Made some improvements to value taining, and added some tests.

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)))))
+        )))