From dbcf62dcd86798bc1ce2d3bb9c61dbb189fb8fc9 Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Thu, 6 Dec 2018 22:51:46 -0400 Subject: - Added basic support for capability-based security. - Re-designed the file-system signatures to be capability-based. --- stdlib/source/lux/control/monad.lux | 21 ++ stdlib/source/lux/control/security/capability.lux | 6 + stdlib/source/lux/world/file.lux | 350 ++++++++++++++-------- 3 files changed, 247 insertions(+), 130 deletions(-) create mode 100644 stdlib/source/lux/control/security/capability.lux (limited to 'stdlib/source') 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)] ["." text format] [collection - ["." array (#+ Array)]]] + ["." array (#+ Array)] + ["." list ("list/." Functor)]]] [time ["." instant (#+ Instant)] ["." duration]] [world ["." binary (#+ Binary)]] - ["." io (#+ IO)] + ["." io (#+ IO) ("io/." Functor)] [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 [] - [(: (-> Binary File (! (Error Any))) - )] +(do-template [ ] + [(type: #export ( !) + (Capability (! (Error ))))] - [append] - [write]) + [Can-Edit [Binary] Any] + [Can-Delete [] Any] + ) - (do-template [ ] - [(: (-> File (! (Error ))) - )] +(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 [] - [(: (-> File (! (Error Bit))) +(signature: #export (File !) + (do-template [ ] + [(: (Can-Query ! ) )] - [file?] - [directory?] + [size Nat] + [last-modified Instant] + [can-execute? Bit] + [content (Dirty Binary)] ) - (: (-> Permission File (! (Error Bit))) - can?) + (: (Can-Open ! File) + move) - (do-template [] - [(: (-> File (! (Error Any))) + (do-template [ ] + [(: (Can-Modify ! ) )] - [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 [ ] + [(: (Can-Open ! ) + )] + + [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 [] - [(def: ( parameter file) - (promise.future (:: system parameter file)))] + [(def: (|>> (:: file ) promise.future))] - [append] [write] - [can?] [move] [modify])) + [size] [last-modified] [can-execute?] [content] + [modify] [over-write] + [append] + [delete])) - (~~ (do-template [] - [(def: (|>> (:: system ) 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 [ ] + [(def: (|>> (:: directory ) + (io/map (error/map (list/map ))) + 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 [ ] + [(def: (|>> (:: system ) (io/map (error/map )) 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 [] - [(exception: #export ( {file File}) - (ex.report ["File" file]))] + [(exception: #export ( {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 + [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 [] [( [] #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 path) + (-> Path (File IO)) + (do-template [ ] - [(def: ( data file) + [(def: ( data) (do io.Monad - [stream (FileOutputStream::new (java/io/File::new file) ) + [stream (FileOutputStream::new (java/io/File::new path) ) _ (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 - [#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 map .nat))) - - (def: (files dir) - (do io.Monad - [?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 [ ] - [(def: (|>> java/io/File::new ))] - - [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 map .nat))) + + (def: (last-modified _) + (|> path + java/io/File::new + (java/io/File::lastModified) + (:: io.Monad map (|>> duration.from-millis instant.absolute)))) + + (def: (can-execute? _) + (|> path + java/io/File::new + java/io/File::canExecute)) + + (def: (move destination) + (do io.Monad + [outcome (java/io/File::renameTo (java/io/File::new destination) + (java/io/File::new path))] + (case outcome + (#error.Success #1) + (wrap (#error.Success (File destination))) + + _ + (io.throw cannot-move [destination path])))) + + (def: (modify time-stamp) + (do io.Monad + [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 path) + (-> Path (Directory IO)) + + (do-template [ ] + [(def: ( _) + (do io.Monad + [?children (java/io/File::listFiles (java/io/File::new path))] + (case ?children + (#.Some children) + (|> children + array.to-list + (monad.filter @ (|>> )) + (:: @ map (monad.map @ (|>> java/io/File::getAbsolutePath (:: @ map )))) + (:: @ join)) + + #.None + (io.throw not-a-directory [path]))))] + + [files java/io/File::isFile File] + [directories java/io/File::isDirectory Directory] ) - (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 map (|>> duration.from-millis instant.absolute)))) - - (do-template [ ] - [(def: ( subject) - (do io.Monad - [outcome ( (java/io/File::new subject))] - (case outcome - (#error.Success #1) - (wrap (#error.Success [])) - - _ - (io.throw [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 [ ] - [(def: ( parameter subject) + (structure: #export _ (System IO) + (do-template [ ] + [(def: ( path) (do io.Monad - [outcome ( (|> parameter ) - (java/io/File::new subject))] + [#let [file (java/io/File::new path)] + outcome ( file)] (case outcome (#error.Success #1) - (wrap (#error.Success [])) + (wrap (#error.Success ( path))) _ - (io.throw [parameter subject]))))] + (wrap (ex.throw [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 cannot-find-file] + [create-file java/io/File::createNewFile ..File cannot-create-file] + [directory java/io/File::isDirectory ..Directory cannot-find-directory] + [create-directory java/io/File::mkdir ..Directory 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)))))) -- cgit v1.2.3