- Added basic support for capability-based security.

- Re-designed the file-system signatures to be capability-based.

3 files changed, 247 insertions, 130 deletions

diff --git a/stdlib/source/lux/control/monad.lux b/stdlib/source/lux/control/monad.lux
index 6f07ceb0a..6e0992444 100644
--- a/stdlib/source/lux/control/monad.lux
+++ b/stdlib/source/lux/control/monad.lux
@@ -127,6 +127,27 @@
                      (!/map (|>> (#.Cons _x)) (recur xs'))))
             !/join)))))
 
+(def: #export (filter Monad<!> f)
+  {#.doc "Filter the values in a list with a monadic function."}
+  (All [! a b]
+    (-> (Monad !) (-> a (! Bit)) (List a)
+        (! (List a))))
+  (let [(^open "!/.") Monad<!>]
+    (function (recur xs)
+      (case xs
+        #.Nil
+        (!/wrap #.Nil)
+        
+        (#.Cons head xs')
+        (|> (f head)
+            (!/map (function (_ verdict)
+                     (!/map (function (_ tail)
+                              (if verdict
+                                (#.Cons head tail)
+                                tail))
+                            (recur xs'))))
+            !/join)))))
+
 (def: #export (fold monad f init xs)
   {#.doc "Fold a list with a monadic function."}
   (All [M a b]
diff --git a/stdlib/source/lux/control/security/capability.lux b/stdlib/source/lux/control/security/capability.lux
new file mode 100644
index 000000000..572b52f3b
--- /dev/null
+++ b/stdlib/source/lux/control/security/capability.lux
@@ -0,0 +1,6 @@
+(.module:
+  [lux #*])
+
+(signature: #export (Capability input output)
+  (: (-> input output)
+     perform))
diff --git a/stdlib/source/lux/world/file.lux b/stdlib/source/lux/world/file.lux
index 9b53e4453..e0975799d 100644
--- a/stdlib/source/lux/world/file.lux
+++ b/stdlib/source/lux/world/file.lux
@@ -4,20 +4,22 @@
     ["." monad (#+ Monad do)]
     ["ex" exception (#+ Exception exception:)]
     [security
-     ["." taint (#+ Dirty taint)]]]
+     ["." taint (#+ Dirty taint)]
+     ["." capability (#+ Capability)]]]
    [data
     ["." maybe]
-    ["." error (#+ Error)]
+    ["." error (#+ Error) ("error/." Functor<Error>)]
     ["." text
      format]
     [collection
-     ["." array (#+ Array)]]]
+     ["." array (#+ Array)]
+     ["." list ("list/." Functor<List>)]]]
    [time
     ["." instant (#+ Instant)]
     ["." duration]]
    [world
     ["." binary (#+ Binary)]]
-   ["." io (#+ IO)]
+   ["." io (#+ IO) ("io/." Functor<IO>)]
    [concurrency
     ["." promise (#+ Promise)]]
    [host (#+ import:)]
@@ -25,80 +27,119 @@
     [compiler
      ["." host]]]])
 
-(type: #export File Text)
+(type: #export Path Text)
 
-(type: #export Permission
-  #Read
-  #Write
-  #Execute)
+(type: #export (Can-Open ! capability)
+  (Capability Path (! (Error (capability !)))))
 
-(signature: #export (System !)
-  (do-template [<name>]
-    [(: (-> Binary File (! (Error Any)))
-        <name>)]
+(do-template [<capability> <input> <output>]
+  [(type: #export (<capability> !)
+     (Capability <input> (! (Error <output>))))]
 
-    [append]
-    [write])
+  [Can-Edit   [Binary] Any]
+  [Can-Delete []       Any]
+  )
 
-  (do-template [<name> <output>]
-    [(: (-> File (! (Error <output>)))
-        <name>)]
+(type: #export (Can-Query ! o)
+  (Capability [] (! (Error o))))
 
-    [read (Dirty Binary)]
-    [size Nat]
-    [files (List File)]
-    [last-modified Instant])
+(type: #export (Can-Modify ! i)
+  (Capability [i] (! (Error Any))))
 
-  (do-template [<name>]
-    [(: (-> File (! (Error Bit)))
+(signature: #export (File !)
+  (do-template [<name> <output>]
+    [(: (Can-Query ! <output>)
         <name>)]
 
-    [file?]
-    [directory?]
+    [size          Nat]
+    [last-modified Instant]
+    [can-execute?  Bit]
+    [content       (Dirty Binary)]
     )
 
-  (: (-> Permission File (! (Error Bit)))
-     can?)
+  (: (Can-Open ! File)
+     move)
 
-  (do-template [<name>]
-    [(: (-> File (! (Error Any)))
+  (do-template [<name> <input>]
+    [(: (Can-Modify ! <input>)
         <name>)]
 
-    [make-directory]
-    [delete]
+    [modify     Instant]
+    [over-write Binary]
     )
 
-  (: (-> File File (! (Error Any)))
-     move)
+  (: (Can-Edit !)
+     append)
+
+  (: (Can-Delete !)
+     delete)
+  )
 
-  (: (-> Instant File (! (Error Any)))
-     modify)
+(signature: #export (Directory !)
+  (: (Can-Query ! (List (File !)))
+     files)
+
+  (: (Can-Query ! (List (Directory !)))
+     directories)
+
+  (: (Can-Delete !)
+     discard))
+
+(signature: #export (System !)
+  (do-template [<name> <capability>]
+    [(: (Can-Open ! <capability>)
+        <name>)]
+
+    [file             File]
+    [create-file      File]
+    [directory        Directory]
+    [create-directory Directory]
+    )
 
   (: Text
      separator)
   )
 
-(def: #export (async system)
-  (-> (System IO) (System Promise))
+(def: (async-file file)
+  (-> (File IO) (File Promise))
   (`` (structure
        (~~ (do-template [<name>]
-             [(def: (<name> parameter file)
-                (promise.future (:: system <name> parameter file)))]
+             [(def: <name> (|>> (:: file <name>) promise.future))]
 
-             [append] [write]
-             [can?] [move] [modify]))
+             [size] [last-modified] [can-execute?] [content]
+             [modify] [over-write]
+             [append]
+             [delete]))
 
-       (~~ (do-template [<name>]
-             [(def: <name> (|>> (:: system <name>) promise.future))]
+       (def: move (|>> (:: file move) (io/map (error/map async-file)) promise.future)))))
+
+(def: (async-directory directory)
+  (-> (Directory IO) (Directory Promise))
+  (`` (structure (~~ (do-template [<name> <async>]
+                       [(def: <name> (|>> (:: directory <name>)
+                                          (io/map (error/map (list/map <async>)))
+                                          promise.future))]
+
+                       [files       async-file]
+                       [directories async-directory]))
 
-             [read] [size] [files] [last-modified]
-             [file?] [directory?]
-             [make-directory] [delete]))
+                 (def: discard (|>> (:: directory discard) promise.future)))))
+
+(def: #export (async system)
+  (-> (System IO) (System Promise))
+  (`` (structure
+       (~~ (do-template [<name> <async>]
+             [(def: <name> (|>> (:: system <name>) (io/map (error/map <async>)) promise.future))]
+
+             [file             async-file]
+             [create-file      async-file]
+             [directory        async-directory]
+             [create-directory async-directory]))
 
        (def: separator (:: system separator)))))
 
 (def: #export (un-nest System<!> file)
-  (All [!] (-> (System !) File (Maybe [File Text])))
+  (All [!] (-> (System !) Path (Maybe [Path Text])))
   (case (text.last-index-of (:: System<!> separator) file)
     #.None
     #.None
@@ -109,26 +150,42 @@
       (#.Some [parent child]))))
 
 (def: #export (nest System<!> [parent child])
-  (All [!] (-> (System !) [File Text] File))
+  (All [!] (-> (System !) [Path Text] Path))
   (format parent (:: System<!> separator) child))
 
 (do-template [<name>]
-  [(exception: #export (<name> {file File})
-     (ex.report ["File" file]))]
+  [(exception: #export (<name> {file Path})
+     (ex.report ["Path" file]))]
+
+  [cannot-create-file]
+  [cannot-find-file]
+  [cannot-delete-file]
 
+  [cannot-create-directory]
+  [cannot-find-directory]
+  [cannot-discard-directory]
+  
   [cannot-read-all-data]
   [not-a-directory]
-  [cannot-make-directory]
-  [cannot-delete]
   )
 
-(exception: #export (cannot-move {target File} {source File})
+(exception: #export (cannot-move {target Path} {source Path})
   (ex.report ["Source" source]
              ["Target" target]))
 
-(exception: #export (cannot-modify {instant Instant} {file File})
+(exception: #export (cannot-modify {instant Instant} {file Path})
   (ex.report ["Instant" (%instant instant)]
-             ["File" file]))
+             ["Path" file]))
+
+(template: (!delete path exception)
+  (do io.Monad<IO>
+    [outcome (java/io/File::delete (java/io/File::new path))]
+    (case outcome
+      (#error.Success #1)
+      (wrap (#error.Success []))
+
+      _
+      (io.throw exception [path]))))
 
 (`` (for {(~~ (static host.jvm))
           (as-is (import: #long java/io/File
@@ -136,7 +193,8 @@
                    (~~ (do-template [<name>]
                          [(<name> [] #io #try boolean)]
 
-                         [exists] [mkdirs] [delete]
+                         [createNewFile] [mkdir]
+                         [exists] [delete]
                          [isFile] [isDirectory]
                          [canRead] [canWrite] [canExecute]))
                    
@@ -164,105 +222,137 @@
                  (import: java/io/FileInputStream
                    (new [java/io/File] #io #try))
 
-                 (structure: #export _ (System IO)
+                 (structure: (File<IO> path)
+                   (-> Path (File IO))
+
                    (do-template [<name> <flag>]
-                     [(def: (<name> data file)
+                     [(def: (<name> data)
                         (do io.Monad<Process>
-                          [stream (FileOutputStream::new (java/io/File::new file) <flag>)
+                          [stream (FileOutputStream::new (java/io/File::new path) <flag>)
                            _ (OutputStream::write data stream)
                            _ (OutputStream::flush stream)]
                           (AutoCloseable::close stream)))]
 
-                     [append #1]
-                     [write  #0]
+                     [over-write  #0]
+                     [append      #1]
                      )
 
-                   (def: (read file)
+                   (def: (content _)
                      (do io.Monad<Process>
-                       [#let [file' (java/io/File::new file)]
-                        size (java/io/File::length file')
+                       [#let [file (java/io/File::new path)]
+                        size (java/io/File::length file)
                         #let [data (binary.create (.nat size))]
-                        stream (FileInputStream::new file')
+                        stream (FileInputStream::new file)
                         bytes-read (InputStream::read data stream)
                         _ (AutoCloseable::close stream)]
                        (if (i/= size bytes-read)
                          (wrap (taint data))
-                         (io.io (ex.throw cannot-read-all-data file)))))
-
-                   (def: size
-                     (|>> java/io/File::new
-                          java/io/File::length
-                          (:: io.Monad<Process> map .nat)))
-
-                   (def: (files dir)
-                     (do io.Monad<Process>
-                       [?files (java/io/File::listFiles (java/io/File::new dir))]
-                       (case ?files
-                         (#.Some files)
-                         (monad.map @ (|>> java/io/File::getAbsolutePath)
-                                    (array.to-list files))
-
-                         #.None
-                         (io.throw not-a-directory dir))))
-
-                   (do-template [<name> <method>]
-                     [(def: <name> (|>> java/io/File::new <method>))]
-
-                     [file?      java/io/File::isFile]
-                     [directory? java/io/File::isDirectory]
+                         (io.io (ex.throw cannot-read-all-data path)))))
+
+                   (def: (size _)
+                     (|> path
+                         java/io/File::new
+                         java/io/File::length
+                         (:: io.Monad<Process> map .nat)))
+
+                   (def: (last-modified _)
+                     (|> path
+                         java/io/File::new
+                         (java/io/File::lastModified)
+                         (:: io.Monad<Process> map (|>> duration.from-millis instant.absolute))))
+
+                   (def: (can-execute? _)
+                     (|> path
+                         java/io/File::new
+                         java/io/File::canExecute))
+
+                   (def: (move destination)
+                     (do io.Monad<IO>
+                       [outcome (java/io/File::renameTo (java/io/File::new destination)
+                                                        (java/io/File::new path))]
+                       (case outcome
+                         (#error.Success #1)
+                         (wrap (#error.Success (File<IO> destination)))
+
+                         _
+                         (io.throw cannot-move [destination path]))))
+
+                   (def: (modify time-stamp)
+                     (do io.Monad<IO>
+                       [outcome (java/io/File::setLastModified (|> time-stamp instant.relative duration.to-millis)
+                                                               (java/io/File::new path))]
+                       (case outcome
+                         (#error.Success #1)
+                         (wrap (#error.Success []))
+
+                         _
+                         (io.throw cannot-modify [time-stamp path]))))
+
+                   (def: (delete _)
+                     (!delete path cannot-delete-file)))
+
+                 (structure: (Directory<IO> path)
+                   (-> Path (Directory IO))
+
+                   (do-template [<name> <method> <capability>]
+                     [(def: (<name> _)
+                        (do io.Monad<Process>
+                          [?children (java/io/File::listFiles (java/io/File::new path))]
+                          (case ?children
+                            (#.Some children)
+                            (|> children
+                                array.to-list
+                                (monad.filter @ (|>> <method>))
+                                (:: @ map (monad.map @ (|>> java/io/File::getAbsolutePath (:: @ map  <capability>))))
+                                (:: @ join))
+
+                            #.None
+                            (io.throw not-a-directory [path]))))]
+
+                     [files       java/io/File::isFile      File<IO>]
+                     [directories java/io/File::isDirectory Directory<IO>]
                      )
 
-                   (def: (can? permission file)
-                     (let [jvm-file (java/io/File::new file)]
-                       (case permission
-                         #Read (java/io/File::canRead jvm-file)
-                         #Write (java/io/File::canWrite jvm-file)
-                         #Execute (java/io/File::canExecute jvm-file))))
-
-                   (def: last-modified
-                     (|>> java/io/File::new
-                          (java/io/File::lastModified)
-                          (:: io.Monad<Process> map (|>> duration.from-millis instant.absolute))))
-
-                   (do-template [<name> <exception> <method>]
-                     [(def: (<name> subject)
-                        (do io.Monad<IO>
-                          [outcome (<method> (java/io/File::new subject))]
-                          (case outcome
-                            (#error.Success #1)
-                            (wrap (#error.Success []))
-
-                            _
-                            (io.throw <exception> [subject]))))]
-
-                     [make-directory cannot-make-directory java/io/File::mkdirs]
-                     [delete         cannot-delete         java/io/File::delete]
-                     )
+                   (def: (discard _)
+                     (!delete path cannot-discard-directory)))
 
-                   (do-template [<name> <exception> <method> <parameter-pre>]
-                     [(def: (<name> parameter subject)
+                 (structure: #export _ (System IO)
+                   (do-template [<name> <method> <capability> <exception>]
+                     [(def: (<name> path)
                         (do io.Monad<IO>
-                          [outcome (<method> (|> parameter <parameter-pre>)
-                                             (java/io/File::new subject))]
+                          [#let [file (java/io/File::new path)]
+                           outcome (<method> file)]
                           (case outcome
                             (#error.Success #1)
-                            (wrap (#error.Success []))
+                            (wrap (#error.Success (<capability> path)))
 
                             _
-                            (io.throw <exception> [parameter subject]))))]
+                            (wrap (ex.throw <exception> [path])))))]
 
-                     [move   cannot-move   java/io/File::renameTo        java/io/File::new]
-                     [modify cannot-modify java/io/File::setLastModified (<| duration.to-millis instant.relative)]
+                     [file             java/io/File::isFile        ..File<IO>      cannot-find-file]
+                     [create-file      java/io/File::createNewFile ..File<IO>      cannot-create-file]
+                     [directory        java/io/File::isDirectory   ..Directory<IO> cannot-find-directory]
+                     [create-directory java/io/File::mkdir         ..Directory<IO> cannot-create-directory]
                      )
 
                    (def: separator (java/io/File::separator))
                    ))
           }))
 
-(def: #export (exists? Monad<!> System<!> file)
-  (All [!] (-> (Monad !) (System !) File (! (Error Bit))))
-  (do (error.ErrorT Monad<!>)
-    [??? (:: System<!> file? file)]
-    (if ???
-      (wrap ???)
-      (:: System<!> directory? file))))
+(def: #export (exists? Monad<!> System<!> path)
+  (All [!] (-> (Monad !) (System !) Path (! Bit)))
+  (do Monad<!>
+    [?file (:: System<!> file path)]
+    (case ?file
+      (#error.Success file)
+      (wrap true)
+
+      (#error.Error _)
+      (do Monad<!>
+        [?directory (:: System<!> directory path)]
+        (case ?directory
+          (#error.Success directory)
+          (wrap true)
+
+          (#error.Error _)
+          (wrap false))))))