Now tainting values coming from the outside world.

7 files changed, 255 insertions, 215 deletions

diff --git a/stdlib/source/lux/control/security/taint.lux b/stdlib/source/lux/control/security/taint.lux
index 745baa95f..afdc1904c 100644
--- a/stdlib/source/lux/control/security/taint.lux
+++ b/stdlib/source/lux/control/security/taint.lux
@@ -1,10 +1,11 @@
 (.module:
   [lux #*
    [control
-    [predicate (#+ Predicate)]
     [functor (#+ Functor)]
     [apply (#+ Apply)]
     [monad (#+ Monad)]]
+   [data
+    [error (#+ Error)]]
    [type
     abstract]])
 
@@ -15,12 +16,9 @@
     (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 (validate validator dirty)
+    (All [a b] (-> (-> a (Error b)) (Dirty a) (Error b)))
+    (validator (:representation dirty)))
 
   (def: #export trust
     (All [a] (-> (Dirty a) a))
diff --git a/stdlib/source/lux/world/console.lux b/stdlib/source/lux/world/console.lux
index cf7d2f2d4..99d290479 100644
--- a/stdlib/source/lux/world/console.lux
+++ b/stdlib/source/lux/world/console.lux
@@ -2,15 +2,20 @@
   [lux #*
    [control
     [monad (#+ do)]
-    ["ex" exception (#+ exception:)]]
+    ["ex" exception (#+ exception:)]
+    [security
+     ["." taint (#+ Dirty taint)]]]
    [data
-    ["." error]
+    ["." error (#+ Error)]
     ["." text
      format]]
    ["." io (#+ IO Process io)]
+   [concurrency
+    ["." promise (#+ Promise)]]
    [host (#+ import:)]
-   [compiler
-    ["." host]]])
+   [platform
+    [compiler
+     ["." host]]]])
 
 (do-template [<name>]
   [(exception: #export (<name>)
@@ -21,15 +26,22 @@
   )
 
 (signature: #export (Console !)
-  (: (-> [] (! Nat))
+  (: (-> Any (! (Error (Dirty Nat))))
      read)
-  (: (-> [] (! Text))
+  (: (-> Any (! (Error (Dirty Text))))
      read-line)
-  (: (-> Text (! Any))
+  (: (-> Text (! (Error Any)))
      write)
-  (: (-> [] (! Any))
+  (: (-> Any (! (Error Any)))
      close))
 
+(def: #export (async console)
+  (-> (Console IO) (Console Promise))
+  (`` (structure (~~ (do-template [<capability>]
+                       [(def: <capability> (|>> (:: console <capability>) promise.future))]
+
+                       [read] [read-line] [write] [close])))))
+
 (`` (for {(~~ (static host.jvm))
           (as-is (import: java/lang/String)
 
@@ -47,8 +59,8 @@
                    (#static in java/io/InputStream)
                    (#static out java/io/PrintStream))
 
-                 (def: #export open
-                   (Process (Console Process))
+                 (def: #export system
+                   (IO (Error (Console IO)))
                    (do io.Monad<IO>
                      [?jvm-console (System::console)]
                      (case ?jvm-console
@@ -60,15 +72,17 @@
                              jvm-output (System::out)]
                          (<| io.from-io
                              wrap
-                             (: (Console Process)) ## TODO: Remove ASAP
+                             (: (Console IO)) ## TODO: Remove ASAP
                              (structure
                               (def: (read _)
                                 (|> jvm-input
                                     InputStream::read
-                                    (:: io.Functor<Process> map .nat)))
+                                    (:: io.Functor<Process> map (|>> .nat taint))))
                               
                               (def: (read-line _)
-                                (java/io/Console::readLine jvm-console))
+                                (|> jvm-console
+                                    java/io/Console::readLine
+                                    (:: io.Functor<Process> map taint)))
                               
                               (def: (write message)
                                 (PrintStream::print message jvm-output))
diff --git a/stdlib/source/lux/world/environment.jvm.lux b/stdlib/source/lux/world/environment.jvm.lux
index 2a64c31f8..57ffcd465 100644
--- a/stdlib/source/lux/world/environment.jvm.lux
+++ b/stdlib/source/lux/world/environment.jvm.lux
@@ -1,5 +1,8 @@
 (.module:
   [lux #*
+   [control
+    [security
+     ["." taint (#+ Dirty taint)]]]
    [data
     ["." text]
     [format
@@ -9,6 +12,9 @@
    [io (#- run)]
    [host (#+ import:)]])
 
+## Do not trust the values of environment variables
+## https://wiki.sei.cmu.edu/confluence/display/java/ENV02-J.+Do+not+trust+the+values+of+environment+variables
+
 (import: java/lang/String)
 
 (import: (java/util/Map$Entry k v)
@@ -41,9 +47,10 @@
    (Map$Entry::getValue entry)])
 
 (def: #export read
-  (IO Context)
+  (IO (Dirty Context))
   (io (|> (System::getenv)
           Map::entrySet
           Set::iterator
           (consume-iterator entry-to-kv)
-          (dictionary.from-list text.Hash<Text>))))
+          (dictionary.from-list text.Hash<Text>)
+          taint)))
diff --git a/stdlib/source/lux/world/file.lux b/stdlib/source/lux/world/file.lux
index e97668917..9b53e4453 100644
--- a/stdlib/source/lux/world/file.lux
+++ b/stdlib/source/lux/world/file.lux
@@ -2,7 +2,9 @@
   [lux #*
    [control
     ["." monad (#+ Monad do)]
-    ["ex" exception (#+ Exception exception:)]]
+    ["ex" exception (#+ Exception exception:)]
+    [security
+     ["." taint (#+ Dirty taint)]]]
    [data
     ["." maybe]
     ["." error (#+ Error)]
@@ -15,10 +17,13 @@
     ["." duration]]
    [world
     ["." binary (#+ Binary)]]
-   ["." io (#+ Process)]
+   ["." io (#+ IO)]
+   [concurrency
+    ["." promise (#+ Promise)]]
    [host (#+ import:)]
-   [compiler
-    ["." host]]])
+   [platform
+    [compiler
+     ["." host]]]])
 
 (type: #export File Text)
 
@@ -28,63 +33,70 @@
   #Execute)
 
 (signature: #export (System !)
-  (: (Monad !)
-     &monad)
-
-  (: (All [e a] (-> (Exception e) e (! a)))
-     throw)
-
-  (: (All [a] (-> (! a) (! (Error a))))
-     try)
-
-  (: (All [a] (-> (Error a) (! a)))
-     lift)
-  
   (do-template [<name>]
-    [(: (-> Binary File (! Any))
+    [(: (-> Binary File (! (Error Any)))
         <name>)]
 
     [append]
     [write])
 
   (do-template [<name> <output>]
-    [(: (-> File (! <output>))
+    [(: (-> File (! (Error <output>)))
         <name>)]
 
-    [read Binary]
+    [read (Dirty Binary)]
     [size Nat]
     [files (List File)]
     [last-modified Instant])
 
   (do-template [<name>]
-    [(: (-> File (! Bit))
+    [(: (-> File (! (Error Bit)))
         <name>)]
 
     [file?]
     [directory?]
     )
 
-  (: (-> Permission File (! Bit))
+  (: (-> Permission File (! (Error Bit)))
      can?)
 
   (do-template [<name>]
-    [(: (-> File (! Any))
+    [(: (-> File (! (Error Any)))
         <name>)]
 
     [make-directory]
     [delete]
     )
 
-  (: (-> File File (! Any))
+  (: (-> File File (! (Error Any)))
      move)
 
-  (: (-> Instant File (! Any))
+  (: (-> Instant File (! (Error Any)))
      modify)
 
   (: Text
      separator)
   )
 
+(def: #export (async system)
+  (-> (System IO) (System Promise))
+  (`` (structure
+       (~~ (do-template [<name>]
+             [(def: (<name> parameter file)
+                (promise.future (:: system <name> parameter file)))]
+
+             [append] [write]
+             [can?] [move] [modify]))
+
+       (~~ (do-template [<name>]
+             [(def: <name> (|>> (:: system <name>) promise.future))]
+
+             [read] [size] [files] [last-modified]
+             [file?] [directory?]
+             [make-directory] [delete]))
+
+       (def: separator (:: system separator)))))
+
 (def: #export (un-nest System<!> file)
   (All [!] (-> (System !) File (Maybe [File Text])))
   (case (text.last-index-of (:: System<!> separator) file)
@@ -152,18 +164,7 @@
                  (import: java/io/FileInputStream
                    (new [java/io/File] #io #try))
 
-                 (structure: #export JVM@System (System Process)
-                   (def: &monad io.Monad<Process>)
-
-                   (def: throw io.throw)
-
-                   (def: (try computation)
-                     (do io.Monad<IO>
-                       [outcome computation]
-                       (:: io.Monad<Process> wrap outcome)))
-
-                   (def: lift (:: io.Monad<IO> wrap))
-                   
+                 (structure: #export _ (System IO)
                    (do-template [<name> <flag>]
                      [(def: (<name> data file)
                         (do io.Monad<Process>
@@ -185,7 +186,7 @@
                         bytes-read (InputStream::read data stream)
                         _ (AutoCloseable::close stream)]
                        (if (i/= size bytes-read)
-                         (wrap data)
+                         (wrap (taint data))
                          (io.io (ex.throw cannot-read-all-data file)))))
 
                    (def: size
@@ -258,9 +259,9 @@
                    ))
           }))
 
-(def: #export (exists? System<!> file)
-  (All [!] (-> (System !) File (! Bit)))
-  (do (:: System<!> &monad)
+(def: #export (exists? Monad<!> System<!> file)
+  (All [!] (-> (Monad !) (System !) File (! (Error Bit))))
+  (do (error.ErrorT Monad<!>)
     [??? (:: System<!> file? file)]
     (if ???
       (wrap ???)
diff --git a/stdlib/source/lux/world/net.lux b/stdlib/source/lux/world/net.lux
index c7e597a66..867430af0 100644
--- a/stdlib/source/lux/world/net.lux
+++ b/stdlib/source/lux/world/net.lux
@@ -2,4 +2,9 @@
   lux)
 
 (type: #export Address Text)
+
 (type: #export Port Nat)
+
+(type: #export Location
+  {#address Address
+   #port Port})
diff --git a/stdlib/source/lux/world/net/tcp.jvm.lux b/stdlib/source/lux/world/net/tcp.jvm.lux
index 50191c407..329d256e0 100644
--- a/stdlib/source/lux/world/net/tcp.jvm.lux
+++ b/stdlib/source/lux/world/net/tcp.jvm.lux
@@ -1,19 +1,22 @@
 (.module:
   [lux #*
    [control
-    monad]
+    monad
+    [security
+     ["." taint (#+ Dirty taint)]]]
    [concurrency
     ["." promise (#+ Promise promise)]
     [task (#+ Task)]
     ["." frp]]
    [data
-    ["e" error]]
-   [type
-    abstract]
+    ["." error (#+ Error)]]
    [world
-    [binary (#+ Binary)]]
-   ["." io (#+ Process)]
-   [host (#+ import:)]]
+    ["." binary (#+ Binary)]]
+   ["." io (#+ IO)]
+   [host (#+ import:)]
+   [platform
+    [compiler
+     ["." host]]]]
   ["." //])
 
 (import: java/lang/AutoCloseable
@@ -30,8 +33,8 @@
 
 (import: java/net/Socket
   (new [String int] #io #try)
-  (getInputStream [] #io #try InputStream)
-  (getOutputStream [] #io #try OutputStream))
+  (getInputStream [] #try InputStream)
+  (getOutputStream [] #try OutputStream))
 
 (import: java/net/ServerSocket
   (new [int] #io #try)
@@ -41,80 +44,80 @@
 ############################################################
 ############################################################
 
-(abstract: #export TCP {}
-  {#socket Socket
-   #in InputStream
-   #out OutputStream}
-  
-  (def: #export (read data offset length self)
-    (-> Binary Nat Nat TCP (Task Nat))
-    (promise.future
-     (do io.Monad<Process>
-       [bytes-read (InputStream::read data (.int offset) (.int length)
-                                      (get@ #in (:representation self)))]
-       (wrap (.nat bytes-read)))))
-  
-  (def: #export (write data offset length self)
-    (-> Binary Nat Nat TCP (Task Any))
-    (let [out (get@ #out (:representation self))]
-      (promise.future
-       (do io.Monad<Process>
-         [_ (OutputStream::write data (.int offset) (.int length)
-                                 out)]
-         (Flushable::flush out)))))
-
-  (def: #export (close self)
-    (-> TCP (Task Any))
-    (let [(^open ".") (:representation self)]
-      (promise.future
-       (do io.Monad<Process>
-         [_ (AutoCloseable::close in)
-          _ (AutoCloseable::close out)]
-         (AutoCloseable::close socket)))))
-
-  (def: (tcp-client socket)
-    (-> Socket (Process TCP))
-    (do io.Monad<Process>
-      [input (Socket::getInputStream socket)
-       output (Socket::getOutputStream socket)]
-      (wrap (:abstraction {#socket socket
-                           #in input
-                           #out output}))))
-  )
-
-(def: #export (client address port)
-  (-> //.Address //.Port (Task TCP))
-  (promise.future
-   (do io.Monad<Process>
-     [socket (Socket::new address (.int port))]
-     (tcp-client socket))))
-
-(def: #export (server port)
-  (-> //.Port (Task [(Promise Any)
-                     (frp.Channel TCP)]))
-  (promise.future
-   (do (e.ErrorT io.Monad<IO>)
-     [server (ServerSocket::new (.int port))
-      #let [signal (: (Promise Any)
-                      (promise #.None))
-            _ (promise.await (function (_ _)
-                               (AutoCloseable::close server))
-                             signal)
-            output (: (frp.Channel TCP)
-                      (frp.channel []))
-            _ (: (Promise Any)
-                 (promise.future
-                  (loop [_ []]
-                    (do io.Monad<IO>
-                      [?client (do (e.ErrorT io.Monad<IO>)
-                                 [socket (ServerSocket::accept server)]
-                                 (tcp-client socket))]
-                      (case ?client
-                        (#e.Error error)
-                        (wrap [])
-                        
-                        (#e.Success client)
-                        (do @
-                          [_ (frp.publish output client)]
-                          (recur [])))))))]]
-     (wrap [signal output]))))
+(signature: #export (TCP !)
+  (: (-> Nat (! (Error [Nat (Dirty Binary)])))
+     read)
+
+  (: (-> Binary (! (Error Any)))
+     write)
+
+  (: (-> Any (! (Error Any)))
+     close))
+
+(def: #export (async tcp)
+  (-> (TCP IO) (TCP Promise))
+  (`` (structure (~~ (do-template [<capability>]
+                       [(def: <capability> (|>> (:: tcp <capability>) promise.future))]
+
+                       [read] [write] [close])))))
+
+(`` (for {(~~ (static host.jvm))
+          (as-is (def: (tcp socket)
+                   (-> Socket (Error (TCP IO)))
+                   (do error.Monad<Error>
+                     [input (Socket::getInputStream socket)
+                      output (Socket::getOutputStream socket)]
+                     (wrap (: (TCP IO)
+                              (structure (def: (read size)
+                                           (do io.Monad<Process>
+                                             [#let [data (binary.create size)]
+                                              bytes-read (InputStream::read data +0 (.int size) input)]
+                                             (wrap [(.nat bytes-read)
+                                                    (taint data)])))
+                                         
+                                         (def: (write data)
+                                           (do io.Monad<Process>
+                                             [_ (OutputStream::write data +0 (.int (binary.size data))
+                                                                     output)]
+                                             (Flushable::flush output)))
+
+                                         (def: (close _)
+                                           (do io.Monad<Process>
+                                             [_ (AutoCloseable::close input)
+                                              _ (AutoCloseable::close output)]
+                                             (AutoCloseable::close socket))))))))
+
+                 (def: #export (client address port)
+                   (-> //.Address //.Port (IO (Error (TCP IO))))
+                   (do io.Monad<Process>
+                     [socket (Socket::new address (.int port))]
+                     (io.io (tcp socket))))
+
+                 (def: #export (server port)
+                   (-> //.Port (IO (Error [(Promise Any)
+                                           (frp.Channel (TCP IO))])))
+                   (do io.Monad<Process>
+                     [server (ServerSocket::new (.int port))
+                      #let [close-signal (: (Promise Any)
+                                            (promise #.None))
+                            _ (promise.await (function (_ _)
+                                               (AutoCloseable::close server))
+                                             close-signal)
+                            output (: (frp.Channel (TCP IO))
+                                      (frp.channel []))
+                            _ (: (Promise Any)
+                                 (promise.future
+                                  (loop [_ []]
+                                    (do io.Monad<IO>
+                                      [?client (do io.Monad<Process>
+                                                 [socket (ServerSocket::accept server)]
+                                                 (io.io (tcp socket)))]
+                                      (case ?client
+                                        (#error.Error error)
+                                        (wrap [])
+                                        
+                                        (#error.Success client)
+                                        (do @
+                                          [_ (frp.publish output client)]
+                                          (recur [])))))))]]
+                     (wrap [close-signal output]))))}))
diff --git a/stdlib/source/lux/world/net/udp.jvm.lux b/stdlib/source/lux/world/net/udp.jvm.lux
index 8b785eb98..842f1c969 100644
--- a/stdlib/source/lux/world/net/udp.jvm.lux
+++ b/stdlib/source/lux/world/net/udp.jvm.lux
@@ -2,22 +2,25 @@
   [lux #*
    [control
     monad
-    ["ex" exception (#+ exception:)]]
+    ["ex" exception (#+ exception:)]
+    [security
+     ["." taint (#+ Dirty taint)]]]
    [concurrency
-    ["P" promise]
-    ["T" task]]
+    ["." promise (#+ Promise)]
+    [task (#+ Task)]]
    [data
-    ["e" error]
+    ["." error (#+ Error)]
     ["." maybe]
     [collection
      ["." array]]]
-   [type
-    abstract]
    [world
-    [binary (#+ Binary)]]
-   ["." io]
-   [host (#+ import:)]]
-  ["." //])
+    ["." binary (#+ Binary)]]
+   ["." io (#+ IO)]
+   [host (#+ import:)]
+   [platform
+    [compiler
+     ["." host]]]]
+  ["." // (#+ Location)])
 
 (import: java/lang/AutoCloseable
   (close [] #io #try void))
@@ -47,62 +50,71 @@
 ############################################################
 
 (exception: #export (cannot-resolve-address {address //.Address})
-  address)
+  (ex.report ["Address" address]))
 
 (exception: #export (multiple-candidate-addresses {address //.Address})
-  address)
-
-(def: (resolve address)
-  (-> //.Address (io.IO (e.Error InetAddress)))
-  (do (e.ErrorT io.Monad<IO>)
-    [addresses (InetAddress::getAllByName address)]
-    (: (io.IO (e.Error InetAddress))
-       (case (array.size addresses)
-         0 (io.io (ex.throw cannot-resolve-address address))
-         1 (wrap (maybe.assume (array.read 0 addresses)))
-         _ (io.io (ex.throw multiple-candidate-addresses address))))))
-
-(abstract: #export UDP {}
-  {#socket DatagramSocket}
-  
-  (def: #export (read data offset length self)
-    (-> Binary Nat Nat UDP (T.Task [Nat //.Address //.Port]))
-    (let [(^open ".") (:representation self)
-          packet (DatagramPacket::new|receive data (.int offset) (.int length))]
-      (P.future
-       (do (e.ErrorT io.Monad<IO>)
-         [_ (DatagramSocket::receive packet socket)
-          #let [bytes-read (.nat (DatagramPacket::getLength packet))]]
-         (wrap [bytes-read
-                (|> packet DatagramPacket::getAddress InetAddress::getHostAddress)
-                (.nat (DatagramPacket::getPort packet))])))))
-  
-  (def: #export (write address port data offset length self)
-    (-> //.Address //.Port Binary Nat Nat UDP (T.Task Any))
-    (P.future
-     (do (e.ErrorT io.Monad<IO>)
-       [address (resolve address)
-        #let [(^open ".") (:representation self)]]
-       (DatagramSocket::send (DatagramPacket::new|send data (.int offset) (.int length) address (.int port))
-                             socket))))
-
-  (def: #export (close self)
-    (-> UDP (T.Task Any))
-    (let [(^open ".") (:representation self)]
-      (P.future
-       (AutoCloseable::close socket))))
-
-  (def: #export (client _)
-    (-> Any (T.Task UDP))
-    (P.future
-     (do (e.ErrorT io.Monad<IO>)
-       [socket (DatagramSocket::new|client)]
-       (wrap (:abstraction (#socket socket))))))
-
-  (def: #export (server port)
-    (-> //.Port (T.Task UDP))
-    (P.future
-     (do (e.ErrorT io.Monad<IO>)
-       [socket (DatagramSocket::new|server (.int port))]
-       (wrap (:abstraction (#socket socket))))))
-  )
+  (ex.report ["Address" address]))
+
+(signature: #export (UDP !)
+  (: (-> Nat (! (Error [Nat Location (Dirty Binary)])))
+     read)
+
+  (: (-> Location Binary (! (Error Any)))
+     write)
+
+  (: (-> Any (! (Error Any)))
+     close))
+
+(def: #export (async udp)
+  (-> (UDP IO) (UDP Promise))
+  (`` (structure (def: read (|>> (:: udp read) promise.future))
+                 
+                 (def: (write location data)
+                   (promise.future (:: udp write location data)))
+                 
+                 (def: close (|>> (:: udp close) promise.future)))))
+
+(`` (for {(~~ (static host.jvm))
+          (as-is (def: (resolve address)
+                   (-> //.Address (IO (Error InetAddress)))
+                   (do io.Monad<Process>
+                     [addresses (InetAddress::getAllByName address)]
+                     (: (IO (Error InetAddress))
+                        (case (array.size addresses)
+                          0 (io.io (ex.throw cannot-resolve-address address))
+                          1 (wrap (maybe.assume (array.read 0 addresses)))
+                          _ (io.io (ex.throw multiple-candidate-addresses address))))))
+
+                 (def: (udp socket)
+                   (-> DatagramSocket (UDP IO))
+                   (structure (def: (read size)
+                                (let [data (binary.create size)
+                                      packet (DatagramPacket::new|receive data +0 (.int size))]
+                                  (do io.Monad<Process>
+                                    [_ (DatagramSocket::receive packet socket)
+                                     #let [bytes-read (.nat (DatagramPacket::getLength packet))]]
+                                    (wrap [bytes-read
+                                           {#//.address (|> packet DatagramPacket::getAddress InetAddress::getHostAddress)
+                                            #//.port (.nat (DatagramPacket::getPort packet))}
+                                           (taint data)]))))
+
+                              (def: (write location data)
+                                (do io.Monad<Process>
+                                  [address (resolve (get@ #//.address location))]
+                                  (DatagramSocket::send (DatagramPacket::new|send data +0 (.int (binary.size data)) address (.int (get@ #//.port location)))
+                                                        socket)))
+
+                              (def: (close _)
+                                (AutoCloseable::close socket))))
+
+                 (def: #export client
+                   (IO (Error (UDP IO)))
+                   (|> (DatagramSocket::new|client)
+                       (:: io.Monad<Process> map udp)))
+
+                 (def: #export server
+                   (-> //.Port (IO (Error (UDP IO))))
+                   (|>> .int
+                        DatagramSocket::new|server
+                        (:: io.Monad<Process> map udp)))
+                 )}))