From 5cf4efa861075f8276f43a2516f5beacaf610b44 Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Fri, 2 Jul 2021 03:11:36 -0400 Subject: 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.--- stdlib/source/program/aedifex.lux | 11 +- stdlib/source/program/aedifex/command/auto.lux | 10 +- stdlib/source/program/aedifex/command/build.lux | 29 ++-- stdlib/source/program/aedifex/command/clean.lux | 12 +- stdlib/source/program/aedifex/command/install.lux | 4 +- stdlib/source/program/aedifex/command/pom.lux | 4 +- stdlib/source/program/aedifex/command/test.lux | 15 +- .../program/aedifex/dependency/deployment.lux | 28 ++-- .../program/aedifex/dependency/resolution.lux | 6 +- .../source/program/aedifex/dependency/status.lux | 6 +- stdlib/source/program/aedifex/input.lux | 10 +- stdlib/source/program/aedifex/metadata.lux | 24 +++- stdlib/source/program/aedifex/package.lux | 14 +- stdlib/source/program/aedifex/repository.lux | 10 +- stdlib/source/program/aedifex/repository/local.lux | 10 +- .../source/program/aedifex/repository/remote.lux | 152 ++++++++------------- stdlib/source/program/compositor.lux | 20 ++- stdlib/source/program/compositor/export.lux | 6 +- stdlib/source/program/compositor/import.lux | 6 +- 19 files changed, 163 insertions(+), 214 deletions(-) (limited to 'stdlib/source/program') diff --git a/stdlib/source/program/aedifex.lux b/stdlib/source/program/aedifex.lux index 2d873f8a8..772f57d88 100644 --- a/stdlib/source/program/aedifex.lux +++ b/stdlib/source/program/aedifex.lux @@ -11,8 +11,6 @@ ["." exception (#+ exception:)] [parser [environment (#+ Environment)]] - [security - ["!" capability]] [concurrency ["." promise (#+ Promise) ("#\." monad)]]] [data @@ -36,7 +34,10 @@ ["." console (#+ Console)] ["." program (#+ Program)] ["." file (#+ Path) - ["." watch]]]] + ["." watch]] + [net + ["." http #_ + ["#" client]]]]] ["." / #_ ["#" profile] ["#." action (#+ Action)] @@ -65,7 +66,7 @@ (-> /.Profile (List (Repository Promise))) (|>> (get@ #/.repositories) set.to_list - (list\map (|>> (/repository/remote.repository #.None) /repository.async)))) + (list\map (|>> (/repository/remote.repository http.default #.None) /repository.async)))) (def: (with_dependencies program console command profile) (All [a] @@ -155,7 +156,7 @@ (dictionary.get repository (get@ #/.deploy_repositories profile))] [(#.Some artifact) (#.Some repository)] (/command/deploy.do! console - (/repository.async (/repository/remote.repository (#.Some identity) repository)) + (/repository.async (/repository/remote.repository http.default (#.Some identity) repository)) (file.async file.default) artifact profile) diff --git a/stdlib/source/program/aedifex/command/auto.lux b/stdlib/source/program/aedifex/command/auto.lux index f74d3069a..5f3d95631 100644 --- a/stdlib/source/program/aedifex/command/auto.lux +++ b/stdlib/source/program/aedifex/command/auto.lux @@ -5,9 +5,7 @@ [control ["." try (#+ Try)] [concurrency - ["." promise (#+ Promise)]] - [security - ["!" capability]]] + ["." promise (#+ Promise)]]] [data [collection ["." list] @@ -29,14 +27,14 @@ (def: (targets fs path) (-> (file.System Promise) Path (Promise (List Path))) (do {! promise.monad} - [?root (!.use (\ fs directory) [path])] + [?root (\ fs directory [path])] (case ?root (#try.Success root) (loop [root root] (do ! [subs (\ ! map (|>> (try.default (list))) - (!.use (\ root directories) []))] - (\ ! map (|>> list.concat (list& (!.use (\ root scope) []))) + (\ root directories []))] + (\ ! map (|>> list.concat (list& (\ root scope))) (monad.map ! recur subs)))) (#try.Failure error) diff --git a/stdlib/source/program/aedifex/command/build.lux b/stdlib/source/program/aedifex/command/build.lux index 6d61475d0..572ebf0f0 100644 --- a/stdlib/source/program/aedifex/command/build.lux +++ b/stdlib/source/program/aedifex/command/build.lux @@ -7,9 +7,7 @@ ["." exception (#+ exception:)] ["." io (#+ IO)] [concurrency - ["." promise (#+ Promise) ("#\." monad)]] - [security - ["!" capability]]] + ["." promise (#+ Promise) ("#\." monad)]]] [data ["." product] ["." maybe] @@ -140,7 +138,7 @@ (let [[read! write!] (: [(Promise (Try Any)) (promise.Resolver (Try Any))] (promise.promise [])) - _ (|> (!.use (\ process ) []) + _ (|> (\ process []) (promise.await (function (recur ?line) (case ?line (#try.Failure error) @@ -156,7 +154,7 @@ (#try.Success _) (promise.await recur - (!.use (\ process ) [])))) + (\ process [])))) (console.write_line line console))))) io.run)] read!))] @@ -188,19 +186,18 @@ / (\ fs separator) cache_directory (format working_directory / target)] _ (console.write_line ..start console) - process (!.use (\ shell execute) - [environment - working_directory - command - (list.concat (list compiler_params - (list "build") - (..plural "--library" (..libraries fs home resolution)) - (..plural "--source" (set.to_list (get@ #///.sources profile))) - (..singular "--target" cache_directory) - (..singular "--module" program_module)))]) + process (\ shell execute [environment + working_directory + command + (list.concat (list compiler_params + (list "build") + (..plural "--library" (..libraries fs home resolution)) + (..plural "--source" (set.to_list (get@ #///.sources profile))) + (..singular "--target" cache_directory) + (..singular "--module" program_module)))]) _ (..log_output! console process) _ (..log_error! console process) - exit (!.use (\ process await) []) + exit (\ process await []) _ (console.write_line (if (i.= shell.normal exit) ..success ..failure) diff --git a/stdlib/source/program/aedifex/command/clean.lux b/stdlib/source/program/aedifex/command/clean.lux index b966fe85e..142451113 100644 --- a/stdlib/source/program/aedifex/command/clean.lux +++ b/stdlib/source/program/aedifex/command/clean.lux @@ -5,8 +5,6 @@ [control ["." try (#+ Try)] ["." exception] - [security - ["!" capability]] [concurrency ["." promise (#+ Promise)]]] [data @@ -24,9 +22,9 @@ (-> (Directory Promise) (Promise (Try Any))) (do {! ///action.monad} [nodes (: (Promise (Try (List (File Promise)))) - (!.use (\ root files) [])) + (\ root files [])) _ (monad.map ! (function (_ node) - (!.use (\ node delete) [])) + (\ node delete [])) nodes)] (wrap []))) @@ -39,7 +37,7 @@ (do promise.monad [#let [target (get@ #///.target profile)] root (: (Promise (Try (Directory Promise))) - (!.use (\ fs directory) target))] + (\ fs directory target))] (case root (#try.Success root) (do {! ///action.monad} @@ -47,9 +45,9 @@ (do ! [_ (..clean_files! root) subs (: (Promise (Try (List (Directory Promise)))) - (!.use (\ root directories) [])) + (\ root directories [])) _ (monad.map ! recur subs)] - (!.use (\ root discard) [])))] + (\ root discard [])))] (console.write_line (..success target) console)) (#try.Failure error) diff --git a/stdlib/source/program/aedifex/command/install.lux b/stdlib/source/program/aedifex/command/install.lux index 2e5ce6d89..4b6b96e3e 100644 --- a/stdlib/source/program/aedifex/command/install.lux +++ b/stdlib/source/program/aedifex/command/install.lux @@ -6,9 +6,7 @@ ["." try (#+ Try)] ["." exception] [concurrency - ["." promise (#+ Promise)]] - [security - ["!" capability]]] + ["." promise (#+ Promise)]]] [data [binary (#+ Binary)] [text diff --git a/stdlib/source/program/aedifex/command/pom.lux b/stdlib/source/program/aedifex/command/pom.lux index 16d036718..b8a728904 100644 --- a/stdlib/source/program/aedifex/command/pom.lux +++ b/stdlib/source/program/aedifex/command/pom.lux @@ -4,8 +4,6 @@ [monad (#+ do)]] [control ["." try (#+ Try)] - [security - ["!" capability]] [concurrency ["." promise (#+ Promise) ("#\." monad)]]] [data @@ -37,6 +35,6 @@ outcome (|> pom (\ xml.codec encode) (\ utf8.codec encode) - (!.use (\ file over_write))) + (\ file over_write)) _ (console.write_line ..success console)] (wrap ///pom.file))) diff --git a/stdlib/source/program/aedifex/command/test.lux b/stdlib/source/program/aedifex/command/test.lux index f3ab6c12a..e8b5a2a23 100644 --- a/stdlib/source/program/aedifex/command/test.lux +++ b/stdlib/source/program/aedifex/command/test.lux @@ -4,9 +4,7 @@ [monad (#+ do)]] [control [concurrency - ["." promise (#+ Promise) ("#\." monad)]] - [security - ["!" capability]]] + ["." promise (#+ Promise) ("#\." monad)]]] [data [text ["%" format (#+ format)]]] @@ -44,14 +42,13 @@ #let [[compiler_command compiler_parameters] (case compiler (#//build.JVM artifact) (///runtime.java program) (#//build.JS artifact) (///runtime.node program))] - process (!.use (\ shell execute) - [environment - working_directory - compiler_command - compiler_parameters]) + process (\ shell execute [environment + working_directory + compiler_command + compiler_parameters]) _ (//build.log_output! console process) _ (//build.log_error! console process) - exit (!.use (\ process await) []) + exit (\ process await []) _ (console.write_line (if (i.= shell.normal exit) ..success ..failure) diff --git a/stdlib/source/program/aedifex/dependency/deployment.lux b/stdlib/source/program/aedifex/dependency/deployment.lux index 0fdf7956f..edfa3142b 100644 --- a/stdlib/source/program/aedifex/dependency/deployment.lux +++ b/stdlib/source/program/aedifex/dependency/deployment.lux @@ -6,9 +6,7 @@ [control ["." try (#+ Try)] [concurrency - ["." promise (#+ Promise)]] - [security - ["!" capability]]] + ["." promise (#+ Promise)]]] [data [binary (#+ Binary)] ["." product] @@ -19,17 +17,12 @@ [collection ["." dictionary] ["." set (#+ Set)] - ["." list ("#\." monoid)]] - [format - ["." xml]]] + ["." list ("#\." monoid)]]] [time - ["." instant (#+ Instant)]] - [world - [program (#+ Program)] - ["." file (#+ Path File Directory)]]] + ["." instant (#+ Instant)]]] ["." /// #_ - ["#" local] - ["#." hash (#+ Hash SHA-1 MD5)] + [repository (#+ Repository)] + ["#." hash (#+ Hash)] ["#." package (#+ Package)] ["#." artifact (#+ Artifact) ["#/." time] @@ -37,16 +30,14 @@ ["#/." extension (#+ Extension)] ["#/." versioning] ["#/." snapshot - ["#/." version (#+ Version) + ["#/." version ["#/." value]]]] - ["#." metadata + ["#." metadata #_ ["#/." artifact] ["#/." snapshot (#+ Metadata)]] ["#." dependency (#+ Dependency) [resolution (#+ Resolution)] - ["#/." status (#+ Status)]] - ["#." repository (#+ Repository) - ["#/." origin]]]) + ["#/." status (#+ Status)]]]) (def: (with_status repository version_template [artifact type] [data status]) (-> (Repository Promise) ///artifact.Version Dependency [Binary Status] (Promise (Try Any))) @@ -150,8 +141,7 @@ (def: #export (all repository resolution) (-> (Repository Promise) Resolution (Promise (Try (Set Artifact)))) - (do {! (try.with promise.monad)} - [] + (let [! (try.with promise.monad)] (|> (dictionary.entries resolution) (monad.map ! (function (_ [dependency package]) (..one repository dependency package))) diff --git a/stdlib/source/program/aedifex/dependency/resolution.lux b/stdlib/source/program/aedifex/dependency/resolution.lux index 2d92e1438..138ee31bf 100644 --- a/stdlib/source/program/aedifex/dependency/resolution.lux +++ b/stdlib/source/program/aedifex/dependency/resolution.lux @@ -33,7 +33,9 @@ ["." i64]]] [world [net (#+ URL) - ["." uri]]]] + ["." uri] + ["." http #_ + ["#" client]]]]] ["." // (#+ Dependency) ["#." status (#+ Status)] ["/#" // #_ @@ -214,7 +216,7 @@ ///package.repositories (try\map set.to_list) (try.default (list)) - (list\map (|>> (///repository/remote.repository #.None) + (list\map (|>> (///repository/remote.repository http.default #.None) ///repository.async)) (list\compose repositories))] [successes failures resolution] (recur sub_repositories diff --git a/stdlib/source/program/aedifex/dependency/status.lux b/stdlib/source/program/aedifex/dependency/status.lux index 8c4db9ddd..f501ebc8b 100644 --- a/stdlib/source/program/aedifex/dependency/status.lux +++ b/stdlib/source/program/aedifex/dependency/status.lux @@ -27,12 +27,10 @@ ..any_equivalence ($_ sum.equivalence ///hash.equivalence - ///hash.equivalence - ) + ///hash.equivalence) ($_ product.equivalence ///hash.equivalence - ///hash.equivalence - ) + ///hash.equivalence) )) (def: #export (verified payload) diff --git a/stdlib/source/program/aedifex/input.lux b/stdlib/source/program/aedifex/input.lux index b00829469..2e7dbbab6 100644 --- a/stdlib/source/program/aedifex/input.lux +++ b/stdlib/source/program/aedifex/input.lux @@ -6,9 +6,7 @@ [pipe (#+ do>)] ["." try (#+ Try)] [parser - ["" code]] - [security - ["!" capability]]] + ["<.>" code]]] [data [binary (#+ Binary)] ["." text @@ -46,13 +44,13 @@ (|>> (do> try.monad [(\ utf8.codec decode)] [..parse_lux] - [(list) (.run //parser.project)]))) + [(list) (.run //parser.project)]))) (def: #export (read monad fs profile) (All [!] (-> (Monad !) (file.System !) Text (! (Try Profile)))) (do (try.with monad) - [project_file (!.use (\ fs file) //project.file) - project_file (!.use (\ project_file content) [])] + [project_file (\ fs file //project.file) + project_file (\ project_file content [])] (\ monad wrap (|> project_file (do> try.monad diff --git a/stdlib/source/program/aedifex/metadata.lux b/stdlib/source/program/aedifex/metadata.lux index 08dab9ed3..86981eb62 100644 --- a/stdlib/source/program/aedifex/metadata.lux +++ b/stdlib/source/program/aedifex/metadata.lux @@ -1,12 +1,34 @@ (.module: [lux #* + [data + [text + ["%" format (#+ format)]]] [world - [file (#+ Path)]]]) + [file (#+ Path)] + [net + ["." uri (#+ URI)]]]] + ["." // #_ + ["#." artifact (#+ Artifact)]]) (def: #export remote_file Path "maven-metadata.xml") +(def: #export (remote_artifact_uri artifact) + (-> Artifact URI) + (let [/ uri.separator] + (format (get@ #//artifact.group artifact) + / (get@ #//artifact.name artifact) + / (get@ #//artifact.version artifact) + / ..remote_file))) + +(def: #export (remote_project_uri artifact) + (-> Artifact URI) + (let [/ uri.separator] + (format (get@ #//artifact.group artifact) + / (get@ #//artifact.name artifact) + / ..remote_file))) + (def: #export local_file Path "maven-metadata-local.xml") diff --git a/stdlib/source/program/aedifex/package.lux b/stdlib/source/program/aedifex/package.lux index f871954c3..acfa7bd62 100644 --- a/stdlib/source/program/aedifex/package.lux +++ b/stdlib/source/program/aedifex/package.lux @@ -19,7 +19,7 @@ [set (#+ Set)]]]] ["." // #_ ["/" profile] - ["#." hash (#+ Hash SHA-1 MD5)] + ["#." hash] ["#." pom] [dependency (#+ Dependency) ["#." status (#+ Status)]] @@ -49,10 +49,14 @@ (def: #export (local pom library) (-> XML Binary Package) {#origin (#//origin.Local "") - #library [library #//status.Unverified] - #pom [pom - (|> pom (\ xml.codec encode) (\ utf8.codec encode)) - #//status.Unverified]}) + #library [library + (#//status.Verified (//hash.sha-1 library) + (//hash.md5 library))] + #pom (let [binary_pom (|> pom (\ xml.codec encode) (\ utf8.codec encode))] + [pom + binary_pom + (#//status.Verified (//hash.sha-1 binary_pom) + (//hash.md5 binary_pom))])}) (def: #export dependencies (-> Package (Try (Set Dependency))) 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 [] + [(exception: #export ( {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]))))) ) diff --git a/stdlib/source/program/compositor.lux b/stdlib/source/program/compositor.lux index 557e9d22a..f443301db 100644 --- a/stdlib/source/program/compositor.lux +++ b/stdlib/source/program/compositor.lux @@ -8,8 +8,6 @@ [control ["." io (#+ IO io)] ["." try (#+ Try)] - [security - ["!" capability]] [concurrency ["." promise (#+ Promise) ("#\." monad)]]] [data @@ -97,14 +95,14 @@ (! (Try (File !))) (:assume (file.get_file monad file_system package)))] - (!.use (\ (:share [!] - (Monad !) - monad - - (File !) - (:assume package)) - over_write) - [content])) + (\ (:share [!] + (Monad !) + monad + + (File !) + (:assume package)) + over_write + content)) (#try.Failure error) (\ monad wrap (#try.Failure error)))} @@ -118,7 +116,7 @@ (do (try.with monad) [package (: (Promise (Try (File Promise))) (file.get_file monad file_system package))] - (!.use (\ (: (File Promise) package) over_write) [content])) + (\ (: (File Promise) package) over_write content)) (#try.Failure error) (\ monad wrap (#try.Failure error)))))))) diff --git a/stdlib/source/program/compositor/export.lux b/stdlib/source/program/compositor/export.lux index 2c764aff9..238034534 100644 --- a/stdlib/source/program/compositor/export.lux +++ b/stdlib/source/program/compositor/export.lux @@ -5,9 +5,7 @@ [control ["." try (#+ Try)] [concurrency - ["." promise (#+ Promise)]] - [security - ["!" capability]]] + ["." promise (#+ Promise)]]] [data ["." text ["%" format (#+ format)]] @@ -72,4 +70,4 @@ (format target (\ system separator) ..file)))] (|> tar (binary.run tar.writer) - (!.use (\ package over_write))))) + (\ package over_write)))) diff --git a/stdlib/source/program/compositor/import.lux b/stdlib/source/program/compositor/import.lux index 7b4a9262e..19a2d7607 100644 --- a/stdlib/source/program/compositor/import.lux +++ b/stdlib/source/program/compositor/import.lux @@ -7,8 +7,6 @@ ["." exception (#+ exception:)] [concurrency ["." promise (#+ Promise) ("#\." monad)]] - [security - ["!" capability]] ["<>" parser ["" binary]]] [data @@ -47,8 +45,8 @@ (-> (file.System Promise) Library Import (Action Import)) (do (try.with promise.monad) [file (: (Action (File Promise)) - (!.use (\ system file) [library])) - binary (!.use (\ file content) [])] + (\ system file library)) + binary (\ file content [])] (promise\wrap (do {! try.monad} [tar (.run tar.parser binary)] -- cgit v1.2.3