aboutsummaryrefslogtreecommitdiff
path: root/stdlib/source/library/lux/world/net/http/cookie.lux
blob: 1e4623761983ffa040685674528dd6fd578eba89 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
(.module:
  [library
   [lux #*
    [control
     [monad (#+ do)]
     ["." try (#+ Try)]
     ["p" parser ("#\." monad)
      ["l" text (#+ Parser)]]]
    [data
     [number
      ["i" int]]
     [text
      ["%" format (#+ format)]]
     [format
      ["." context (#+ Context)]]
     [collection
      ["." dictionary]]]
    [time
     ["." duration (#+ Duration)]]]]
  ["." // (#+ Header)
   ["." header]])

(type: .public Directive
  (-> Text Text))

(def: (directive extension)
  (-> Text Directive)
  (function (_ so_far)
    (format so_far "; " extension)))

(def: .public (set name value)
  (-> Text Text Header)
  (header.add "Set-Cookie" (format name "=" value)))

(def: .public (max_age duration)
  (-> Duration Directive)
  (let [seconds (duration.query duration.second duration)]
    (..directive (format "Max-Age=" (if (i.< +0 seconds)
                                      (%.int seconds)
                                      (%.nat (.nat seconds)))))))

(template [<name> <prefix>]
  [(def: .public (<name> value)
     (-> Text Directive)
     (..directive (format <prefix> "=" value)))]

  [domain "Domain"]
  [path "Path"]
  )

(template [<name> <tag>]
  [(def: .public <name>
     Directive
     (..directive <tag>))]

  [secure "Secure"]
  [http_only "HttpOnly"]
  )

(type: .public CSRF_Policy
  #Strict
  #Lax)

(def: .public (same_site policy)
  (-> CSRF_Policy Directive)
  (..directive (format "SameSite=" (case policy
                                     #Strict "Strict"
                                     #Lax "Lax"))))

(def: (cookie context)
  (-> Context (Parser Context))
  (do p.monad
    [key (l.slice (l.many! (l.none_of! "=")))
     _ (l.this "=")
     value (l.slice (l.many! (l.none_of! ";")))]
    (in (dictionary.put key value context))))

(def: (cookies context)
  (-> Context (Parser Context))
  ($_ p.either
      (do p.monad
        [context' (..cookie context)
         _ (l.this "; ")]
        (cookies context'))
      (p\in context)))

(def: .public (get header)
  (-> Text (Try Context))
  (l.run header (..cookies context.empty)))