diff options
| -rw-r--r-- | stdlib/source/lux/control/security/integrity.lux | 51 | ||||
| -rw-r--r-- | stdlib/source/lux/control/security/policy.lux | 95 | ||||
| -rw-r--r-- | stdlib/source/lux/control/security/privacy.lux | 95 | ||||
| -rw-r--r-- | stdlib/source/test/lux/control.lux | 6 | ||||
| -rw-r--r-- | stdlib/source/test/lux/control/security/integrity.lux | 55 | ||||
| -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)))) )))) |