diff options
author | Eduardo Julian | 2021-07-14 13:59:02 -0400 |
---|---|---|
committer | Eduardo Julian | 2021-07-14 13:59:02 -0400 |
commit | d6c48ae6a8b58f5974133170863a31c70f0123d1 (patch) | |
tree | 008eb88328009e2f3f07002f35c0378a8a137ed0 /stdlib/source/library/lux/control/security | |
parent | 2431e767a09894c2f685911ba7f1ba0b7de2a165 (diff) |
Normalized the hierarchy of the standard library modules.
Diffstat (limited to 'stdlib/source/library/lux/control/security')
-rw-r--r-- | stdlib/source/library/lux/control/security/capability.lux | 71 | ||||
-rw-r--r-- | stdlib/source/library/lux/control/security/policy.lux | 93 |
2 files changed, 164 insertions, 0 deletions
diff --git a/stdlib/source/library/lux/control/security/capability.lux b/stdlib/source/library/lux/control/security/capability.lux new file mode 100644 index 000000000..13ae40d15 --- /dev/null +++ b/stdlib/source/library/lux/control/security/capability.lux @@ -0,0 +1,71 @@ +(.module: + [library + [lux #* + [abstract + [monad (#+ do)]] + [control + ["<>" parser + ["<c>" code]] + ["." io (#+ IO)] + [concurrency + ["." promise (#+ Promise)]]] + [data + [text + ["%" format (#+ format)]] + [collection + ["." list ("#\." functor)]]] + [type + abstract] + ["." meta] + ["." macro + ["." code] + [syntax (#+ syntax:) + ["|.|" export] + ["|.|" declaration] + ["|.|" annotations]]]]]) + +(abstract: #export (Capability brand input output) + (-> input output) + + {#.doc (doc "Represents the capability to perform an operation." + "This operation is assumed to have security implications.")} + + (def: forge + (All [brand input output] + (-> (-> input output) + (Capability brand input output))) + (|>> :abstraction)) + + (def: #export (use capability input) + (All [brand input output] + (-> (Capability brand input output) + input + output)) + ((:representation capability) input)) + + (syntax: #export (capability: {export |export|.parser} + {declaration |declaration|.parser} + {annotations (<>.maybe |annotations|.parser)} + {[forge input output] (<c>.form ($_ <>.and <c>.local_identifier <c>.any <c>.any))}) + (do {! meta.monad} + [this_module meta.current_module_name + #let [[name vars] declaration] + g!brand (\ ! map (|>> %.code code.text) + (macro.gensym (format (%.name [this_module name])))) + #let [capability (` (..Capability (.primitive (~ g!brand)) (~ input) (~ output)))]] + (wrap (list (` (type: (~+ (|export|.format export)) + (~ (|declaration|.format declaration)) + (~ capability))) + (` (def: (~ (code.local_identifier forge)) + (All [(~+ (list\map code.local_identifier vars))] + (-> (-> (~ input) (~ output)) + (~ capability))) + (~! ..forge))) + )))) + + (def: #export (async capability) + (All [brand input output] + (-> (Capability brand input (IO output)) + (Capability brand input (Promise output)))) + (..forge (|>> ((:representation capability)) promise.future))) + ) diff --git a/stdlib/source/library/lux/control/security/policy.lux b/stdlib/source/library/lux/control/security/policy.lux new file mode 100644 index 000000000..3c1eb579e --- /dev/null +++ b/stdlib/source/library/lux/control/security/policy.lux @@ -0,0 +1,93 @@ +(.module: + [library + [lux #* + [abstract + [functor (#+ Functor)] + [apply (#+ Apply)] + [monad (#+ Monad)]] + [type + abstract]]]) + +(abstract: #export (Policy brand value label) + value + + (type: #export (Can_Upgrade brand label value) + {#.doc (doc "Represents the capacity to 'upgrade' a value.")} + (-> value (Policy brand value label))) + + (type: #export (Can_Downgrade brand label value) + {#.doc (doc "Represents the capacity to 'downgrade' a value.")} + (-> (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 (|>> :abstraction) + #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))) + (|>> downgrade 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)))))) + + (implementation: #export functor + (:~ (decorate Functor)) + + (def: (map f fa) + (|> fa :representation f :abstraction))) + + (implementation: #export apply + (:~ (decorate Apply)) + + (def: &functor ..functor) + (def: (apply ff fa) + (:abstraction ((:representation ff) (:representation fa))))) + + (implementation: #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] + ) |