From 0f06e0a5775a3588b7b6f35e975d39b2724a6f65 Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Sun, 3 Feb 2019 02:17:42 -0400 Subject: Added "forge" and "use" functions for working with capabilities. --- stdlib/source/lux/control/security/capability.lux | 23 ++- stdlib/source/lux/world/file.lux | 219 ++++++++++++---------- stdlib/test/test/lux/host/jvm.jvm.lux | 6 +- 3 files changed, 146 insertions(+), 102 deletions(-) (limited to 'stdlib') diff --git a/stdlib/source/lux/control/security/capability.lux b/stdlib/source/lux/control/security/capability.lux index 2a964bfe8..5de65a17e 100644 --- a/stdlib/source/lux/control/security/capability.lux +++ b/stdlib/source/lux/control/security/capability.lux @@ -1,8 +1,23 @@ (.module: - [lux #*]) + [lux #* + [type + abstract]]) -(signature: #export (Capability input output) +(abstract: #export (Capability input output) {#.doc (doc "Represents the capability to perform an operation." "This operation is assumed to have security implications.")} - (: (-> input output) - perform)) + + (-> input output) + + (def: #export forge + (All [input output] + (-> (-> input output) + (Capability input output))) + (|>> :abstraction)) + + (def: #export (use capability input) + (All [input output] + (-> (Capability input output) + input + output)) + ((:representation capability) input))) diff --git a/stdlib/source/lux/world/file.lux b/stdlib/source/lux/world/file.lux index 4793f2fa2..148934436 100644 --- a/stdlib/source/lux/world/file.lux +++ b/stdlib/source/lux/world/file.lux @@ -7,7 +7,7 @@ ["." promise (#+ Promise)]] [security ["." integrity (#+ Dirty)] - ["." capability (#+ Capability)]]] + ["!" capability (#+ Capability)]]] [data ["." maybe] ["." error (#+ Error) ("error/." Functor)] @@ -104,32 +104,37 @@ (-> (File IO) (File Promise)) (`` (structure (~~ (do-template [] - [(def: (|>> (:: file ) promise.future))] + [(def: (!.forge + (|>> (!.use (:: file )) promise.future)))] [size] [last-modified] [can-execute?] [content] [modify] [over-write] [append] [delete])) - (def: move (|>> (:: file move) (io/map (error/map async-file)) promise.future))))) + (def: move (!.forge + (|>> (!.use (:: 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))] + [(def: (!.forge + (|>> (!.use (:: directory )) + (io/map (error/map (list/map ))) + promise.future)))] [files async-file] [directories async-directory])) - (def: discard (|>> (:: directory discard) promise.future))))) + (def: discard (!.forge + (|>> (!.use (:: directory discard)) promise.future)))))) (def: #export (async system) (-> (System IO) (System Promise)) (`` (structure (~~ (do-template [ ] - [(def: (|>> (:: system ) (io/map (error/map )) promise.future))] + [(def: (!.forge + (|>> (!.use (:: system )) (io/map (error/map )) promise.future)))] [file async-file] [create-file async-file] @@ -226,108 +231,130 @@ (-> Path (File IO)) (~~ (do-template [ ] - [(def: ( data) - (do io.Monad - [stream (FileOutputStream::new (java/io/File::new path) ) - _ (OutputStream::write data stream) - _ (OutputStream::flush stream)] - (AutoCloseable::close stream)))] + [(def: + (!.forge + (function ( data) + (do io.Monad + [stream (FileOutputStream::new (java/io/File::new path) ) + _ (OutputStream::write data stream) + _ (OutputStream::flush stream)] + (AutoCloseable::close stream)))))] [over-write #0] [append #1] )) - (def: (content _) - (do io.Monad - [#let [file (java/io/File::new path)] - size (java/io/File::length file) - #let [data (binary.create (.nat size))] - stream (FileInputStream::new file) - bytes-read (InputStream::read data stream) - _ (AutoCloseable::close stream)] - (if (i/= size bytes-read) - (wrap (integrity.taint data)) - (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))) + (def: content + (!.forge + (function (content _) + (do io.Monad + [#let [file (java/io/File::new path)] + size (java/io/File::length file) + #let [data (binary.create (.nat size))] + stream (FileInputStream::new file) + bytes-read (InputStream::read data stream) + _ (AutoCloseable::close stream)] + (if (i/= size bytes-read) + (wrap (integrity.taint data)) + (io.io (ex.throw cannot-read-all-data path))))))) + + (def: size + (!.forge + (function (size _) + (|> path + java/io/File::new + java/io/File::length + (:: io.Monad map .nat))))) + + (def: last-modified + (!.forge + (function (last-modified _) + (|> path + java/io/File::new + (java/io/File::lastModified) + (:: io.Monad map (|>> duration.from-millis instant.absolute)))))) + + (def: can-execute? + (!.forge + (function (can-execute? _) + (|> path + java/io/File::new + java/io/File::canExecute)))) + + (def: move + (!.forge + (function (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 + (!.forge + (function (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 + (!.forge + (function (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]))))] + [(def: + (!.forge + (function ( _) + (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: (discard _) - (!delete path cannot-discard-directory))) + (def: discard + (!.forge + (function (discard _) + (!delete path cannot-discard-directory))))) (structure: #export _ (System IO) (~~ (do-template [ ] - [(def: ( path) - (do io.Monad - [#let [file (java/io/File::new path)] - outcome ( file)] - (case outcome - (#error.Success #1) - (wrap (#error.Success ( path))) - - _ - (wrap (ex.throw [path])))))] + [(def: + (!.forge + (function ( path) + (do io.Monad + [#let [file (java/io/File::new path)] + outcome ( file)] + (case outcome + (#error.Success #1) + (wrap (#error.Success ( path))) + + _ + (wrap (ex.throw [path])))))))] [file java/io/File::isFile ..File cannot-find-file] [create-file java/io/File::createNewFile ..File cannot-create-file] @@ -343,14 +370,14 @@ [(def: #export ( Monad System path) (All [!] (-> (Monad !) (System !) Path (! (Error ( !))))) (do Monad - [outcome (:: System path)] + [outcome (!.use (:: System ) path)] (case outcome (#error.Success file) (wrap (#error.Success file)) (#error.Failure error) (if (ex.match? error) - (:: System path) + (!.use (:: System ) path) (wrap (#error.Failure error))))))] [get-file File create-file file ..cannot-create-file] @@ -360,14 +387,14 @@ (def: #export (exists? Monad System path) (All [!] (-> (Monad !) (System !) Path (! Bit))) (do Monad - [?file (:: System file path)] + [?file (!.use (:: System file) path)] (case ?file (#error.Success file) (wrap true) (#error.Failure _) (do Monad - [?directory (:: System directory path)] + [?directory (!.use (:: System directory) path)] (case ?directory (#error.Success directory) (wrap true) diff --git a/stdlib/test/test/lux/host/jvm.jvm.lux b/stdlib/test/test/lux/host/jvm.jvm.lux index 2f5142e80..70a8c3da5 100644 --- a/stdlib/test/test/lux/host/jvm.jvm.lux +++ b/stdlib/test/test/lux/host/jvm.jvm.lux @@ -3,7 +3,9 @@ [control [monad (#+ do)] [concurrency - ["." atom]]] + ["." atom]] + [security + ["!" capability]]] [data ["." error (#+ Error)] ["." text @@ -38,7 +40,7 @@ [outcome (do (error.ErrorT @) [file (: (IO (Error (File IO))) (file.get-file io.Monad file.System file-path))] - (:: file over-write bytecode))] + (!.use (:: file over-write) bytecode))] (wrap (case outcome (#error.Success definition) (format "Wrote: " (%t file-path)) -- cgit v1.2.3