aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--stdlib/source/lux/control/security/integrity.lux51
-rw-r--r--stdlib/source/lux/control/security/policy.lux95
-rw-r--r--stdlib/source/lux/control/security/privacy.lux95
-rw-r--r--stdlib/source/test/lux/control.lux6
-rw-r--r--stdlib/source/test/lux/control/security/integrity.lux55
-rw-r--r--stdlib/source/test/lux/control/security/policy.lux (renamed from stdlib/source/test/lux/control/security/privacy.lux)31
6 files changed, 113 insertions, 220 deletions
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/privacy.lux b/stdlib/source/test/lux/control/security/policy.lux
index 3b167e0d2..69c358e88 100644
--- a/stdlib/source/test/lux/control/security/privacy.lux
+++ b/stdlib/source/test/lux/control/security/policy.lux
@@ -13,12 +13,13 @@
[security
["!" capability]]]
[data
- ["." text ("#;." equivalence)
+ ["." name]
+ ["." text ("#@." equivalence)
format]]
[math
["r" random]]]
{1
- ["." / (#+ Context Can-Conceal Can-Reveal Privilege Private with-privacy)]})
+ ["." / (#+ Context Privacy Can-Conceal Can-Reveal Privilege Private with-policy)]})
(def: (injection can-conceal)
(All [label]
@@ -41,49 +42,49 @@
(: (-> Text (Password %))
password)
- (: (Privilege %)
+ (: (Privilege Privacy %)
privilege))
(def: (policy _)
(Ex [%] (-> Any (Policy %)))
- (with-privacy
- (: (Context Policy)
- (function (_ (^@ privilege (^open "%/.")))
+ (with-policy
+ (: (Context Privacy Policy)
+ (function (_ (^@ privilege (^open "%@.")))
(structure
(def: &hash
(structure
(def: &equivalence
(structure (def: (= reference sample)
- (text;= (!.use %/can-reveal reference)
- (!.use %/can-reveal sample)))))
+ (text@= (!.use %@can-downgrade reference)
+ (!.use %@can-downgrade sample)))))
(def: hash
- (|>> (!.use %/can-reveal)
+ (|>> (!.use %@can-downgrade)
(:: text.hash hash)))))
(def: password
- (!.use %/can-conceal))
+ (!.use %@can-upgrade))
(def: privilege
privilege))))))
(def: #export test
Test
- (<| (_.context (%name (name-of /.Private)))
+ (<| (_.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-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)
+ ($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-reveal) (:: policy-1 can-conceal))]
+ 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))))
))))