diff options
author | Eduardo Julian | 2021-07-02 03:11:36 -0400 |
---|---|---|
committer | Eduardo Julian | 2021-07-02 03:11:36 -0400 |
commit | 5cf4efa861075f8276f43a2516f5beacaf610b44 (patch) | |
tree | e21cf528d960c29d22cbc7e41180fa09e62f16d6 /stdlib/source/program/aedifex/repository | |
parent | 744ee69630de59ca3ba660b0aab6361cd17ce1b4 (diff) |
No longer employing the capabilities model on the lux/world/* modules.
Capabilities should be opt-in, but using them in the standard library makes them mandatory.
Diffstat (limited to '')
-rw-r--r-- | stdlib/source/program/aedifex/repository.lux | 10 | ||||
-rw-r--r-- | stdlib/source/program/aedifex/repository/local.lux | 10 | ||||
-rw-r--r-- | stdlib/source/program/aedifex/repository/remote.lux | 152 |
3 files changed, 63 insertions, 109 deletions
diff --git a/stdlib/source/program/aedifex/repository.lux b/stdlib/source/program/aedifex/repository.lux index c5f822633..d966c7f82 100644 --- a/stdlib/source/program/aedifex/repository.lux +++ b/stdlib/source/program/aedifex/repository.lux @@ -30,21 +30,21 @@ (promise.future (\ repository upload uri content))) )) -(interface: #export (Simulation s) +(interface: #export (Mock s) (: (-> URI s (Try [s Binary])) on_download) (: (-> URI Binary s (Try s)) on_upload)) -(def: #export (mock simulation init) - (All [s] (-> (Simulation s) s (Repository Promise))) +(def: #export (mock mock init) + (All [s] (-> (Mock s) s (Repository Promise))) (let [state (stm.var init)] (implementation (def: (download uri) (stm.commit (do {! stm.monad} [|state| (stm.read state)] - (case (\ simulation on_download uri |state|) + (case (\ mock on_download uri |state|) (#try.Success [|state| output]) (do ! [_ (stm.write |state| state)] @@ -57,7 +57,7 @@ (stm.commit (do {! stm.monad} [|state| (stm.read state)] - (case (\ simulation on_upload uri content |state|) + (case (\ mock on_upload uri content |state|) (#try.Success |state|) (do ! [_ (stm.write |state| state)] diff --git a/stdlib/source/program/aedifex/repository/local.lux b/stdlib/source/program/aedifex/repository/local.lux index 2841bbd32..8ceaf5ffc 100644 --- a/stdlib/source/program/aedifex/repository/local.lux +++ b/stdlib/source/program/aedifex/repository/local.lux @@ -6,9 +6,7 @@ [control ["." try (#+ Try)] [concurrency - ["." promise (#+ Promise)]] - [security - ["!" capability]]] + ["." promise (#+ Promise)]]] [data ["." text ["%" format (#+ format)]]] @@ -46,7 +44,7 @@ (: (Promise (Try (File Promise))) (file.get_file promise.monad system absolute_path))) (: (Promise (Try (File Promise))) - (!.use (\ system file) absolute_path))))) + (\ system file absolute_path))))) (implementation: #export (repository program system) (-> (Program Promise) (file.System Promise) (//.Repository Promise)) @@ -54,9 +52,9 @@ (def: (download uri) (do {! (try.with promise.monad)} [file (..file program system false uri)] - (!.use (\ file content) []))) + (\ file content []))) (def: (upload uri content) (do {! (try.with promise.monad)} [file (..file program system true uri)] - (!.use (\ file over_write) [content])))) + (\ file over_write content)))) diff --git a/stdlib/source/program/aedifex/repository/remote.lux b/stdlib/source/program/aedifex/repository/remote.lux index dcf1e1d51..50115f123 100644 --- a/stdlib/source/program/aedifex/repository/remote.lux +++ b/stdlib/source/program/aedifex/repository/remote.lux @@ -1,19 +1,15 @@ (.module: [lux #* - [ffi (#+ import:)] [abstract [monad (#+ do)]] [control ["." io (#+ IO)] - ["." try] + ["." try (#+ Try)] ["." exception (#+ exception:)]] [data - ["." binary] - ["." text + ["." product] + [text ["%" format (#+ format)]]] - [math - [number - ["n" nat]]] [tool [compiler ["." version] @@ -22,7 +18,11 @@ ["#" version]]]]] [world [net (#+ URL) - [uri (#+ URI)]]]] + [uri (#+ URI)] + ["." http #_ + ["#" client] + ["#/." status] + ["@#" /]]]]] ["." // ["#." identity (#+ Identity)] ["/#" // #_ @@ -32,108 +32,64 @@ (type: #export Address URL) -(import: java/lang/String) +(template [<name>] + [(exception: #export (<name> {url URL} {status Nat}) + (exception.report + ["URL" (%.text url)] + ["Status Code" (%.nat status)]))] -(import: java/lang/AutoCloseable - ["#::." - (close [] #io #try void)]) - -(import: java/io/InputStream) - -(import: java/io/OutputStream - ["#::." - (flush [] #io #try void) - (write [[byte]] #io #try void)]) - -(import: java/net/URLConnection - ["#::." - (setDoOutput [boolean] #io #try void) - (setRequestProperty [java/lang/String java/lang/String] #io #try void) - (getInputStream [] #io #try java/io/InputStream) - (getOutputStream [] #io #try java/io/OutputStream)]) - -(import: java/net/HttpURLConnection - ["#::." - (setRequestMethod [java/lang/String] #io #try void) - (getResponseCode [] #io #try int)]) - -(import: java/net/URL - ["#::." - (new [java/lang/String]) - (openConnection [] #io #try java/net/URLConnection)]) - -(import: java/io/BufferedInputStream - ["#::." - (new [java/io/InputStream]) - (read [[byte] int int] #io #try int)]) - -(exception: #export (no_credentials {address Address}) - (exception.report - ["Address" (%.text address)])) - -(exception: #export (deployment_failure {code Int}) - (exception.report - ["Code" (%.int code)])) + [download_failure] + [upload_failure] + ) (def: #export (uri version_template artifact extension) (-> Version Artifact Extension URI) (format (///artifact.uri version_template artifact) extension)) -(def: buffer_size - (n.* 1,024 1,024)) - -(def: user_agent +(def: #export user_agent (format "LuxAedifex/" (version.format language/lux.version))) -(implementation: #export (repository identity address) - (All [s] (-> (Maybe Identity) Address (//.Repository IO))) +(def: base_headers + (List [Text Text]) + (list ["User-Agent" ..user_agent])) + +(implementation: #export (repository http identity address) + (All [s] (-> (http.Client IO) (Maybe Identity) Address (//.Repository IO))) (def: (download uri) (do {! (try.with io.monad)} - [connection (|> (format address uri) - java/net/URL::new - java/net/URL::openConnection) - #let [connection (:coerce java/net/HttpURLConnection connection)] - _ (java/net/HttpURLConnection::setRequestMethod "GET" connection) - _ (java/net/URLConnection::setRequestProperty "User-Agent" ..user_agent connection) - input (|> connection - java/net/URLConnection::getInputStream - (\ ! map (|>> java/io/BufferedInputStream::new))) - #let [buffer (binary.create ..buffer_size)]] - (loop [output (\ binary.monoid identity)] + [[status message] (: (IO (Try (@http.Response IO))) + (http.get (format address uri) + (http.headers ..base_headers) + #.None + http))] + (case status + (^ (static http/status.ok)) + (\ ! map product.right ((get@ #@http.body message) #.None)) + + _ (do ! - [bytes_read (java/io/BufferedInputStream::read buffer +0 (.int ..buffer_size) input)] - (case bytes_read - -1 (do ! - [_ (java/lang/AutoCloseable::close input)] - (wrap output)) - +0 (recur output) - _ (if (n.= ..buffer_size bytes_read) - (recur (\ binary.monoid compose output buffer)) - (do ! - [chunk (\ io.monad wrap (binary.slice 0 (.nat bytes_read) buffer))] - (recur (\ binary.monoid compose output chunk))))))))) + [_ ((get@ #@http.body message) (#.Some 0))] + (\ io.monad wrap (exception.throw ..download_failure [(format address uri) status])))))) (def: (upload uri content) - (case identity - #.None - (\ io.monad wrap (exception.throw ..no_credentials [address])) - - (#.Some [user password]) - (do (try.with io.monad) - [connection (|> (format address uri) - java/net/URL::new - java/net/URL::openConnection) - #let [connection (:coerce java/net/HttpURLConnection connection)] - _ (java/net/HttpURLConnection::setRequestMethod "PUT" connection) - _ (java/net/URLConnection::setDoOutput true connection) - _ (java/net/URLConnection::setRequestProperty "Authorization" (//identity.basic_auth user password) connection) - stream (java/net/URLConnection::getOutputStream connection) - _ (java/io/OutputStream::write content stream) - _ (java/io/OutputStream::flush stream) - _ (java/lang/AutoCloseable::close stream) - code (java/net/HttpURLConnection::getResponseCode connection)] - (case code - +201 (wrap []) - _ (\ io.monad wrap (exception.throw ..deployment_failure [code])))))) + (do (try.with io.monad) + [[status message] (: (IO (Try (@http.Response IO))) + (http.put (format address uri) + (http.headers (case identity + #.None + ..base_headers + + (#.Some [user password]) + (list& ["Authorization" (//identity.basic_auth user password)] + ..base_headers))) + (#.Some content) + http)) + _ ((get@ #@http.body message) (#.Some 0))] + (case status + (^ (static http/status.created)) + (wrap []) + + _ + (\ io.monad wrap (exception.throw ..upload_failure [(format address uri) status]))))) ) |