aboutsummaryrefslogtreecommitdiff
path: root/stdlib
diff options
context:
space:
mode:
Diffstat (limited to '')
-rw-r--r--stdlib/source/lux/control/security/capability.lux23
-rw-r--r--stdlib/source/lux/world/file.lux219
-rw-r--r--stdlib/test/test/lux/host/jvm.jvm.lux6
3 files changed, 146 insertions, 102 deletions
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<Error>)]
@@ -104,32 +104,37 @@
(-> (File IO) (File Promise))
(`` (structure
(~~ (do-template [<name>]
- [(def: <name> (|>> (:: file <name>) promise.future))]
+ [(def: <name> (!.forge
+ (|>> (!.use (:: file <name>)) 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 [<name> <async>]
- [(def: <name> (|>> (:: directory <name>)
- (io/map (error/map (list/map <async>)))
- promise.future))]
+ [(def: <name> (!.forge
+ (|>> (!.use (:: directory <name>))
+ (io/map (error/map (list/map <async>)))
+ 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 [<name> <async>]
- [(def: <name> (|>> (:: system <name>) (io/map (error/map <async>)) promise.future))]
+ [(def: <name> (!.forge
+ (|>> (!.use (:: system <name>)) (io/map (error/map <async>)) promise.future)))]
[file async-file]
[create-file async-file]
@@ -226,108 +231,130 @@
(-> Path (File IO))
(~~ (do-template [<name> <flag>]
- [(def: (<name> data)
- (do io.Monad<Process>
- [stream (FileOutputStream::new (java/io/File::new path) <flag>)
- _ (OutputStream::write data stream)
- _ (OutputStream::flush stream)]
- (AutoCloseable::close stream)))]
+ [(def: <name>
+ (!.forge
+ (function (<name> data)
+ (do io.Monad<Process>
+ [stream (FileOutputStream::new (java/io/File::new path) <flag>)
+ _ (OutputStream::write data stream)
+ _ (OutputStream::flush stream)]
+ (AutoCloseable::close stream)))))]
[over-write #0]
[append #1]
))
- (def: (content _)
- (do io.Monad<Process>
- [#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<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)))
+ (def: content
+ (!.forge
+ (function (content _)
+ (do io.Monad<Process>
+ [#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<Process> map .nat)))))
+
+ (def: last-modified
+ (!.forge
+ (function (last-modified _)
+ (|> path
+ java/io/File::new
+ (java/io/File::lastModified)
+ (:: io.Monad<Process> 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<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
+ (!.forge
+ (function (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
+ (!.forge
+ (function (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]))))]
+ [(def: <name>
+ (!.forge
+ (function (<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: (discard _)
- (!delete path cannot-discard-directory)))
+ (def: discard
+ (!.forge
+ (function (discard _)
+ (!delete path cannot-discard-directory)))))
(structure: #export _ (System IO)
(~~ (do-template [<name> <method> <capability> <exception>]
- [(def: (<name> path)
- (do io.Monad<IO>
- [#let [file (java/io/File::new path)]
- outcome (<method> file)]
- (case outcome
- (#error.Success #1)
- (wrap (#error.Success (<capability> path)))
-
- _
- (wrap (ex.throw <exception> [path])))))]
+ [(def: <name>
+ (!.forge
+ (function (<name> path)
+ (do io.Monad<IO>
+ [#let [file (java/io/File::new path)]
+ outcome (<method> file)]
+ (case outcome
+ (#error.Success #1)
+ (wrap (#error.Success (<capability> path)))
+
+ _
+ (wrap (ex.throw <exception> [path])))))))]
[file java/io/File::isFile ..File<IO> cannot-find-file]
[create-file java/io/File::createNewFile ..File<IO> cannot-create-file]
@@ -343,14 +370,14 @@
[(def: #export (<get> Monad<!> System<!> path)
(All [!] (-> (Monad !) (System !) Path (! (Error (<signature> !)))))
(do Monad<!>
- [outcome (:: System<!> <create> path)]
+ [outcome (!.use (:: System<!> <create>) path)]
(case outcome
(#error.Success file)
(wrap (#error.Success file))
(#error.Failure error)
(if (ex.match? <exception> error)
- (:: System<!> <find> path)
+ (!.use (:: System<!> <find>) 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<IO> file.System<IO> file-path))]
- (:: file over-write bytecode))]
+ (!.use (:: file over-write) bytecode))]
(wrap (case outcome
(#error.Success definition)
(format "Wrote: " (%t file-path))
generated by cgit v1.2.3 (git 2.25.1) at 2024-12-26 01:37:07 +0000