diff options
Diffstat (limited to '')
| -rw-r--r-- | stdlib/source/lux/control/security/privacy.lux | 51 | ||||
| -rw-r--r-- | stdlib/source/lux/type/abstract.lux | 23 | ||||
| -rw-r--r-- | stdlib/test/test/lux/control/security/privacy.lux | 55 |
3 files changed, 81 insertions, 48 deletions
diff --git a/stdlib/source/lux/control/security/privacy.lux b/stdlib/source/lux/control/security/privacy.lux index eeccbd57e..ad85ae679 100644 --- a/stdlib/source/lux/control/security/privacy.lux +++ b/stdlib/source/lux/control/security/privacy.lux @@ -7,10 +7,10 @@ [type abstract]]) -(abstract: #export (Private label value) +(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 in different policies." + "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.")} @@ -19,39 +19,60 @@ ## there to prevent confusing private values from different origins. value - (signature: #export (Privilege label value) - (: (-> value (Private label value)) + (type: #export (Close label) + (All [value] (-> value (Private value label)))) + + (type: #export (Open label) + (All [value] (-> (Private value label) value))) + + (signature: #export (Privilege label) + (: (Close label) conceal) - (: (-> (Private label value) value) + (: (Open label) reveal)) - (type: #export (Policy value scope label) - (-> (Privilege label value) + (def: Privilege<_> + Privilege + (structure (def: conceal (|>> :abstraction)) + (def: reveal (|>> :representation)))) + + (type: #export (Delegation from to) + (All [value] (-> (Private value from) (Private value to)))) + + (def: #export (delegation open close) + (All [from to] (-> (Open from) (Close to) (Delegation from to))) + (|>> open close)) + + (type: #export (Context scope label) + (-> (Privilege label) (scope label))) - (def: #export (with-privacy policy) + (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 [value scope] + (All [scope] (Ex [label] - (-> (Policy value scope label) + (-> (Context scope label) (scope label)))) - (policy (structure (def: conceal (|>> :abstraction)) - (def: reveal (|>> :representation))))) + (context ..Privilege<_>)) + + (def: (privatize constructor) + (-> Type Type) + (type (All [label] (constructor (All [value] (Private value label)))))) (structure: #export Functor<Private> - (All [label] (Functor (Private label))) + (:~ (privatize Functor)) (def: (map f fa) (|> fa :representation f :abstraction))) (structure: #export Apply<Private> - (All [label] (Apply (Private label))) + (:~ (privatize Apply)) (def: functor Functor<Private>) @@ -59,7 +80,7 @@ (:abstraction ((:representation ff) (:representation fa))))) (structure: #export Monad<Private> - (All [label] (Monad (Private label))) + (:~ (privatize Monad)) (def: functor Functor<Private>) diff --git a/stdlib/source/lux/type/abstract.lux b/stdlib/source/lux/type/abstract.lux index 4faea93cf..1ed24af1d 100644 --- a/stdlib/source/lux/type/abstract.lux +++ b/stdlib/source/lux/type/abstract.lux @@ -4,6 +4,7 @@ [monad (#+ do Monad)] ["p" parser]] [data + [name ("name/." Codec<Text,Name>)] [text ("text/." Equivalence<Text> Monoid<Text>)] ["." error] [collection @@ -59,9 +60,12 @@ (def: macro-anns Code (' {#.macro? #1})) (def: representation-name - (-> Text Text) - (|>> ($_ text/compose "{" kind "@" module "}") - (let [[module kind] (name-of #..Representation)]))) + (-> Name Text) + (|>> name/encode + ($_ text/compose + "{" + (name/encode (name-of #..Representation)) + "} "))) (def: (cast type-vars input-declaration output-declaration) (-> (List Code) Code Code Macro) @@ -80,7 +84,8 @@ [this-module (macro.find-module this-module-name) #let [type-varsC (list/map code.local-identifier type-vars) abstraction-declaration (` ((~ (code.local-identifier name)) (~+ type-varsC))) - representation-declaration (` ((~ (code.local-identifier (representation-name name))) (~+ type-varsC))) + representation-declaration (` ((~ (code.local-identifier (representation-name [this-module-name name]))) + (~+ type-varsC))) this-module (|> this-module (update@ #.definitions (put down-cast (: Definition [Macro macro-anns @@ -143,10 +148,12 @@ {annotations (p.default cs.empty-annotations csr.annotations)} representation-type {primitives (p.some s.any)}) - (let [hidden-name (representation-name name) - type-varsC (list/map code.local-identifier type-vars) - abstraction-declaration (` ((~ (code.local-identifier name)) (~+ type-varsC))) - representation-declaration (` ((~ (code.local-identifier hidden-name)) (~+ type-varsC)))] + (do @ + [current-module macro.current-module-name + #let [hidden-name (representation-name [current-module name]) + type-varsC (list/map code.local-identifier type-vars) + abstraction-declaration (` ((~ (code.local-identifier name)) (~+ type-varsC))) + representation-declaration (` ((~ (code.local-identifier hidden-name)) (~+ type-varsC)))]] (wrap (list& (` (type: (~+ (csw.export export)) (~ abstraction-declaration) (~ (csw.annotations annotations)) (primitive (~ (code.text hidden-name)) [(~+ type-varsC)]))) diff --git a/stdlib/test/test/lux/control/security/privacy.lux b/stdlib/test/test/lux/control/security/privacy.lux index 14ef98a15..37415bf30 100644 --- a/stdlib/test/test/lux/control/security/privacy.lux +++ b/stdlib/test/test/lux/control/security/privacy.lux @@ -4,7 +4,7 @@ [hash (#+ Hash)] [monad (#+ do)] [security - ["@" privacy (#+ Private Policy with-privacy)]]] + ["@" privacy (#+ Context Privilege Private with-privacy)]]] [data ["." text ("text/." Equivalence<Text>) format]] @@ -12,18 +12,23 @@ ["r" random]]] lux/test) -(signature: (Password %) - (: (Hash (Private % Text)) +(type: Password (Private Text)) + +(signature: (Policy %) + (: (Hash (Password %)) &hash) - (: (-> Text (Private % Text)) - password)) + (: (-> Text (Password %)) + password) + + (: (Privilege %) + privilege)) -(def: (Password<%> _) - (Ex [%] (-> Any (Password %))) +(def: (policy _) + (Ex [%] (-> Any (Policy %))) (with-privacy - (: (Policy Text Password) - (function (_ (^open "%/.")) + (: (Context Policy) + (function (_ (^@ privilege (^open "%/."))) (structure (def: &hash (structure @@ -36,35 +41,35 @@ (:: text.Hash<Text> hash))))) (def: password - %/conceal)))))) + %/conceal) + + (def: privilege privilege)))))) (context: "Policy labels." (do @ - [#let [Password<%>0 (Password<%> 0)] + [#let [policy-0 (policy 0)] raw-password (r.ascii 10) - #let [password (:: Password<%>0 password raw-password)]] + #let [password (:: policy-0 password raw-password)]] ($_ seq (test "Can work with private values under the same label." - (and (:: Password<%>0 = password password) + (and (:: policy-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))) + (:: 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))) - Password<%>0 (Password<%> 0)] + policy-0 (policy 0)] raw-password (r.ascii 10) - #let [password (:: Password<%>0 password raw-password)] - #let [check (:: Password<%>0 = - (:: Password<%>0 password (duplicate raw-password))) + #let [password (:: policy-0 password raw-password)] + #let [check (:: policy-0 = + (:: policy-0 password (duplicate raw-password))) (^open "@/.") @.Functor<Private> (^open "@/.") @.Apply<Private> (^open "@/.") @.Monad<Private>]] @@ -75,6 +80,6 @@ (check (@/apply (@/wrap duplicate) password))) (test "Can use Monad." (check (do @.Monad<Private> - [raw-password' (:: Password<%>0 password raw-password)] + [raw-password' (:: policy-0 password raw-password)] (wrap (duplicate raw-password'))))) ))) |