aboutsummaryrefslogtreecommitdiff
path: root/stdlib/source/library/lux/control/security/policy.lux
blob: 32bf06c389c359abd35358438d40d2e4b6d0beef (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
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
(.module:
  [library
   [lux #*
    [abstract
     [functor (#+ Functor)]
     [apply (#+ Apply)]
     [monad (#+ Monad)]]
    [type
     abstract]]])

(abstract: .public (Policy brand value label)
  {#.doc (doc "A security policy encoded as the means to 'upgrade' or 'downgrade' in a secure context.")}

  value

  (type: .public (Can_Upgrade brand label value)
    {#.doc (doc "Represents the capacity to 'upgrade' a value.")}
    (-> value (Policy brand value label)))

  (type: .public (Can_Downgrade brand label value)
    {#.doc (doc "Represents the capacity to 'downgrade' a value.")}
    (-> (Policy brand value label) value))

  (type: .public (Privilege brand label)
    {#.doc (doc "Represents the privilege to both 'upgrade' and 'downgrade' a value.")}
    {#can_upgrade (Can_Upgrade brand label)
     #can_downgrade (Can_Downgrade brand label)})

  (type: .public (Delegation brand from to)
    {#.doc (doc "Represents the act of delegating policy capacities.")}
    (All [value]
      (-> (Policy brand value from)
          (Policy brand value to))))

  (def: .public (delegation downgrade upgrade)
    {#.doc (doc "Delegating policy capacities.")}
    (All [brand from to]
      (-> (Can_Downgrade brand from) (Can_Upgrade brand to)
          (Delegation brand from to)))
    (|>> downgrade upgrade))

  (type: .public (Context brand scope label)
    {#.doc (doc "A computational context with an associated policy privilege.")}
    (-> (Privilege brand label)
        (scope label)))

  (def: privilege
    Privilege
    {#can_upgrade (|>> :abstraction)
     #can_downgrade (|>> :representation)})

  (def: .public (with_policy context)
    {#.doc (doc "Activates a security context with the priviledge to enforce it's policy."

                (type: Password
                  (Private Text))

                (interface: (Policy %)
                  (: (-> Text (Password %))
                     password)
                  (: (-> (Password %) Text)
                     unsafe))

                (def: (policy _)
                  (Ex [%] (-> Any (Policy %)))
                  (with_policy
                    (: (Context Privacy Policy)
                       (function (_ (^open "%::."))
                         (implementation
                          (def: (password value)
                            (%::can_upgrade value))
                          (def: (unsafe password)
                            (%::can_downgrade password))))))))}
    (All [brand scope]
      (Ex [label]
        (-> (Context brand scope label)
            (scope label))))
    (context ..privilege))

  (def: (of_policy constructor)
    (-> Type Type)
    (type (All [brand label]
            (constructor (All [value] (Policy brand value label))))))

  (implementation: .public functor
    (:~ (..of_policy Functor))
    
    (def: (map f fa)
      (|> fa :representation f :abstraction)))

  (implementation: .public apply
    (:~ (..of_policy Apply))
    
    (def: &functor ..functor)
    
    (def: (apply ff fa)
      (:abstraction ((:representation ff) (:representation fa)))))

  (implementation: .public monad
    (:~ (..of_policy Monad))
    
    (def: &functor ..functor)
    (def: in (|>> :abstraction))
    (def: join (|>> :representation)))
  )

(template [<brand> <value> <upgrade> <downgrade> <doc>]
  [(abstract: .public <brand>
     {#.doc <doc>}
     
     Any

     (type: .public <value>
       (Policy <brand>))
     
     (type: .public <upgrade>
       (Can_Upgrade <brand>))
     
     (type: .public <downgrade>
       (Can_Downgrade <brand>))
     )]

  [Privacy Private Can_Conceal Can_Reveal
   (doc "A security context for privacy."
        "Private data is data which cannot be allowed to leak outside of the programmed.")]
  [Safety Safe Can_Trust Can_Distrust
   (doc "A security context for safety."
        "Safe data is data coming from outside the program which can be trusted to be properly formatted and lacking injections.")]
  )