aboutsummaryrefslogtreecommitdiff
path: root/stdlib/source/test/lux/control/security/policy.lux
blob: 87593861045e87c8c531cc5903213fbaa0f9c9ee (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
(.module:
  [library
   [lux "*"
    ["_" test {"+" [Test]}]
    [abstract
     [hash {"+" [Hash]}]
     [monad {"+" [do]}]
     [\\specification
      ["$[0]" functor {"+" [Injection Comparison]}]
      ["$[0]" apply]
      ["$[0]" monad]]]
    [data
     ["[0]" text ("[1]#[0]" equivalence)]]
    [math
     ["[0]" random]
     [number
      ["n" nat]]]]]
  [\\library
   ["[0]" / {"+" [Context Privacy Can_Conceal Can_Reveal Privilege Private]}]])

(def: (injection can_conceal)
  (All (_ label)
    (-> (Can_Conceal label) (Injection (All (_ value) (Private value label)))))
  can_conceal)

(def: (comparison can_reveal)
  (All (_ label)
    (-> (Can_Reveal label) (Comparison (All (_ value) (Private value label)))))
  (function (_ == left right)
    (== (can_reveal left)
        (can_reveal right))))

(type: Password
  (Private Text))

(type: (Policy %)
  (Interface
   (: (Hash (Password %))
      &hash)

   (: (-> Text (Password %))
      password)

   (: (Privilege Privacy %)
      privilege)))

(def: (policy _)
  (Ex (_ %) (-> Any (Policy %)))
  (/.with_policy
    (: (Context Privacy Policy)
       (function (_ (^@ privilege (^open "%[0]")))
         (implementation
          (def: &hash
            (implementation
             (def: &equivalence
               (implementation
                (def: (= reference sample)
                  (text#= (%#can_downgrade reference)
                          (%#can_downgrade sample)))))
             (def: hash
               (|>> %#can_downgrade
                    (# text.hash hash)))))
          
          (def: password
            %#can_upgrade)

          (def: privilege
            privilege))))))

(def: .public test
  Test
  (<| (_.covering /._)
      (_.for [/.Policy
              /.Can_Upgrade /.Can_Downgrade])
      (do random.monad
        [.let [policy_0 (policy [])]
         raw_password (random.ascii 10)
         .let [password (# policy_0 password raw_password)]]
        ($_ _.and
            (_.for [/.Privacy /.Private /.Can_Conceal /.Can_Reveal
                    /.Safety /.Safe /.Can_Trust /.Can_Distrust]
                   ($_ _.and
                       (_.for [/.functor]
                              ($functor.spec (..injection (# policy_0 #can_upgrade)) (..comparison (# policy_0 #can_downgrade)) /.functor))
                       (_.for [/.apply]
                              ($apply.spec (..injection (# policy_0 #can_upgrade)) (..comparison (# policy_0 #can_downgrade)) /.apply))
                       (_.for [/.monad]
                              ($monad.spec (..injection (# policy_0 #can_upgrade)) (..comparison (# policy_0 #can_downgrade)) /.monad))))

            (_.cover [/.Privilege /.Context /.with_policy]
                     (and (# policy_0 = password password)
                          (n.= (# text.hash hash raw_password)
                               (# policy_0 hash password))))
            (let [policy_1 (policy [])
                  delegate (/.delegation (# policy_0 #can_downgrade) (# policy_1 #can_upgrade))]
              (_.cover [/.Delegation /.delegation]
                       (# policy_1 = (delegate password) (delegate password))))
            ))))