aboutsummaryrefslogtreecommitdiff
path: root/stdlib/source/lux/control/security/capability.lux
blob: 914a141ab80b7c96e0d568248fb6887659b1d62a (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
(.module:
  [lux #*
   ["." io (#+ IO)]
   [control
    [monad (#+ do)]
    ["p" parser]
    [concurrency
     ["." promise (#+ Promise)]]]
   [data
    [text
     format]
    [collection
     [list ("list/." functor)]]]
   [type
    abstract]
   ["." macro
    ["." code]
    ["s" syntax (#+ syntax:)
     [common
      ["." reader]
      ["." writer]]]]])

(abstract: #export (Capability brand input output)
  {#.doc (doc "Represents the capability to perform an operation."
              "This operation is assumed to have security implications.")}

  (-> input output)

  (def: forge
    (All [brand input output]
      (-> (-> input output)
          (Capability brand input output)))
    (|>> :abstraction))

  (def: #export (use capability input)
    (All [brand input output]
      (-> (Capability brand input output)
          input
          output))
    ((:representation capability) input))

  (syntax: #export (capability: {export reader.export}
                     {declaration reader.declaration}
                     {annotations (p.maybe reader.annotations)}
                     {[forge input output] (s.form ($_ p.and s.local-identifier s.any s.any))})
    (do @
      [this-module macro.current-module-name
       #let [[name vars] declaration]
       g!brand (:: @ map (|>> %code code.text)
                   (macro.gensym (format (%name [this-module name]))))
       #let [capability (` (..Capability (.primitive (~ g!brand)) (~ input) (~ output)))]]
      (wrap (list (` (type: (~+ (writer.export export))
                       (~ (writer.declaration declaration))
                       (~ capability)))
                  (` (def: (~+ (writer.export export))
                       (~ (code.local-identifier forge))
                       (All [(~+ (list/map code.local-identifier vars))]
                         (-> (-> (~ input) (~ output))
                             (~ capability)))
                       (~! ..forge)))
                  ))))

  (def: #export (async capability)
    (All [brand input output]
      (-> (Capability brand input (IO output))
          (Capability brand input (Promise output))))
    (..forge (|>> ((:representation capability)) promise.future)))
  )