aboutsummaryrefslogtreecommitdiff
path: root/stdlib/source/library/lux/control/security
diff options
context:
space:
mode:
authorEduardo Julian2021-07-14 13:59:02 -0400
committerEduardo Julian2021-07-14 13:59:02 -0400
commitd6c48ae6a8b58f5974133170863a31c70f0123d1 (patch)
tree008eb88328009e2f3f07002f35c0378a8a137ed0 /stdlib/source/library/lux/control/security
parent2431e767a09894c2f685911ba7f1ba0b7de2a165 (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.lux71
-rw-r--r--stdlib/source/library/lux/control/security/policy.lux93
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]
+ )