aboutsummaryrefslogtreecommitdiff
path: root/stdlib/source/test/lux/control/security/privacy.lux
blob: 5505433ed829a4741484144ac90592f6c83e816e (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
(.module:
  [lux #*
   [control
    [hash (#+ Hash)]
    [monad (#+ do)]
    [security
     ["@" privacy (#+ Context Privilege Private with-privacy)]]]
   [data
    ["." text ("#/." equivalence)
     format]]
   [math
    ["r" random]]]
  lux/test)

(type: Password (Private Text))

(signature: (Policy %)
  (: (Hash (Password %))
     &hash)

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

  (: (Privilege %)
     privilege))

(def: (policy _)
  (Ex [%] (-> Any (Policy %)))
  (with-privacy
    (: (Context Policy)
       (function (_ (^@ privilege (^open "%/.")))
         (structure
          (def: &hash
            (structure
             (def: eq
               (structure (def: (= reference sample)
                            (text/= (%/reveal reference)
                                    (%/reveal sample)))))
             (def: hash
               (|>> %/reveal
                    (:: text.hash hash)))))
          
          (def: password
            %/conceal)

          (def: privilege privilege))))))

(context: "Policy labels."
  (do @
    [#let [policy-0 (policy 0)]
     raw-password (r.ascii 10)
     #let [password (:: policy-0 password raw-password)]]
    ($_ seq
        (test "Can work with private values under the same label."
              (and (:: policy-0 = password password)
                   (n/= (:: text.hash hash raw-password)
                        (:: policy-0 hash password))))
        (let [policy-1 (policy 1)
              delegate (@.delegation (:: policy-0 reveal) (:: policy-1 conceal))]
          (test "Can use delegation to share private values between policies."
                (:: policy-1 = (delegate password) (delegate password))))
        )))

(context: "Structures."
  (do @
    [#let [duplicate (: (-> Text Text)
                        (function (_ raw) (format raw raw)))
           policy-0 (policy 0)]
     raw-password (r.ascii 10)
     #let [password (:: policy-0 password raw-password)]
     #let [check (:: policy-0 =
                     (:: policy-0 password (duplicate raw-password)))
           (^open "@/.") @.functor
           (^open "@/.") @.apply
           (^open "@/.") @.monad]]
    ($_ seq
        (test "Can use Functor."
              (check (@/map duplicate password)))
        (test "Can use Apply."
              (check (@/apply (@/wrap duplicate) password)))
        (test "Can use Monad."
              (check (do @.monad
                       [raw-password' (:: policy-0 password raw-password)]
                       (wrap (duplicate raw-password')))))
        )))