From 1bce0132321794e421508ae687c9b1b68725a088 Mon Sep 17 00:00:00 2001
From: Eduardo Julian
Date: Sat, 4 May 2019 01:06:24 -0400
Subject: - Replaced "Dirty" values with "Safe" values. - Generalized "Safety"
 and "Privacy" as instances of "Policy".

---
 stdlib/source/lux/control/security/integrity.lux   | 51 ------------
 stdlib/source/lux/control/security/policy.lux      | 95 ++++++++++++++++++++++
 stdlib/source/lux/control/security/privacy.lux     | 95 ----------------------
 stdlib/source/test/lux/control.lux                 |  6 +-
 .../source/test/lux/control/security/integrity.lux | 55 -------------
 stdlib/source/test/lux/control/security/policy.lux | 90 ++++++++++++++++++++
 .../source/test/lux/control/security/privacy.lux   | 89 --------------------
 7 files changed, 187 insertions(+), 294 deletions(-)
 delete mode 100644 stdlib/source/lux/control/security/integrity.lux
 create mode 100644 stdlib/source/lux/control/security/policy.lux
 delete mode 100644 stdlib/source/lux/control/security/privacy.lux
 delete mode 100644 stdlib/source/test/lux/control/security/integrity.lux
 create mode 100644 stdlib/source/test/lux/control/security/policy.lux
 delete mode 100644 stdlib/source/test/lux/control/security/privacy.lux

(limited to 'stdlib/source')

diff --git a/stdlib/source/lux/control/security/integrity.lux b/stdlib/source/lux/control/security/integrity.lux
deleted file mode 100644
index 625f3c431..000000000
--- a/stdlib/source/lux/control/security/integrity.lux
+++ /dev/null
@@ -1,51 +0,0 @@
-(.module:
-  [lux #*
-   [abstract
-    [functor (#+ Functor)]
-    [apply (#+ Apply)]
-    [monad (#+ Monad)]]
-   [data
-    [error (#+ Error)]]
-   [type
-    abstract]])
-
-(abstract: #export (Dirty a)
-  {#.doc (doc "A value which is considered untrustworthy due to its origin.")}
-  
-  a
-
-  (def: #export taint
-    {#.doc (doc "Mark a value as dirty/untrustworthy.")}
-    (All [a] (-> a (Dirty a)))
-    (|>> :abstraction))
-
-  (def: #export (validate validator dirty)
-    {#.doc (doc "Test a dirty/untrustworthy value."
-                "Potentially produces a 'clean' value.")}
-    (All [a b] (-> (-> a (Error b)) (Dirty a) (Error b)))
-    (validator (:representation dirty)))
-
-  (def: #export trust
-    {#.doc (doc "Trusts a (previously thought as) dirty/untrustworthy value."
-                "Only use this function if you know what you are doing."
-                "Trusting a value that hasn't been validated opens a security vulnerability.")}
-    (All [a] (-> (Dirty a) a))
-    (|>> :representation))
-
-  (structure: #export functor (Functor Dirty)
-    (def: (map f fa)
-      (|> fa :representation f :abstraction)))
-
-  (structure: #export apply (Apply Dirty)
-    (def: &functor ..functor)
-
-    (def: (apply ff fa)
-      (:abstraction ((:representation ff) (:representation fa)))))
-
-  (structure: #export monad (Monad Dirty)
-    (def: &functor ..functor)
-
-    (def: wrap (|>> :abstraction))
-
-    (def: join (|>> :representation)))
-  )
diff --git a/stdlib/source/lux/control/security/policy.lux b/stdlib/source/lux/control/security/policy.lux
new file mode 100644
index 000000000..f61f4c58b
--- /dev/null
+++ b/stdlib/source/lux/control/security/policy.lux
@@ -0,0 +1,95 @@
+(.module:
+  [lux #*
+   [abstract
+    [functor (#+ Functor)]
+    [apply (#+ Apply)]
+    [monad (#+ Monad)]]
+   [type
+    abstract]]
+  [//
+   ["!" capability (#+ capability:)]])
+
+(abstract: #export (Policy brand value label)
+  {}
+
+  value
+
+  (capability: #export (Can-Upgrade brand label value)
+    {#.doc (doc "Represents the capacity to 'upgrade' a value.")}
+    (can-upgrade value (Policy brand value label)))
+
+  (capability: #export (Can-Downgrade brand label value)
+    {#.doc (doc "Represents the capacity to 'downgrade' a value.")}
+    (can-downgrade (Policy brand value label) value))
+
+  (type: #export (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)})
+
+  (def: Privilege<_>
+    Privilege
+    {#can-upgrade (..can-upgrade (|>> :abstraction))
+     #can-downgrade (..can-downgrade (|>> :representation))})
+
+  (type: #export (Delegation brand from to)
+    {#.doc (doc "Represents the act of delegating policy capacities.")}
+    (All [value] (-> (Policy brand value from) (Policy brand value to))))
+
+  (def: #export (delegation downgrade upgrade)
+    {#.doc (doc "Delegating policy capacities.")}
+    (All [brand from to]
+      (-> (Can-Downgrade brand from) (Can-Upgrade brand to)
+          (Delegation brand from to)))
+    (|>> (!.use downgrade) (!.use upgrade)))
+
+  (type: #export (Context brand scope label)
+    {#.doc (doc "A computational context with an associated policy privilege.")}
+    (-> (Privilege brand label)
+        (scope label)))
+
+  (def: #export (with-policy context)
+    (All [brand scope]
+      (Ex [label]
+        (-> (Context brand scope label)
+            (scope label))))
+    (context ..Privilege<_>))
+
+  (def: (decorate constructor)
+    (-> Type Type)
+    (type (All [brand label] (constructor (All [value] (Policy brand value label))))))
+
+  (structure: #export functor
+    (:~ (decorate Functor))
+    
+    (def: (map f fa)
+      (|> fa :representation f :abstraction)))
+
+  (structure: #export apply
+    (:~ (decorate Apply))
+    
+    (def: &functor ..functor)
+    (def: (apply ff fa)
+      (:abstraction ((:representation ff) (:representation fa)))))
+
+  (structure: #export monad
+    (:~ (decorate Monad))
+    
+    (def: &functor ..functor)
+    (def: wrap (|>> :abstraction))
+    (def: join (|>> :representation)))
+  )
+
+(template [<brand> <value> <upgrade> <downgrade>]
+  [(abstract: #export <brand>
+     {}
+     Any
+     
+     (type: #export <value> (Policy <brand>))
+     (type: #export <upgrade> (Can-Upgrade <brand>))
+     (type: #export <downgrade> (Can-Downgrade <brand>))
+     )]
+
+  [Privacy Private Can-Conceal Can-Reveal]
+  [Safety Safe Can-Trust Can-Distrust]
+  )
diff --git a/stdlib/source/lux/control/security/privacy.lux b/stdlib/source/lux/control/security/privacy.lux
deleted file mode 100644
index 4a54947b1..000000000
--- a/stdlib/source/lux/control/security/privacy.lux
+++ /dev/null
@@ -1,95 +0,0 @@
-(.module:
-  [lux #*
-   [abstract
-    [functor (#+ Functor)]
-    [apply (#+ Apply)]
-    [monad (#+ Monad)]]
-   [type
-    abstract]]
-  [//
-   ["!" capability (#+ capability:)]])
-
-(abstract: #export (Private value label)
-  {#.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 by 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
-
-  (capability: #export (Can-Conceal label value)
-    {#.doc (doc "Represents the capacity to 'privatize' a value.")}
-    (can-conceal value (Private value label)))
-
-  (capability: #export (Can-Reveal label value)
-    {#.doc (doc "Represents the capacity to 'publicize' a value.")}
-    (can-reveal (Private value label) value))
-
-  (type: #export (Privilege label)
-    {#.doc (doc "Represents the privilege to both 'privatize' and 'publicize' a value.")}
-    {#can-conceal (Can-Conceal label)
-     #can-reveal (Can-Reveal label)})
-
-  (def: Privilege<_>
-    Privilege
-    {#can-conceal (..can-conceal (|>> :abstraction))
-     #can-reveal (..can-reveal (|>> :representation))})
-
-  (type: #export (Delegation from to)
-    {#.doc (doc "Represents the act of delegating privatization capacities.")}
-    (All [value] (-> (Private value from) (Private value to))))
-
-  (def: #export (delegation reveal conceal)
-    {#.doc (doc "Delegating privatization capacities.")}
-    (All [from to] (-> (Can-Reveal from) (Can-Conceal to) (Delegation from to)))
-    (|>> (!.use reveal) (!.use conceal)))
-
-  (type: #export (Context scope label)
-    {#.doc (doc "A computational context with an associated privacy privilege.")}
-    (-> (Privilege label)
-        (scope label)))
-
-  (def: #export (with-privacy context)
-    {#.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 [scope]
-      (Ex [label]
-        (-> (Context scope label)
-            (scope label))))
-    (context ..Privilege<_>))
-
-  (def: (privatize constructor)
-    (-> Type Type)
-    (type (All [label] (constructor (All [value] (Private value label))))))
-
-  (structure: #export functor
-    (:~ (privatize Functor))
-    
-    (def: (map f fa)
-      (|> fa :representation f :abstraction)))
-
-  (structure: #export apply
-    (:~ (privatize Apply))
-    
-    (def: &functor ..functor)
-
-    (def: (apply ff fa)
-      (:abstraction ((:representation ff) (:representation fa)))))
-
-  (structure: #export monad
-    (:~ (privatize Monad))
-    
-    (def: &functor ..functor)
-
-    (def: wrap (|>> :abstraction))
-
-    (def: join (|>> :representation)))
-  )
diff --git a/stdlib/source/test/lux/control.lux b/stdlib/source/test/lux/control.lux
index ae2455e84..26fd02ab9 100644
--- a/stdlib/source/test/lux/control.lux
+++ b/stdlib/source/test/lux/control.lux
@@ -22,8 +22,7 @@
     ["#/." text]
     ["#/." cli]]
    [security
-    ["#." privacy]
-    ["#." integrity]]
+    ["#." policy]]
    ])
 
 (def: concurrency
@@ -46,8 +45,7 @@
 (def: security
   Test
   ($_ _.and
-      /privacy.test
-      /integrity.test
+      /policy.test
       ))
 
 (def: #export test
diff --git a/stdlib/source/test/lux/control/security/integrity.lux b/stdlib/source/test/lux/control/security/integrity.lux
deleted file mode 100644
index 77e0505d6..000000000
--- a/stdlib/source/test/lux/control/security/integrity.lux
+++ /dev/null
@@ -1,55 +0,0 @@
-(.module:
-  [lux #*
-   ["_" test (#+ Test)]
-   [abstract
-    [hash (#+ Hash)]
-    [monad (#+ do)]
-    {[0 #test]
-     [/
-      ["$." functor (#+ Injection Comparison)]
-      ["$." apply]
-      ["$." monad]]}]
-   [data
-    ["." error]
-    ["." text ("#;." equivalence)
-     format]]
-   [math
-    ["r" random]]]
-  {1
-   ["." / (#+ Dirty)]})
-
-(def: injection
-  (Injection Dirty)
-  /.taint)
-
-(def: comparison
-  (Comparison Dirty)
-  (function (_ == left right)
-    (== (/.trust left)
-        (/.trust right))))
-
-(def: #export test
-  Test
-  (<| (_.context (%name (name-of /.Dirty)))
-      (do r.monad
-        [raw (r.ascii 10)
-         #let [dirty (/.taint raw)]]
-        ($_ _.and
-            ($functor.spec ..injection ..comparison /.functor)
-            ($apply.spec ..injection ..comparison /.apply)
-            ($monad.spec ..injection ..comparison /.monad)
-
-            (_.test "Can clean a dirty value by trusting it."
-                    (text;= raw (/.trust dirty)))
-            (_.test "Can validate a dirty value."
-                    (case (/.validate (function (_ value)
-                                        (if (|> value text.size (n/> 0))
-                                          (#error.Success value)
-                                          (#error.Failure "Empty text is invalid.")))
-                                      dirty)
-                      (#error.Success clean)
-                      (text;= raw clean)
-
-                      (#error.Failure error)
-                      false))
-            ))))
diff --git a/stdlib/source/test/lux/control/security/policy.lux b/stdlib/source/test/lux/control/security/policy.lux
new file mode 100644
index 000000000..69c358e88
--- /dev/null
+++ b/stdlib/source/test/lux/control/security/policy.lux
@@ -0,0 +1,90 @@
+(.module:
+  [lux #*
+   ["_" test (#+ Test)]
+   [abstract
+    [hash (#+ Hash)]
+    [monad (#+ do)]
+    {[0 #test]
+     [/
+      ["$." functor (#+ Injection Comparison)]
+      ["$." apply]
+      ["$." monad]]}]
+   [control
+    [security
+     ["!" capability]]]
+   [data
+    ["." name]
+    ["." text ("#@." equivalence)
+     format]]
+   [math
+    ["r" random]]]
+  {1
+   ["." / (#+ Context Privacy Can-Conceal Can-Reveal Privilege Private with-policy)]})
+
+(def: (injection can-conceal)
+  (All [label]
+    (-> (Can-Conceal label) (Injection (All [value] (Private value label)))))
+  (!.use can-conceal))
+
+(def: (comparison can-reveal)
+  (All [label]
+    (-> (Can-Reveal label) (Comparison (All [value] (Private value label)))))
+  (function (_ == left right)
+    (== (!.use can-reveal left)
+        (!.use can-reveal right))))
+
+(type: Password (Private Text))
+
+(signature: (Policy %)
+  (: (Hash (Password %))
+     &hash)
+
+  (: (-> Text (Password %))
+     password)
+
+  (: (Privilege Privacy %)
+     privilege))
+
+(def: (policy _)
+  (Ex [%] (-> Any (Policy %)))
+  (with-policy
+    (: (Context Privacy Policy)
+       (function (_ (^@ privilege (^open "%@.")))
+         (structure
+          (def: &hash
+            (structure
+             (def: &equivalence
+               (structure (def: (= reference sample)
+                            (text@= (!.use %@can-downgrade reference)
+                                    (!.use %@can-downgrade sample)))))
+             (def: hash
+               (|>> (!.use %@can-downgrade)
+                    (:: text.hash hash)))))
+          
+          (def: password
+            (!.use %@can-upgrade))
+
+          (def: privilege
+            privilege))))))
+
+(def: #export test
+  Test
+  (<| (_.context (name.module (name-of /._)))
+      (do r.monad
+        [#let [policy-0 (policy [])]
+         raw-password (r.ascii 10)
+         #let [password (:: policy-0 password raw-password)]]
+        ($_ _.and
+            ($functor.spec (..injection (:: policy-0 can-upgrade)) (..comparison (:: policy-0 can-downgrade)) /.functor)
+            ($apply.spec (..injection (:: policy-0 can-upgrade)) (..comparison (:: policy-0 can-downgrade)) /.apply)
+            ($monad.spec (..injection (:: policy-0 can-upgrade)) (..comparison (:: policy-0 can-downgrade)) /.monad)
+
+            (_.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 [])
+                  delegate (/.delegation (:: policy-0 can-downgrade) (:: policy-1 can-upgrade))]
+              (_.test "Can use delegation to share private values between policies."
+                      (:: policy-1 = (delegate password) (delegate password))))
+            ))))
diff --git a/stdlib/source/test/lux/control/security/privacy.lux b/stdlib/source/test/lux/control/security/privacy.lux
deleted file mode 100644
index 3b167e0d2..000000000
--- a/stdlib/source/test/lux/control/security/privacy.lux
+++ /dev/null
@@ -1,89 +0,0 @@
-(.module:
-  [lux #*
-   ["_" test (#+ Test)]
-   [abstract
-    [hash (#+ Hash)]
-    [monad (#+ do)]
-    {[0 #test]
-     [/
-      ["$." functor (#+ Injection Comparison)]
-      ["$." apply]
-      ["$." monad]]}]
-   [control
-    [security
-     ["!" capability]]]
-   [data
-    ["." text ("#;." equivalence)
-     format]]
-   [math
-    ["r" random]]]
-  {1
-   ["." / (#+ Context Can-Conceal Can-Reveal Privilege Private with-privacy)]})
-
-(def: (injection can-conceal)
-  (All [label]
-    (-> (Can-Conceal label) (Injection (All [value] (Private value label)))))
-  (!.use can-conceal))
-
-(def: (comparison can-reveal)
-  (All [label]
-    (-> (Can-Reveal label) (Comparison (All [value] (Private value label)))))
-  (function (_ == left right)
-    (== (!.use can-reveal left)
-        (!.use can-reveal right))))
-
-(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: &equivalence
-               (structure (def: (= reference sample)
-                            (text;= (!.use %/can-reveal reference)
-                                    (!.use %/can-reveal sample)))))
-             (def: hash
-               (|>> (!.use %/can-reveal)
-                    (:: text.hash hash)))))
-          
-          (def: password
-            (!.use %/can-conceal))
-
-          (def: privilege
-            privilege))))))
-
-(def: #export test
-  Test
-  (<| (_.context (%name (name-of /.Private)))
-      (do r.monad
-        [#let [policy-0 (policy [])]
-         raw-password (r.ascii 10)
-         #let [password (:: policy-0 password raw-password)]]
-        ($_ _.and
-            ($functor.spec (..injection (:: policy-0 can-conceal)) (..comparison (:: policy-0 can-reveal)) /.functor)
-            ($apply.spec (..injection (:: policy-0 can-conceal)) (..comparison (:: policy-0 can-reveal)) /.apply)
-            ($monad.spec (..injection (:: policy-0 can-conceal)) (..comparison (:: policy-0 can-reveal)) /.monad)
-
-            (_.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 [])
-                  delegate (/.delegation (:: policy-0 can-reveal) (:: policy-1 can-conceal))]
-              (_.test "Can use delegation to share private values between policies."
-                      (:: policy-1 = (delegate password) (delegate password))))
-            ))))
-- 
cgit v1.2.3