diff options
Diffstat (limited to 'stdlib')
-rw-r--r-- | stdlib/source/lux/control/security/taint.lux | 45 | ||||
-rw-r--r-- | stdlib/source/lux/data/tainted.lux | 28 | ||||
-rw-r--r-- | stdlib/test/test/lux/control/security/taint.lux | 49 |
3 files changed, 94 insertions, 28 deletions
diff --git a/stdlib/source/lux/control/security/taint.lux b/stdlib/source/lux/control/security/taint.lux new file mode 100644 index 000000000..745baa95f --- /dev/null +++ b/stdlib/source/lux/control/security/taint.lux @@ -0,0 +1,45 @@ +(.module: + [lux #* + [control + [predicate (#+ Predicate)] + [functor (#+ Functor)] + [apply (#+ Apply)] + [monad (#+ Monad)]] + [type + abstract]]) + +(abstract: #export (Dirty a) + a + + (def: #export taint + (All [a] (-> a (Dirty a))) + (|>> :abstraction)) + + (def: #export (validate valid? dirty) + (All [a] (-> (Predicate a) (Dirty a) (Maybe a))) + (let [value (:representation dirty)] + (if (valid? value) + (#.Some value) + #.None))) + + (def: #export trust + (All [a] (-> (Dirty a) a)) + (|>> :representation)) + + (structure: #export _ (Functor Dirty) + (def: (map f fa) + (|> fa :representation f :abstraction))) + + (structure: #export _ (Apply Dirty) + (def: functor Functor<Dirty>) + + (def: (apply ff fa) + (:abstraction ((:representation ff) (:representation fa))))) + + (structure: #export _ (Monad Dirty) + (def: functor Functor<Dirty>) + + (def: wrap (|>> :abstraction)) + + (def: join (|>> :representation))) + ) diff --git a/stdlib/source/lux/data/tainted.lux b/stdlib/source/lux/data/tainted.lux deleted file mode 100644 index 7ff754081..000000000 --- a/stdlib/source/lux/data/tainted.lux +++ /dev/null @@ -1,28 +0,0 @@ -(.module: - [lux #* - [data - [product]] - [type - abstract]]) - -(abstract: #export (Tainted a) - a - - (def: #export taint - (All [a] (-> a (Tainted a))) - (|>> :abstraction)) - - (def: #export trust - (All [a] (-> (Tainted a) a)) - (|>> :representation))) - -(def: #export (validate pred tainted) - (All [a] (-> (-> a Bit) (Tainted a) (Maybe a))) - (let [value (trust tainted)] - (if (pred value) - (#.Some value) - #.None))) - -(def: #export (sanitize f tainted) - (All [a] (-> (-> a a) (Tainted a) a)) - (|> tainted trust f)) diff --git a/stdlib/test/test/lux/control/security/taint.lux b/stdlib/test/test/lux/control/security/taint.lux new file mode 100644 index 000000000..0b18111ef --- /dev/null +++ b/stdlib/test/test/lux/control/security/taint.lux @@ -0,0 +1,49 @@ +(.module: + [lux #* + [control + [hash (#+ Hash)] + [monad (#+ do)] + [security + ["@" taint]]] + [data + ["." text ("text/." Equivalence<Text>) + format]] + [math + ["r" random]]] + lux/test) + +(context: "Taint." + (do @ + [raw (r.ascii 10) + #let [dirty (@.taint raw)]] + ($_ seq + (test "Can clean a tainted value by trusting it." + (text/= raw (@.trust dirty))) + (test "Can validate a tainted value." + (case (@.validate (|>> text.size (n/> 0)) dirty) + (#.Some clean) + (text/= raw clean) + + #.None + false)) + ))) + +(context: "Structures." + (do @ + [#let [duplicate (: (-> Text Text) + (function (_ raw) (format raw raw)))] + raw (r.ascii 10) + #let [check (|>> @.trust (text/= (duplicate raw))) + (^open "@/.") @.Functor<Dirty> + (^open "@/.") @.Apply<Dirty> + (^open "@/.") @.Monad<Dirty>]] + ($_ seq + (test "Can use Functor." + (check (@/map duplicate (@.taint raw)))) + (test "Can use Apply." + (check (@/apply (@/wrap duplicate) (@.taint raw)))) + (test "Can use Monad." + (check (do @.Monad<Dirty> + [dirty (@.taint raw)] + (wrap (duplicate dirty))))) + ))) |