aboutsummaryrefslogtreecommitdiff
path: root/stdlib/source/program/aedifex
diff options
context:
space:
mode:
Diffstat (limited to '')
-rw-r--r--stdlib/source/program/aedifex.lux11
-rw-r--r--stdlib/source/program/aedifex/command/auto.lux10
-rw-r--r--stdlib/source/program/aedifex/command/build.lux29
-rw-r--r--stdlib/source/program/aedifex/command/clean.lux12
-rw-r--r--stdlib/source/program/aedifex/command/install.lux4
-rw-r--r--stdlib/source/program/aedifex/command/pom.lux4
-rw-r--r--stdlib/source/program/aedifex/command/test.lux15
-rw-r--r--stdlib/source/program/aedifex/dependency/deployment.lux28
-rw-r--r--stdlib/source/program/aedifex/dependency/resolution.lux6
-rw-r--r--stdlib/source/program/aedifex/dependency/status.lux6
-rw-r--r--stdlib/source/program/aedifex/input.lux10
-rw-r--r--stdlib/source/program/aedifex/metadata.lux24
-rw-r--r--stdlib/source/program/aedifex/package.lux14
-rw-r--r--stdlib/source/program/aedifex/repository.lux10
-rw-r--r--stdlib/source/program/aedifex/repository/local.lux10
-rw-r--r--stdlib/source/program/aedifex/repository/remote.lux152
16 files changed, 150 insertions, 195 deletions
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 <capability>) [])
+ _ (|> (\ process <capability> [])
(promise.await (function (recur ?line)
(case ?line
(#try.Failure error)
@@ -156,7 +154,7 @@
(#try.Success _)
(promise.await recur
- (!.use (\ process <capability>) []))))
+ (\ process <capability> []))))
(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
- ["<c>" code]]
- [security
- ["!" capability]]]
+ ["<.>" code]]]
[data
[binary (#+ Binary)]
["." text
@@ -46,13 +44,13 @@
(|>> (do> try.monad
[(\ utf8.codec decode)]
[..parse_lux]
- [(list) (<c>.run //parser.project)])))
+ [(list) (<code>.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 [<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])))))
)
generated by cgit v1.2.3 (git 2.25.1) at 2024-12-25 09:08:37 +0000