xenia/henttp
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

Make encode-/decode-string actually take and return Strings, rather than List Chars

Browse Source
This commit is contained in:
xenia 2023-09-09 21:47:10 +02:00
parent 11cc587d1b
commit 4907f2abeb
6 changed files with 173 additions and 155 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

41
src/Main.agda
View File

@ -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,19 +86,17 @@ 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)
; 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"
@ -106,9 +104,8 @@ encode-response res =
; 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"
@ -130,10 +127,11 @@ module Pages where
< body >
< h 1 >
< span style= "color: yellow;" > "hen" </ span > ,
< span style= "color: purple;" > "ttp" </ span >
< span style= "color: fuchsia;" > "ttp" </ span >
</ h 1 > ,
< h 3 > "what is this?" </ h 1 > ,
< p >
"what is this?"
"henttp is an HTTP server, HTML DSL and (soon to be) router, written in Agda"
</ p >
</ body > ,
< 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

41
src/Parse-HTTP.agda
View File

@ -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)
(λ 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)

4
src/Parse-HTTP/Test.agda
View File

@ -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")

2
src/Parse-HTTP/URL.agda
View File

@ -41,7 +41,7 @@ instance
EqPath ._==_ (_ / _) $ = false
EqPath ._==_ $ (_ / _) = false
infixr 5 _/_
infixr 30 _/_
record URL : Type where
constructor http://_/_¿_

72
src/UTF-8.agda
View File

@ -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 (_<_; _<?_)
open import Data.Nat
open import Data.Nat.Properties using (<-trans; <ᵇ⇒<; ≤-refl; m≤n+m)
open import Relation.Nullary
import Data.Vec as V
import Data.List as L
import Data.String as S
import Data.Char as C
open V using (Vec)
open L using (List)
open S using (String)
open C using (Char)
open import Base
open import NonEmpty
open import Bits-and-Bytes
import Data.Char as C
open import Data.Nat.Properties using (<-trans; <ᵇ⇒<; ≤-refl; m≤n+m)
postulate
char-toℕ-in-range : (c : C.Char) → C.toℕ c < 0x110000
@ -32,6 +37,8 @@ encode-char ch = case x <? 0x80 of λ where
(yes x<0x10000) → encode-3 x x<0x10000
(no _) → encode-4 x x<0x110000
where
open V
x : ℕ
x = C.toℕ ch
@ -41,43 +48,48 @@ encode-char ch = case x <? 0x80 of λ where
encode-1 : (n : ℕ) → n < 0x80 → List Byte
encode-1 n n<0x80 = case enbits {7} n n<0x80 of λ where
(b0 ∷ b1 ∷ b2 ∷ b3 ∷ b4 ∷ b5 ∷ b6 ∷ []) →
Bit8-to-Byte (b0 ∷ b1 ∷ b2 ∷ b3 ∷ b4 ∷ b5 ∷ b6 ∷ 𝟘 ∷ []) ∷ˡ
[]ˡ
Bit8-to-Byte (b0 ∷ b1 ∷ b2 ∷ b3 ∷ b4 ∷ b5 ∷ b6 ∷ 𝟘 ∷ []) L.∷
L.[]
encode-2 : (n : ℕ) → n < 0x800 → List Byte
encode-2 n n<0x800 = case enbits {11} n n<0x800 of λ where
(b0 ∷ b1 ∷ b2 ∷ b3 ∷ b4 ∷ b5 ∷ b6 ∷ b7 ∷ b8 ∷ b9 ∷ b10 ∷ []) →
Bit8-to-Byte (b6 ∷ b7 ∷ b8 ∷ b9 ∷ b10 ∷ 𝟘 ∷ 𝟙 ∷ 𝟙 ∷ []) ∷ˡ
Bit8-to-Byte (b0 ∷ b1 ∷ b2 ∷ b3 ∷ b4 ∷ b5 ∷ 𝟘 ∷ 𝟙 ∷ []) ∷ˡ
[]ˡ
Bit8-to-Byte (b6 ∷ b7 ∷ b8 ∷ b9 ∷ b10 ∷ 𝟘 ∷ 𝟙 ∷ 𝟙 ∷ []) L.∷
Bit8-to-Byte (b0 ∷ b1 ∷ b2 ∷ b3 ∷ b4 ∷ b5 ∷ 𝟘 ∷ 𝟙 ∷ []) L.∷
L.[]
encode-3 : (n : ℕ) → n < 0x10000 → List Byte
encode-3 n n<0x10000 = case enbits {16} n n<0x10000 of λ where
(b0 ∷ b1 ∷ b2 ∷ b3 ∷ b4 ∷ b5 ∷ b6 ∷ b7 ∷ b8 ∷ b9 ∷ b10 ∷ b11 ∷ b12 ∷ b13 ∷ b14 ∷ b15 ∷ []) →
Bit8-to-Byte (b12 ∷ b13 ∷ b14 ∷ b15 ∷ 𝟘 ∷ 𝟙 ∷ 𝟙 ∷ 𝟙 ∷ []) ∷ˡ
Bit8-to-Byte (b6 ∷ b7 ∷ b8 ∷ b9 ∷ b10 ∷ b11 ∷ 𝟘 ∷ 𝟙 ∷ []) ∷ˡ
Bit8-to-Byte (b0 ∷ b1 ∷ b2 ∷ b3 ∷ b4 ∷ b5 ∷ 𝟘 ∷ 𝟙 ∷ []) ∷ˡ
[]ˡ
Bit8-to-Byte (b12 ∷ b13 ∷ b14 ∷ b15 ∷ 𝟘 ∷ 𝟙 ∷ 𝟙 ∷ 𝟙 ∷ []) L.∷
Bit8-to-Byte (b6 ∷ b7 ∷ b8 ∷ b9 ∷ b10 ∷ b11 ∷ 𝟘 ∷ 𝟙 ∷ []) L.∷
Bit8-to-Byte (b0 ∷ b1 ∷ b2 ∷ b3 ∷ b4 ∷ b5 ∷ 𝟘 ∷ 𝟙 ∷ []) L.∷
L.[]
encode-4 : (n : ℕ) → n < 0x110000 → List Byte
encode-4 n n<0x110000 = case enbits {21} n (<-trans n<0x110000 (<ᵇ⇒< 0x110000 (2 ^ 21) tt)) of λ where
(b0 ∷ b1 ∷ b2 ∷ b3 ∷ b4 ∷ b5 ∷ b6 ∷ b7 ∷ b8 ∷ b9 ∷ b10 ∷ b11 ∷ b12 ∷ b13 ∷ b14 ∷ b15 ∷
b16 ∷ b17 ∷ b18 ∷ b19 ∷ b20 ∷ []) →
Bit8-to-Byte (b18 ∷ b19 ∷ b20 ∷ 𝟘 ∷ 𝟙 ∷ 𝟙 ∷ 𝟙 ∷ 𝟙 ∷ []) ∷ˡ
Bit8-to-Byte (b12 ∷ b13 ∷ b14 ∷ b15 ∷ b16 ∷ b17 ∷ 𝟘 ∷ 𝟙 ∷ []) ∷ˡ
Bit8-to-Byte (b6 ∷ b7 ∷ b8 ∷ b9 ∷ b10 ∷ b11 ∷ 𝟘 ∷ 𝟙 ∷ []) ∷ˡ
Bit8-to-Byte (b0 ∷ b1 ∷ b2 ∷ b3 ∷ b4 ∷ b5 ∷ 𝟘 ∷ 𝟙 ∷ []) ∷ˡ
[]ˡ
Bit8-to-Byte (b18 ∷ b19 ∷ b20 ∷ 𝟘 ∷ 𝟙 ∷ 𝟙 ∷ 𝟙 ∷ 𝟙 ∷ []) L.∷
Bit8-to-Byte (b12 ∷ b13 ∷ b14 ∷ b15 ∷ b16 ∷ b17 ∷ 𝟘 ∷ 𝟙 ∷ []) L.∷
Bit8-to-Byte (b6 ∷ b7 ∷ b8 ∷ b9 ∷ b10 ∷ b11 ∷ 𝟘 ∷ 𝟙 ∷ []) L.∷
Bit8-to-Byte (b0 ∷ b1 ∷ b2 ∷ b3 ∷ b4 ∷ b5 ∷ 𝟘 ∷ 𝟙 ∷ []) L.∷
L.[]
encode-string : List C.Char → List Byte
encode-string []ˡ = []ˡ
encode-string (c ∷ˡ cs) = encode-char c ++ˡ encode-string cs
encode-string : String → List Byte
encode-string s = go (S.toList s)
where
go : List Char → List Byte
go L.[] = L.[]
go (c L.∷ cs) = encode-char c L.++ go cs
module decode where
open import Indexed using ([_]; _→′_; □_; fix)
open import Parsing (Byte)
import Data.Fin as F
module _ where
open V hiding ([_])
decode-≤-1 : {m : ℕ} → Vec Byte (1 + m) → Maybe (Parse C.Char (1 + m))
decode-≤-1 (x ∷ xs) with Byte-to-Bit8 x
... | (b0 ∷ b1 ∷ b2 ∷ b3 ∷ b4 ∷ b5 ∷ b6 ∷ 𝟘 ∷ [])
@ -149,10 +161,10 @@ module decode where
parse-string : [ Parser (List⁺ C.Char) ]
parse-string = many-fix parse-char
decode-string : List Byte → Maybe (List C.Char)
decode-string []ˡ = real []ˡ
decode-string xs@(_ ∷ˡ _) with parse-string .parse (fromList xs)
... | real ⟨ r , _ , [] ⟩ = real (list⁺-to-list r)
decode-string : List Byte → Maybe String
decode-string L.[] = real ""
decode-string xs@(_ L.∷ _) with parse-string .parse (V.fromList xs)
... | real ⟨ r , _ , V.[] ⟩ = real (S.fromList (list⁺-to-list r))
... | _ = cake
open decode using (decode-string; parse-string; parse-char) public

4
src/UTF-8/Test.agda
View File

@ -33,7 +33,7 @@ encode-∘ : encode-char '∘' ≡ < 0xe2 > ∷ˡ < 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