Added privacy typing for information-flow control.

2 files changed, 149 insertions, 0 deletions

diff --git a/stdlib/source/lux/control/security/privacy.lux b/stdlib/source/lux/control/security/privacy.lux
new file mode 100644
index 000000000..eeccbd57e
--- /dev/null
+++ b/stdlib/source/lux/control/security/privacy.lux
@@ -0,0 +1,69 @@
+(.module:
+  [lux #*
+   [control
+    [functor (#+ Functor)]
+    [apply (#+ Apply)]
+    [monad (#+ Monad)]]
+   [type
+    abstract]])
+
+(abstract: #export (Private label value)
+  {#.doc (doc "A value that is regarded as 'private'."
+              "The special 'label' parameter exists to distinguish private values of the same basic type."
+              "This distinction is necessary when such values are produced in different policies."
+              "This matters, as different policies will have different means to deal with private values."
+              "The main way to deal with private values is to produce 'public' values from them, by calculating values which do not reveal any private information."
+              "An example of a computation which may produce a public value from a private value, would be a hashing function.")}
+
+  ## Only the public 'value' is necessary, as the 'label' is only
+  ## there to prevent confusing private values from different origins.
+  value
+
+  (signature: #export (Privilege label value)
+    (: (-> value (Private label value))
+       conceal)
+    
+    (: (-> (Private label value) value)
+       reveal))
+
+  (type: #export (Policy value scope label)
+    (-> (Privilege label value)
+        (scope label)))
+
+  (def: #export (with-privacy policy)
+    {#.doc (doc "Takes a function that will operate in a privileged/trusted context."
+                "Within that context, it will be possible to label values as 'private'."
+                "It will also be possible to downgrade private values to 'public' (un-labelled) values."
+                "This function can be used to instantiate structures for signatures that provide privacy-sensitive operations."
+                "The context should not, under any circumstance, reveal any private information it may be privy to."
+                "Make sure any functions which produce public values from private values are properly reviewed for potential information leaks.")}
+    (All [value scope]
+      (Ex [label]
+        (-> (Policy value scope label)
+            (scope label))))
+    (policy (structure (def: conceal (|>> :abstraction))
+                       (def: reveal (|>> :representation)))))
+
+  (structure: #export Functor<Private>
+    (All [label] (Functor (Private label)))
+    
+    (def: (map f fa)
+      (|> fa :representation f :abstraction)))
+
+  (structure: #export Apply<Private>
+    (All [label] (Apply (Private label)))
+    
+    (def: functor Functor<Private>)
+
+    (def: (apply ff fa)
+      (:abstraction ((:representation ff) (:representation fa)))))
+
+  (structure: #export Monad<Private>
+    (All [label] (Monad (Private label)))
+    
+    (def: functor Functor<Private>)
+
+    (def: wrap (|>> :abstraction))
+
+    (def: join (|>> :representation)))
+  )
diff --git a/stdlib/test/test/lux/control/security/privacy.lux b/stdlib/test/test/lux/control/security/privacy.lux
new file mode 100644
index 000000000..14ef98a15
--- /dev/null
+++ b/stdlib/test/test/lux/control/security/privacy.lux
@@ -0,0 +1,80 @@
+(.module:
+  [lux #*
+   [control
+    [hash (#+ Hash)]
+    [monad (#+ do)]
+    [security
+     ["@" privacy (#+ Private Policy with-privacy)]]]
+   [data
+    ["." text ("text/." Equivalence<Text>)
+     format]]
+   [math
+    ["r" random]]]
+  lux/test)
+
+(signature: (Password %)
+  (: (Hash (Private % Text))
+     &hash)
+
+  (: (-> Text (Private % Text))
+     password))
+
+(def: (Password<%> _)
+  (Ex [%] (-> Any (Password %)))
+  (with-privacy
+    (: (Policy Text Password)
+       (function (_ (^open "%/."))
+         (structure
+          (def: &hash
+            (structure
+             (def: eq
+               (structure (def: (= reference sample)
+                            (text/= (%/reveal reference)
+                                    (%/reveal sample)))))
+             (def: hash
+               (|>> %/reveal
+                    (:: text.Hash<Text> hash)))))
+          
+          (def: password
+            %/conceal))))))
+
+(context: "Policy labels."
+  (do @
+    [#let [Password<%>0 (Password<%> 0)]
+     raw-password (r.ascii 10)
+     #let [password (:: Password<%>0 password raw-password)]]
+    ($_ seq
+        (test "Can work with private values under the same label."
+              (and (:: Password<%>0 = password password)
+                   (n/= (:: text.Hash<Text> hash raw-password)
+                        (:: Password<%>0 hash password))))
+        ## TODO: Figure out some way to test type-checking
+        ## failures, so the following code can be tested, instead
+        ## of being commented out.
+        ## (let [Password<%>1 (Password<%> 1)]
+        ##   (test "Cannot mix labels."
+        ##         (:: Password<%>1 = password password)))
+        )))
+
+(context: "Structures."
+  (do @
+    [#let [duplicate (: (-> Text Text)
+                        (function (_ raw) (format raw raw)))
+           Password<%>0 (Password<%> 0)]
+     raw-password (r.ascii 10)
+     #let [password (:: Password<%>0 password raw-password)]
+     #let [check (:: Password<%>0 =
+                     (:: Password<%>0 password (duplicate raw-password)))
+           (^open "@/.") @.Functor<Private>
+           (^open "@/.") @.Apply<Private>
+           (^open "@/.") @.Monad<Private>]]
+    ($_ 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<Private>
+                       [raw-password' (:: Password<%>0 password raw-password)]
+                       (wrap (duplicate raw-password')))))
+        )))