Move Response into HTTP

This commit is contained in:
xenia 2023-09-09 23:02:39 +02:00
parent ffb6ffde80
commit 50d8535c50
2 changed files with 100 additions and 89 deletions

View File

@ -2,6 +2,9 @@
open import Agda.Primitive renaming (Set to Type) open import Agda.Primitive renaming (Set to Type)
open import Data.Nat
open import Data.Product
import Data.String as S import Data.String as S
import Data.List as L import Data.List as L
open S using (String) open S using (String)
@ -64,6 +67,16 @@ module HTTP-Header where
ShowHeader .show hdr = show ShowByteList (list⁺-to-list (hdr .name)) S.++ ": " S.++ show ShowByteList (list⁺-to-list (hdr .value)) ShowHeader .show hdr = show ShowByteList (list⁺-to-list (hdr .name)) S.++ ": " S.++ show ShowByteList (list⁺-to-list (hdr .value))
where where
open Header open Header
data Content-Type : Type where
text/plain text/html : Content-Type
instance
ShowContent-Type : Show Content-Type
ShowContent-Type .show text/plain = "text/plain"
ShowContent-Type .show text/html = "text/html"
open HTTP-Header public open HTTP-Header public
module HTTP-Request where module HTTP-Request where
@ -92,3 +105,85 @@ module HTTP-Request where
headers : List Header headers : List Header
content : Maybe (List Byte) content : Maybe (List Byte)
open HTTP-Request public open HTTP-Request public
module HTTP-Response where
record Response : Type where
field
status-code :
status : String
headers : List Header -- all headers besides Content-Type and Content-Length
content : Maybe (Content-Type × List Byte) -- mime type and data
encode-response : Response List Byte
encode-response res =
UTF-8.encode-string status-line L.++ crlfᵇ L.++
encoded-headers L.++ crlfᵇ L.++
(proj₂ <$> res .content or-else L.[])
where
open Response
crlfᵇ : List Byte
crlfᵇ = ASCII.encode-list "\r\n"
status-line : String
status-line = "HTTP/1.1 " S.++ show (res .status-code) S.++ " " S.++ (res .status)
extra-headers : List Header
extra-headers = case res .content of λ where
cake L.[]
(real (content-type , content))
record
{ name = ASCII.encode-list⁺ "Content-Type"
; value = UTF-8.encode-string (show content-type) ++⁺ ASCII.encode-list⁺ "; charset=utf-8"
}
L.∷ record
{ name = ASCII.encode-list⁺ "Content-Length"
; value =
list-to-list⁺? (UTF-8.encode-string (show (L.length content)))
or-else (ASCII.encode-list⁺ "mjau")
}
L.∷ L.[]
encode-header : Header List Byte
encode-header hdr = list⁺-to-list (hdr .name ⁺++⁺ ASCII.encode-list⁺ ": " ⁺++⁺ hdr .value)
where
open Header
encoded-headers : List Byte
encoded-headers =
L.concat (
L.map
(λ h encode-header h L.++ crlfᵇ)
(res .headers L.++ extra-headers)
)
200-ok : Content-Type String Response
200-ok content-type content =
record
{ status-code = 200
; status = "OK"
; headers = L.[]
; content = real (content-type , UTF-8.encode-string content)
}
400-bad-request : Response
400-bad-request =
record
{ status-code = 400
; status = "Bad Request"
; headers = L.[]
; content = real (text/plain , ASCII.encode-list "what is bro doing")
}
404-not-found : Response
404-not-found =
record
{ status-code = 404
; status = "Not Found"
; headers = L.[]
; content = real (text/plain , ASCII.encode-list "not found :(")
}
open HTTP-Response public

View File

@ -34,90 +34,6 @@ import HTML.Render
import UTF-8 import UTF-8
import ASCII import ASCII
data Content-Type : Type where
text/plain text/html : Content-Type
instance
ShowContent-Type : Show Content-Type
ShowContent-Type .show text/plain = "text/plain"
ShowContent-Type .show text/html = "text/html"
record Response : Type where
field
status-code :
status : String
headers : List HTTP.Header -- all headers besides Content-Type and Content-Length
content : Maybe (Content-Type × List Byte) -- mime type and data
open Response
crlfᵇ : List Byte
crlfᵇ = ASCII.encode-list "\r\n"
encode-response : Response List Byte
encode-response res =
UTF-8.encode-string status-line L.++ crlfᵇ L.++
encoded-headers L.++ crlfᵇ L.++
(proj₂ <$> res .content or-else L.[])
where
status-line : String
status-line = "HTTP/1.1 " S.++ show (res .status-code) S.++ " " S.++ (res .status)
extra-headers : List HTTP.Header
extra-headers = case res .content of λ where
cake L.[]
(real (content-type , content))
record
{ name = ASCII.encode-list⁺ "Content-Type"
; value = UTF-8.encode-string (show content-type) ++⁺ ASCII.encode-list⁺ "; charset=utf-8"
}
L.∷ record
{ name = ASCII.encode-list⁺ "Content-Length"
; value =
list-to-list⁺? (UTF-8.encode-string (show (L.length content)))
or-else (ASCII.encode-list⁺ "mjau")
}
L.∷ L.[]
encode-header : HTTP.Header List Byte
encode-header hdr = list⁺-to-list (hdr .name ⁺++⁺ ASCII.encode-list⁺ ": " ⁺++⁺ hdr .value)
where
open HTTP.Header
encoded-headers : List Byte
encoded-headers =
L.concat (
L.map
(λ h encode-header h L.++ crlfᵇ)
(res .headers L.++ extra-headers)
)
200-ok : Content-Type String Response
200-ok content-type content =
record
{ status-code = 200
; status = "OK"
; headers = L.[]
; content = real (content-type , UTF-8.encode-string content)
}
400-bad-request : Response
400-bad-request =
record
{ status-code = 400
; status = "Bad Request"
; headers = L.[]
; content = real (text/plain , ASCII.encode-list "what is bro doing")
}
404-not-found : Response
404-not-found =
record
{ status-code = 404
; status = "Not Found"
; headers = L.[]
; content = real (text/plain , ASCII.encode-list "not found :(")
}
module Pages where module Pages where
open HTML open HTML
@ -146,7 +62,7 @@ module Pages where
where where
open HTML.Syntax open HTML.Syntax
handle-request : HTTP.Request IO Response handle-request : HTTP.Request IO HTTP.Response
handle-request req = handle-request req =
case req .target .path of λ where case req .target .path of λ where
($) ($)
@ -164,9 +80,9 @@ handle-request req =
) )
("index.html" / $) ("index.html" / $)
pure ( pure (
200-ok text/html (HTML.Render.render-element (Pages.render-index (req .target .query))) HTTP.200-ok HTTP.text/html (HTML.Render.render-element (Pages.render-index (req .target .query)))
) )
_ pure 404-not-found _ pure HTTP.404-not-found
where where
open HTTP.Request using (target) open HTTP.Request using (target)
open URL open URL
@ -189,12 +105,12 @@ handle sock = do
case req .content of λ where case req .content of λ where
(real c) putStrLn (" content = " S.++ show ShowByteList c) (real c) putStrLn (" content = " S.++ show ShowByteList c)
cake putStrLn " no content" cake putStrLn " no content"
encode-response <$> handle-request req HTTP.encode-response <$> handle-request req
) )
cake cake
(do (do
putStrLn "Got an invalid request" putStrLn "Got an invalid request"
encode-response <$> pure 400-bad-request HTTP.encode-response <$> pure HTTP.400-bad-request
) )
where where
open HTTP.Request open HTTP.Request