From 1bce0132321794e421508ae687c9b1b68725a088 Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Sat, 4 May 2019 01:06:24 -0400 Subject: - Replaced "Dirty" values with "Safe" values. - Generalized "Safety" and "Privacy" as instances of "Policy". --- stdlib/source/test/lux/control.lux | 6 +- .../source/test/lux/control/security/integrity.lux | 55 ------------- stdlib/source/test/lux/control/security/policy.lux | 90 ++++++++++++++++++++++ .../source/test/lux/control/security/privacy.lux | 89 --------------------- 4 files changed, 92 insertions(+), 148 deletions(-) delete mode 100644 stdlib/source/test/lux/control/security/integrity.lux create mode 100644 stdlib/source/test/lux/control/security/policy.lux delete mode 100644 stdlib/source/test/lux/control/security/privacy.lux (limited to 'stdlib/source/test') 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/policy.lux b/stdlib/source/test/lux/control/security/policy.lux new file mode 100644 index 000000000..69c358e88 --- /dev/null +++ b/stdlib/source/test/lux/control/security/policy.lux @@ -0,0 +1,90 @@ +(.module: + [lux #* + ["_" test (#+ Test)] + [abstract + [hash (#+ Hash)] + [monad (#+ do)] + {[0 #test] + [/ + ["$." functor (#+ Injection Comparison)] + ["$." apply] + ["$." monad]]}] + [control + [security + ["!" capability]]] + [data + ["." name] + ["." text ("#@." equivalence) + format]] + [math + ["r" random]]] + {1 + ["." / (#+ Context Privacy Can-Conceal Can-Reveal Privilege Private with-policy)]}) + +(def: (injection can-conceal) + (All [label] + (-> (Can-Conceal label) (Injection (All [value] (Private value label))))) + (!.use can-conceal)) + +(def: (comparison can-reveal) + (All [label] + (-> (Can-Reveal label) (Comparison (All [value] (Private value label))))) + (function (_ == left right) + (== (!.use can-reveal left) + (!.use can-reveal right)))) + +(type: Password (Private Text)) + +(signature: (Policy %) + (: (Hash (Password %)) + &hash) + + (: (-> Text (Password %)) + password) + + (: (Privilege Privacy %) + privilege)) + +(def: (policy _) + (Ex [%] (-> Any (Policy %))) + (with-policy + (: (Context Privacy Policy) + (function (_ (^@ privilege (^open "%@."))) + (structure + (def: &hash + (structure + (def: &equivalence + (structure (def: (= reference sample) + (text@= (!.use %@can-downgrade reference) + (!.use %@can-downgrade sample))))) + (def: hash + (|>> (!.use %@can-downgrade) + (:: text.hash hash))))) + + (def: password + (!.use %@can-upgrade)) + + (def: privilege + privilege)))))) + +(def: #export test + Test + (<| (_.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-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-downgrade) (:: policy-1 can-upgrade))] + (_.test "Can use delegation to share private values between policies." + (:: policy-1 = (delegate password) (delegate password)))) + )))) diff --git a/stdlib/source/test/lux/control/security/privacy.lux b/stdlib/source/test/lux/control/security/privacy.lux deleted file mode 100644 index 3b167e0d2..000000000 --- a/stdlib/source/test/lux/control/security/privacy.lux +++ /dev/null @@ -1,89 +0,0 @@ -(.module: - [lux #* - ["_" test (#+ Test)] - [abstract - [hash (#+ Hash)] - [monad (#+ do)] - {[0 #test] - [/ - ["$." functor (#+ Injection Comparison)] - ["$." apply] - ["$." monad]]}] - [control - [security - ["!" capability]]] - [data - ["." text ("#;." equivalence) - format]] - [math - ["r" random]]] - {1 - ["." / (#+ Context Can-Conceal Can-Reveal Privilege Private with-privacy)]}) - -(def: (injection can-conceal) - (All [label] - (-> (Can-Conceal label) (Injection (All [value] (Private value label))))) - (!.use can-conceal)) - -(def: (comparison can-reveal) - (All [label] - (-> (Can-Reveal label) (Comparison (All [value] (Private value label))))) - (function (_ == left right) - (== (!.use can-reveal left) - (!.use can-reveal right)))) - -(type: Password (Private Text)) - -(signature: (Policy %) - (: (Hash (Password %)) - &hash) - - (: (-> Text (Password %)) - password) - - (: (Privilege %) - privilege)) - -(def: (policy _) - (Ex [%] (-> Any (Policy %))) - (with-privacy - (: (Context Policy) - (function (_ (^@ privilege (^open "%/."))) - (structure - (def: &hash - (structure - (def: &equivalence - (structure (def: (= reference sample) - (text;= (!.use %/can-reveal reference) - (!.use %/can-reveal sample))))) - (def: hash - (|>> (!.use %/can-reveal) - (:: text.hash hash))))) - - (def: password - (!.use %/can-conceal)) - - (def: privilege - privilege)))))) - -(def: #export test - Test - (<| (_.context (%name (name-of /.Private))) - (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) - - (_.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))] - (_.test "Can use delegation to share private values between policies." - (:: policy-1 = (delegate password) (delegate password)))) - )))) -- cgit v1.2.3