0 | module Network.HTTP.Cookie
 1 |
 2 | import Utils.String
 3 | import Data.String.Extra
 4 | import Data.String
 5 | import Derive.Prelude
 6 |
 7 | %language ElabReflection
 8 |
 9 | public export
10 | record Cookie where
11 |   constructor MkCookie
12 |   key : String
13 |   value : String
14 |   attributes : List (String, Maybe String)
15 |
16 | public export
17 | record CookieJar where
18 |   constructor MkCookieJar
19 |   cookies : List Cookie
20 |
21 | %runElab derive "Cookie" [Eq, Ord, Show]
22 | %runElab derive "CookieJar" [Eq, Ord, Show]
23 |
24 | export
25 | serialize_cookie_no_attr : Cookie -> String
26 | serialize_cookie_no_attr cookie = "\{cookie.key}=\{cookie.value}"
27 |
28 | export
29 | serialize_cookie : Cookie -> String
30 | serialize_cookie cookie = join "; " (serialize_cookie_no_attr cookie :: map serialize_attr cookie.attributes) where
31 |   serialize_attr : (String, Maybe String) -> String
32 |   serialize_attr (k, Nothing) = k
33 |   serialize_attr (k, Just v) = "\{k}=\{v}"
34 |
35 | export
36 | same_key : Cookie -> Cookie -> Bool
37 | same_key a b = a.key == b.key
38 |
39 | export
40 | add_cookie : CookieJar -> Cookie -> CookieJar
41 | add_cookie jar cookie = MkCookieJar $ (cookie :: filter (not . same_key cookie) jar.cookies)
42 |
43 | export
44 | deserialize_cookie : String -> Maybe Cookie
45 | deserialize_cookie string = do
46 |   let (kv ::: attrs) = split (';' ==) string
47 |   guard (isInfixOf "=" kv)
48 |   let (k, v) = splitBy '=' kv
49 |   pure $ MkCookie k v (map parse_attr attrs)
50 |   where
51 |     parse_attr : String -> (String, Maybe String)
52 |     parse_attr attr = bimap ltrim (guard (isInfixOf "=" attr) $>) $ splitBy '=' attr
53 |