aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--stdlib/source/lux/control/security/taint.lux45
-rw-r--r--stdlib/source/lux/data/tainted.lux28
-rw-r--r--stdlib/test/test/lux/control/security/taint.lux49
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)))))
+ )))