diff --git a/src/Main.agda b/src/Main.agda index 7318837..a8f37ed 100644 --- a/src/Main.agda +++ b/src/Main.agda @@ -50,7 +50,7 @@ crlfᵇ = string-to-ascii-list "\r\n" encode-response : Response → List Byte encode-response res = - UTF-8.encode-string (S.toList (status-line)) L.++ crlfᵇ L.++ + UTF-8.encode-string status-line L.++ crlfᵇ L.++ encoded-headers L.++ crlfᵇ L.++ (proj₂ <$> res .content or-else L.[]) where @@ -63,12 +63,12 @@ encode-response res = (real (content-type , content)) → record { name = string-to-ascii-list⁺ "Content-Type" - ; value = UTF-8.encode-string (S.toList (show content-type)) ++⁺ string-to-ascii-list⁺ "; charset=utf-8" + ; value = UTF-8.encode-string (show content-type) ++⁺ string-to-ascii-list⁺ "; charset=utf-8" } L.∷ record { name = string-to-ascii-list⁺ "Content-Length" ; value = - (list-to-list⁺? (UTF-8.encode-string (S.toList (show (L.length content))))) + list-to-list⁺? (UTF-8.encode-string (show (L.length content))) or-else (string-to-ascii-list⁺ "mjau") } L.∷ L.[] @@ -86,35 +86,32 @@ encode-response res = (res .headers L.++ extra-headers) ) -200-ok : Content-Type → List Byte → List Byte +200-ok : Content-Type → String → Response 200-ok content-type content = - encode-response - record - { status-code = 200 - ; status = "OK" - ; headers = L.[] - ; content = real (content-type , content) - } + record + { status-code = 200 + ; status = "OK" + ; headers = L.[] + ; content = real (content-type , UTF-8.encode-string content) + } -400-bad-request : List Byte +400-bad-request : Response 400-bad-request = - encode-response - record - { status-code = 400 - ; status = "Bad Request" - ; headers = L.[] - ; content = real (text/plain , string-to-ascii-list "what is bro doing") - } + record + { status-code = 400 + ; status = "Bad Request" + ; headers = L.[] + ; content = real (text/plain , string-to-ascii-list "what is bro doing") + } -404-not-found : List Byte +404-not-found : Response 404-not-found = - encode-response - record - { status-code = 404 - ; status = "Not Found" - ; headers = L.[] - ; content = real (text/plain , string-to-ascii-list "not found :(") - } + record + { status-code = 404 + ; status = "Not Found" + ; headers = L.[] + ; content = real (text/plain , string-to-ascii-list "not found :(") + } module Pages where open HTML @@ -130,10 +127,11 @@ module Pages where < body > < h 1 > < span style= "color: yellow;" > "hen" , - < span style= "color: purple;" > "ttp" + < span style= "color: fuchsia;" > "ttp" , + < h 3 > "what is this?" , < p > - "what is this?" + "henttp is an HTTP server, HTML DSL and (soon to be) router, written in Agda" , < footer > @@ -143,17 +141,14 @@ module Pages where where open HTML.Syntax -handle-request : Request → IO (List Byte) +handle-request : Request → IO Response handle-request req = - if (req .target .path) == ("index.html" / $) - then pure ( - 200-ok - text/html - (UTF-8.encode-string (S.toList ( - HTML.Render.render-element (Pages.render-index (req .target .query)) - ))) + case req .target .path of λ where + ("index.html" / $) → + pure ( + 200-ok text/html (HTML.Render.render-element (Pages.render-index (req .target .query))) ) - else pure 404-not-found + _ → pure 404-not-found where open Request using (target) open import Parse-HTTP.URL @@ -175,12 +170,12 @@ handle sock = do case req .content of λ where (real c) → putStrLn (" content = " S.++ show ⦃ ShowByteList ⦄ c) cake → putStrLn " no content" - handle-request req + encode-response <$> handle-request req ) cake → (do putStrLn "Got an invalid request" - pure 400-bad-request + encode-response <$> pure 400-bad-request ) where open Request diff --git a/src/Parse-HTTP.agda b/src/Parse-HTTP.agda index 7918015..e1d7b29 100644 --- a/src/Parse-HTTP.agda +++ b/src/Parse-HTTP.agda @@ -31,7 +31,7 @@ module Parse-HTTP where -- helper functions private decode-utf8⁺ : List⁺ Byte → Maybe String - decode-utf8⁺ bs = S.fromList <$> UTF-8.decode-string (list⁺-to-list bs) + decode-utf8⁺ bs = UTF-8.decode-string (list⁺-to-list bs) module Parse-URL where open import Parse-HTTP.URL @@ -221,26 +221,37 @@ module Parse-Request where >>=′ λ (method , target , version , headers) → enbox ( case content-length (list⁺-to-list headers) of λ where cake → - ( - (λ _ → record { method = method; target = target; version = version; headers = list⁺-to-list headers; content = cake }) - <$>′ crlf - ) + crlf >$=′ λ _ → + record + { method = method + ; target = target + ; version = version + ; headers = list⁺-to-list headers + ; content = cake + } (real 0) → - ( - (λ _ → record { method = method; target = target; version = version; headers = list⁺-to-list headers; content = real L.[] }) - <$>′ (crlf <&>□ crlf) - ) + (crlf <&>□ crlf) >$=′ λ _ → + record + { method = method + ; target = target + ; version = version + ; headers = list⁺-to-list headers + ; content = real L.[] + } (real n@(suc _)) → - ( - (λ content → record { method = method; target = target; version = version; headers = list⁺-to-list headers; content = real (V.toList content) }) - <$>′ (crlf <&⃗>□ (repeat n any₁)) - ) + (crlf <&⃗>□ repeat n any₁) >$=′ λ content → + record + { method = method + ; target = target + ; version = version + ; headers = list⁺-to-list headers + ; content = real (V.toList content) + } ) where find-target : ((HTTP-Method × RequestTarget × HTTP-Version) × List⁺ Header) → Maybe (HTTP-Method × URL × HTTP-Version × List⁺ Header) - find-target ((method , record { path = OriginForm path ; query = query } , ver) , headers) = - Parse-Header.host (list⁺-to-list headers) >>= λ auth → - real (method , (http:// auth / path ¿ query) , ver , headers) + find-target ((method , record { path = OriginForm path ; query = query } , ver) , headers) = + (λ auth → method , (http:// auth / path ¿ query) , ver , headers) <$> Parse-Header.host (list⁺-to-list headers) find-target ((method , record { path = AbsoluteForm auth path ; query = query } , ver) , headers) = real (method , (http:// auth / path ¿ query) , ver , headers) diff --git a/src/Parse-HTTP/Test.agda b/src/Parse-HTTP/Test.agda index f81bee5..301137c 100644 --- a/src/Parse-HTTP/Test.agda +++ b/src/Parse-HTTP/Test.agda @@ -23,8 +23,8 @@ open import Parse-HTTP.URL module Parse-HTTP.Test where -enc : (s : String) → V.Vec Byte (L.length (UTF-8.encode-string (S.toList s))) -enc x = V.fromList (UTF-8.encode-string (S.toList x)) +enc : (s : String) → V.Vec Byte (L.length (UTF-8.encode-string s)) +enc x = V.fromList (UTF-8.encode-string x) module Test-Helpers where test-percent-encoding : percent-encoded .parse (enc "%69abc") diff --git a/src/Parse-HTTP/URL.agda b/src/Parse-HTTP/URL.agda index cf4fa64..52ac447 100644 --- a/src/Parse-HTTP/URL.agda +++ b/src/Parse-HTTP/URL.agda @@ -41,7 +41,7 @@ instance EqPath ._==_ (_ / _) $ = false EqPath ._==_ $ (_ / _) = false -infixr 5 _/_ +infixr 30 _/_ record URL : Type where constructor http://_/_¿_ diff --git a/src/UTF-8.agda b/src/UTF-8.agda index 3b97f07..cc7dc2c 100644 --- a/src/UTF-8.agda +++ b/src/UTF-8.agda @@ -4,22 +4,27 @@ module UTF-8 where open import Agda.Primitive renaming (Set to Type) open import Data.Product -open import Data.Unit using (⊤; tt) -open import Data.Empty -open import Data.Vec hiding ([_]) -open import Data.List using (List) renaming (_∷_ to _∷ˡ_; [] to []ˡ; _++_ to _++ˡ_) -open import Data.Bool using (Bool; true; false; T) -open import Data.Nat +open import Data.Unit + open import Relation.Binary.PropositionalEquality hiding ([_]) +open import Data.Bool hiding (_<_; _ ∷ˡ < 0x88 > ∷ˡ < 0x98 > ∷ˡ encode-∘ = refl encode-𐄣 : encode-char '𐄣' ≡ < 0xf0 > ∷ˡ < 0x90 > ∷ˡ < 0x84 > ∷ˡ < 0xa3 > ∷ˡ []ˡ encode-𐄣 = refl -encode-blah : encode-string (S.toList "aö∘𐄣") +encode-blah : encode-string "aö∘𐄣" ≡ < 0x61 > ∷ˡ < 0xc3 > ∷ˡ < 0xb6 > ∷ˡ < 0xe2 > ∷ˡ < 0x88 > ∷ˡ < 0x98 > @@ -46,5 +46,5 @@ decode-blah : decode-string ∷ˡ < 0xe2 > ∷ˡ < 0x88 > ∷ˡ < 0x98 > ∷ˡ < 0xf0 > ∷ˡ < 0x90 > ∷ˡ < 0x84 > ∷ˡ < 0xa3 > ∷ˡ []ˡ ) - ≡ real (S.toList "aö∘𐄣") + ≡ real "aö∘𐄣" decode-blah = refl