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 ++++++++++++++-------- stdlib/test/test/lux/world/file.lux | 228 +++++++------- 4 files changed, 363 insertions(+), 242 deletions(-) create mode 100644 stdlib/source/lux/control/security/capability.lux (limited to 'stdlib') 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)))))) diff --git a/stdlib/test/test/lux/world/file.lux b/stdlib/test/test/lux/world/file.lux index 1332ebdfc..d87ea7fc5 100644 --- a/stdlib/test/test/lux/world/file.lux +++ b/stdlib/test/test/lux/world/file.lux @@ -11,15 +11,17 @@ ["." error (#+ Error)] ["." number] ["." text - format]] + format] + [collection + ["." list]]] [time ["." instant] ["." duration]] [world - ["@" file (#+ File)] + ["@" file (#+ Path File)] ["." binary (#+ Binary)]] [math - ["r" random]]] + ["r" random ("r/." Monad)]]] lux/test [// ["_." binary]]) @@ -27,82 +29,93 @@ (def: truncate-millis (|>> (i// +1_000) (i/* +1_000))) +(def: (creation-and-deletion number) + (-> Nat Test) + (r/wrap (do promise.Monad + [#let [path (format "temp_file_" (%n number))] + result (promise.future + (do (error.ErrorT io.Monad) + [#let [check-existence! (: (IO (Error Bit)) + (io.from-io (@.exists? io.Monad @.System path)))] + pre! check-existence! + file (:: @.System create-file path) + post! check-existence! + _ (:: file delete []) + remains? check-existence!] + (wrap (and (not pre!) + post! + (not remains?)))))] + (assert "Can create/delete files." + (error.default #0 result))))) + +(def: (read-and-write number data) + (-> Nat Binary Test) + (r/wrap (do promise.Monad + [#let [path (format "temp_file_" (%n number))] + result (promise.future + (do (error.ErrorT io.Monad) + [file (:: @.System create-file path) + _ (:: file over-write data) + content (:: file content []) + _ (:: file delete [])] + (wrap (:: binary.Equivalence = data (taint.trust content)))))] + (assert "Can write/read files." + (error.default #0 result))))) + (context: "File system." (do @ [file-size (|> r.nat (:: @ map (|>> (n/% 100) (n/max 10)))) dataL (_binary.binary file-size) dataR (_binary.binary file-size) - last-modified (|> r.int (:: @ map (|>> (:: number.Number abs) - truncate-millis - duration.from-millis - instant.absolute)))] + new-modified (|> r.int (:: @ map (|>> (:: number.Number abs) + truncate-millis + duration.from-millis + instant.absolute)))] ($_ seq + (creation-and-deletion 0) + (read-and-write 1 dataL) (wrap (do promise.Monad - [#let [file "temp_file_0"] + [#let [path "temp_file_2"] result (promise.future - (do io.Monad - [#let [check-existence! (: (IO (Error Bit)) - (@.exists? io.Monad @.System file))] - pre! check-existence! - _ (:: @.System write dataL file) - post! check-existence! - _ (:: @.System delete file) - remains? check-existence!] - (wrap (and (not pre!) - post! - (not remains?)))))] - (assert "Can create/delete files." - (error.default #0 result)))) - (wrap (do promise.Monad - [#let [file "temp_file_1"] - result (promise.future - (do io.Monad - [_ (:: @.System write dataL file) - output (:: @.System read file) - _ (:: @.System delete file)] - (wrap (:: binary.Equivalence = dataL (taint.trust output)))))] - (assert "Can write/read files." - (error.default #0 result)))) - (wrap (do promise.Monad - [#let [file "temp_file_2"] - result (promise.future - (do io.Monad - [_ (:: @.System write dataL file) - read-size (:: @.System size file) - _ (:: @.System delete file)] + (do (error.ErrorT io.Monad) + [file (:: @.System create-file path) + _ (:: file over-write dataL) + read-size (:: file size []) + _ (:: file delete [])] (wrap (n/= file-size read-size))))] (assert "Can read file size." (error.default #0 result)))) (wrap (do promise.Monad - [#let [file "temp_file_3"] + [#let [path "temp_file_3"] result (promise.future - (do io.Monad - [_ (:: @.System write dataL file) - _ (:: @.System append dataR file) - output (:: @.System read file) - read-size (:: @.System size file) - _ (:: @.System delete file)] + (do (error.ErrorT io.Monad) + [file (:: @.System create-file path) + _ (:: file over-write dataL) + _ (:: file append dataR) + content (:: file content []) + read-size (:: file size []) + _ (:: file delete [])] (wrap (and (n/= (n/* 2 file-size) read-size) (:: binary.Equivalence = dataL (error.assume (binary.slice 0 (dec file-size) - (taint.trust output)))) + (taint.trust content)))) (:: binary.Equivalence = dataR (error.assume (binary.slice file-size (dec read-size) - (taint.trust output))))))))] + (taint.trust content))))))))] (assert "Can append to files." (error.default #0 result)))) (wrap (do promise.Monad - [#let [dir "temp_dir_4"] + [#let [path "temp_dir_4"] result (promise.future - (do io.Monad + (do (error.ErrorT io.Monad) [#let [check-existence! (: (IO (Error Bit)) - (@.exists? io.Monad @.System dir))] + (io.from-io (@.exists? io.Monad @.System path)))] pre! check-existence! - _ (:: @.System make-directory dir) + dir (:: @.System create-directory path) post! check-existence! - _ (:: @.System delete dir) + _ (:: dir discard []) remains? check-existence!] (wrap (and (not pre!) post! @@ -110,79 +123,70 @@ (assert "Can create/delete directories." (error.default #0 result)))) (wrap (do promise.Monad - [#let [file "temp_file_5" - dir "temp_dir_5"] + [#let [file-path "temp_file_5" + dir-path "temp_dir_5"] result (promise.future - (do io.Monad - [_ (:: @.System write dataL file) - file-is-file (:: @.System file? file) - file-is-directory (:: @.System directory? file) - _ (:: @.System delete file) - _ (:: @.System make-directory dir) - directory-is-file (:: @.System file? dir) - directory-is-directory (:: @.System directory? dir) - _ (:: @.System delete dir)] - (wrap (and file-is-file (not file-is-directory) - (not directory-is-file) directory-is-directory))))] - (assert "Can differentiate files from directories." - (error.default #0 result)))) - (wrap (do promise.Monad - [#let [file "temp_file_6" - dir "temp_dir_6"] - result (promise.future - (do io.Monad - [_ (:: @.System make-directory dir) - #let [file' (format dir "/" file)] - _ (:: @.System write dataL file') - read-size (:: @.System size file') - _ (:: @.System delete file') - _ (:: @.System delete dir)] + (do (error.ErrorT io.Monad) + [dir (:: @.System create-directory dir-path) + file (:: @.System create-file (format dir-path "/" file-path)) + _ (:: file over-write dataL) + read-size (:: file size []) + _ (:: file delete []) + _ (:: dir discard [])] (wrap (n/= file-size read-size))))] (assert "Can create files inside of directories." (error.default #0 result)))) (wrap (do promise.Monad - [#let [file "temp_file_7" - dir "temp_dir_7"] + [#let [file-path "temp_file_6" + dir-path "temp_dir_6" + inner-dir-path "inner_temp_dir_6"] result (promise.future - (do io.Monad - [_ (:: @.System make-directory dir) - #let [file' (format dir "/" file)] - _ (:: @.System write dataL file') - children (:: @.System files dir) - _ (:: @.System delete file') - _ (:: @.System delete dir)] - (wrap (case children - (^ (list child)) - (text.ends-with? file' child) - - _ - #0))))] - (assert "Can list files inside a directory." + (do (error.ErrorT io.Monad) + [dir (:: @.System create-directory dir-path) + pre-files (:: dir files []) + pre-directories (:: dir directories []) + + file (:: @.System create-file (format dir-path "/" file-path)) + inner-dir (:: @.System create-directory (format dir-path "/" inner-dir-path)) + post-files (:: dir files []) + post-directories (:: dir directories []) + + _ (:: file delete []) + _ (:: inner-dir discard []) + _ (:: dir discard [])] + (wrap (and (and (n/= 0 (list.size pre-files)) + (n/= 0 (list.size pre-directories))) + (and (n/= 1 (list.size post-files)) + (n/= 1 (list.size post-directories)))))))] + (assert "Can list files/directories inside a directory." (error.default #0 result)))) (wrap (do promise.Monad - [#let [file "temp_file_8"] + [#let [path "temp_file_7"] result (promise.future - (do io.Monad - [_ (:: @.System write dataL file) - _ (:: @.System modify last-modified file) - time-read (:: @.System last-modified file) - _ (:: @.System delete file)] - (wrap (:: instant.Equivalence = last-modified time-read))))] + (do (error.ErrorT io.Monad) + [file (:: @.System create-file path) + _ (:: file over-write dataL) + _ (:: file modify new-modified) + old-modified (:: file last-modified []) + _ (:: file delete [])] + (wrap (:: instant.Equivalence = new-modified old-modified))))] (assert "Can change the time of last modification." (error.default #0 result)))) (wrap (do promise.Monad - [#let [file0 (format "temp_file_9+0") - file1 (format "temp_file_9+1")] + [#let [path0 (format "temp_file_8+0") + path1 (format "temp_file_8+1")] result (promise.future - (do io.Monad - [#let [check-existence! (: (-> File (IO (Error Bit))) - (@.exists? io.Monad @.System))] - _ (:: @.System write dataL file0) - pre! (check-existence! file0) - _ (:: @.System move file1 file0) - post! (check-existence! file0) - confirmed? (check-existence! file1) - _ (:: @.System delete file1)] + (do (error.ErrorT io.Monad) + [#let [check-existence! (: (-> Path (IO (Error Bit))) + (|>> (@.exists? io.Monad @.System) io.from-io))] + file0 (:: @.System create-file path0) + _ (:: file0 over-write dataL) + pre! (check-existence! path0) + file1 (: (IO (Error (File IO))) ## TODO: Remove : + (:: file0 move path1)) + post! (check-existence! path0) + confirmed? (check-existence! path1) + _ (:: file1 delete [])] (wrap (and pre! (not post!) confirmed?))))] -- cgit v1.2.3