aboutsummaryrefslogtreecommitdiff
path: root/stdlib/source/program/aedifex
diff options
context:
space:
mode:
Diffstat (limited to 'stdlib/source/program/aedifex')
-rw-r--r--stdlib/source/program/aedifex/cache.lux84
-rw-r--r--stdlib/source/program/aedifex/cli.lux3
-rw-r--r--stdlib/source/program/aedifex/command/deploy.lux13
-rw-r--r--stdlib/source/program/aedifex/dependency/resolution.lux49
-rw-r--r--stdlib/source/program/aedifex/package.lux25
-rw-r--r--stdlib/source/program/aedifex/repository.lux93
-rw-r--r--stdlib/source/program/aedifex/repository/identity.lux42
7 files changed, 179 insertions, 130 deletions
diff --git a/stdlib/source/program/aedifex/cache.lux b/stdlib/source/program/aedifex/cache.lux
index 50062c3f7..ce95f65b7 100644
--- a/stdlib/source/program/aedifex/cache.lux
+++ b/stdlib/source/program/aedifex/cache.lux
@@ -26,12 +26,14 @@
["." file (#+ Path File Directory)]]]
["." // #_
["#" local]
- ["#." hash]
+ ["#." hash (#+ Hash SHA-1 MD5)]
["#." package (#+ Package)]
["#." artifact (#+ Artifact)
- ["#/." extension]]
- [dependency (#+ Dependency)
- [resolution (#+ Resolution)]]])
+ ["#/." type]
+ ["#/." extension (#+ Extension)]]
+ ["#." dependency (#+ Dependency)
+ [resolution (#+ Resolution)]
+ ["#/." status (#+ Status)]]])
(def: (write! system content file)
(-> (file.System Promise) Binary Path (Promise (Try Any)))
@@ -40,6 +42,36 @@
(file.get-file promise.monad system file))]
(!.use (\ file over-write) [content])))
+(def: (write-hashed system directory [artifact type] [data status])
+ (-> (file.System Promise) Path Dependency [Binary Status] (Promise (Try Any)))
+ (let [prefix (format directory
+ (\ system separator)
+ (//artifact.identity artifact)
+ (//artifact/extension.extension type))]
+ (do {! (try.with promise.monad)}
+ [_ (..write! system data prefix)
+ #let [write-hash (: (All [h] (-> (Codec Text (Hash h)) Extension (Hash h) (Promise (Try Any))))
+ (function (_ codec extension hash)
+ (..write! system
+ (|> hash (\ codec encode) (\ encoding.utf8 encode))
+ (format prefix extension))))]]
+ (case status
+ #//dependency/status.Unverified
+ (wrap [])
+
+ (#//dependency/status.Partial partial)
+ (case partial
+ (#.Left sha-1)
+ (write-hash //hash.sha-1-codec //artifact/extension.sha-1 sha-1)
+
+ (#.Right md5)
+ (write-hash //hash.md5-codec //artifact/extension.md5 md5))
+
+ (#//dependency/status.Verified sha-1 md5)
+ (do !
+ [_ (write-hash //hash.sha-1-codec //artifact/extension.sha-1 sha-1)]
+ (write-hash //hash.md5-codec //artifact/extension.md5 md5))))))
+
(def: #export (write-one program system [artifact type] package)
(-> (Program Promise) (file.System Promise) Dependency Package (Promise (Try Artifact)))
(do promise.monad
@@ -47,27 +79,12 @@
(do (try.with promise.monad)
[directory (: (Promise (Try Path))
(file.make-directories promise.monad system (//.path system home artifact)))
- #let [prefix (format directory (\ system separator) (//artifact.identity artifact))]
- directory (: (Promise (Try (Directory Promise)))
- (file.get-directory promise.monad system directory))
- _ (..write! system
- (get@ #//package.library package)
- (format prefix (//artifact/extension.extension type)))
- _ (..write! system
- (|> package
- (get@ #//package.sha-1)
- (\ //hash.sha-1-codec encode)
- (\ encoding.utf8 encode))
- (format prefix //artifact/extension.sha-1))
- _ (..write! system
- (|> package
- (get@ #//package.md5)
- (\ //hash.md5-codec encode)
- (\ encoding.utf8 encode))
- (format prefix //artifact/extension.md5))
- _ (..write! system
- (|> package (get@ #//package.pom) (\ xml.codec encode) (\ encoding.utf8 encode))
- (format prefix //artifact/extension.pom))]
+ _ (write-hashed system directory [artifact type] (get@ #//package.library package))
+ _ (let [[pom status] (get@ #//package.pom package)]
+ (write-hashed system directory
+ [artifact //artifact/type.pom]
+ [(|> pom (\ xml.codec encode) (\ encoding.utf8 encode))
+ status]))]
(wrap artifact))))
(def: #export (write-all program system resolution)
@@ -104,19 +121,18 @@
(//artifact.identity artifact))]]
(do (try.with promise.monad)
[pom (..read! system (format prefix //artifact/extension.pom))
- library (..read! system (format prefix (//artifact/extension.extension type)))
- sha-1 (..read! system (format prefix //artifact/extension.sha-1))
- md5 (..read! system (format prefix //artifact/extension.md5))]
+ #let [extension (//artifact/extension.extension type)]
+ library (..read! system (format prefix extension))
+ library-sha-1 (..read! system (format prefix extension //artifact/extension.sha-1))
+ library-md5 (..read! system (format prefix extension //artifact/extension.md5))]
(\ promise.monad wrap
(do try.monad
[pom (..decode xml.codec pom)
- sha-1 (..decode //hash.sha-1-codec sha-1)
- md5 (..decode //hash.md5-codec md5)]
+ library-sha-1 (..decode //hash.sha-1-codec library-sha-1)
+ library-md5 (..decode //hash.md5-codec library-md5)]
(wrap {#//package.origin #//package.Local
- #//package.library library
- #//package.pom pom
- #//package.sha-1 sha-1
- #//package.md5 md5}))))))
+ #//package.library [library (#//dependency/status.Verified library-sha-1 library-md5)]
+ #//package.pom [pom #//dependency/status.Unverified]}))))))
(def: #export (read-all program system dependencies resolution)
(-> (Program Promise) (file.System Promise) (List Dependency) Resolution (Promise (Try Resolution)))
diff --git a/stdlib/source/program/aedifex/cli.lux b/stdlib/source/program/aedifex/cli.lux
index c00f62852..4625136a3 100644
--- a/stdlib/source/program/aedifex/cli.lux
+++ b/stdlib/source/program/aedifex/cli.lux
@@ -10,7 +10,8 @@
["." product]
["." text]]]
[//
- [repository (#+ Identity)]
+ [repository
+ [identity (#+ Identity)]]
["/" profile (#+ Name)]])
(type: #export Compilation
diff --git a/stdlib/source/program/aedifex/command/deploy.lux b/stdlib/source/program/aedifex/command/deploy.lux
index 4e33b145a..5763c1ff5 100644
--- a/stdlib/source/program/aedifex/command/deploy.lux
+++ b/stdlib/source/program/aedifex/command/deploy.lux
@@ -36,7 +36,8 @@
["#." action (#+ Action)]
["#." pom]
["#." hash]
- ["#." repository (#+ Identity Repository)]
+ ["#." repository (#+ Repository)
+ [identity (#+ Identity)]]
["#." metadata
["#/." artifact]
["#/." snapshot]]
@@ -89,11 +90,11 @@
(format ///artifact/type.lux-library ///artifact/extension.sha-1)
(format ///artifact/type.lux-library ///artifact/extension.md5)))
-(def: #export (do! console repository fs identity artifact profile)
- (-> (Console Promise) (Repository Promise) (file.System Promise) Identity Artifact (Command Any))
+(def: #export (do! console repository fs artifact profile)
+ (-> (Console Promise) (Repository Promise) (file.System Promise) Artifact (Command Any))
(let [deploy! (: (-> Extension Binary (Action Any))
(|>> (///repository.uri artifact)
- (\ repository upload identity)))
+ (\ repository upload)))
fully-deploy! (: (-> Extension Binary (Action Any))
(function (_ extension payload)
(do ///action.monad
@@ -126,12 +127,12 @@
///metadata/snapshot.write
(\ xml.codec encode)
(\ encoding.utf8 encode)
- (\ repository upload identity (///metadata.version artifact)))
+ (\ repository upload (///metadata.version artifact)))
_ (|> project
(set@ #///metadata/artifact.versions (list version))
(set@ #///metadata/artifact.last-updated now)
///metadata/artifact.write
(\ xml.codec encode)
(\ encoding.utf8 encode)
- (\ repository upload identity (///metadata.project artifact)))]
+ (\ repository upload (///metadata.project artifact)))]
(console.write-line //clean.success console)))))
diff --git a/stdlib/source/program/aedifex/dependency/resolution.lux b/stdlib/source/program/aedifex/dependency/resolution.lux
index 2131495b9..f49d1da56 100644
--- a/stdlib/source/program/aedifex/dependency/resolution.lux
+++ b/stdlib/source/program/aedifex/dependency/resolution.lux
@@ -31,65 +31,70 @@
[net (#+ URL)
["." uri]]]]
["." // (#+ Dependency)
+ ["#." status (#+ Status)]
["/#" // #_
["/" profile]
["#." repository (#+ Address Repository)]
- ["#." hash]
+ ["#." hash (#+ Hash SHA-1 MD5)]
["#." pom]
["#." package (#+ Package)]
["#." artifact (#+ Artifact)
["#/." extension (#+ Extension)]]]])
(template [<name>]
- [(exception: #export (<name> {dependency Dependency} {hash Text})
+ [(exception: #export (<name> {artifact Artifact} {extension Extension} {hash Text})
(exception.report
- ["Artifact" (///artifact.format (get@ #//.artifact dependency))]
- ["Type" (%.text (get@ #//.type dependency))]
+ ["Artifact" (///artifact.format artifact)]
+ ["Extension" (%.text extension)]
["Hash" (%.text hash)]))]
[sha-1-does-not-match]
[md5-does-not-match]
)
-(def: (verified-hash dependency library repository artifact extension hash codec exception)
+(def: (verified-hash library repository artifact extension hash codec exception)
(All [h]
- (-> Dependency Binary (Repository Promise) Artifact Extension
- (-> Binary (///hash.Hash h)) (Codec Text (///hash.Hash h))
- (Exception [Dependency Text])
- (Promise (Try (///hash.Hash h)))))
+ (-> Binary (Repository Promise) Artifact Extension
+ (-> Binary (Hash h)) (Codec Text (Hash h))
+ (Exception [Artifact Extension Text])
+ (Promise (Try (Hash h)))))
(do (try.with promise.monad)
[actual (\ repository download (///repository.uri artifact extension))]
(\ promise.monad wrap
(do try.monad
[output (\ encoding.utf8 decode actual)
actual (\ codec decode output)
- _ (exception.assert exception [dependency output]
+ _ (exception.assert exception [artifact extension output]
(\ ///hash.equivalence = (hash library) actual))]
(wrap actual)))))
+(def: (hashed repository artifact extension)
+ (-> (Repository Promise) Artifact Extension (Promise (Try [Binary Status])))
+ (do (try.with promise.monad)
+ [data (\ repository download (///repository.uri artifact extension))
+ sha-1 (..verified-hash data
+ repository artifact (format extension ///artifact/extension.sha-1)
+ ///hash.sha-1 ///hash.sha-1-codec ..sha-1-does-not-match)
+ md5 (..verified-hash data
+ repository artifact (format extension ///artifact/extension.md5)
+ ///hash.md5 ///hash.md5-codec ..md5-does-not-match)]
+ (wrap [data (#//status.Verified sha-1 md5)])))
+
(def: #export (one repository dependency)
(-> (Repository Promise) Dependency (Promise (Try Package)))
(let [[artifact type] dependency
extension (///artifact/extension.extension type)]
(do (try.with promise.monad)
- [library (\ repository download (///repository.uri artifact extension))
- sha-1 (..verified-hash dependency library
- repository artifact ///artifact/extension.sha-1
- ///hash.sha-1 ///hash.sha-1-codec ..sha-1-does-not-match)
- md5 (..verified-hash dependency library
- repository artifact ///artifact/extension.md5
- ///hash.md5 ///hash.md5-codec ..md5-does-not-match)
- pom (\ repository download (///repository.uri artifact ///artifact/extension.pom))]
+ [[pom pom-status] (..hashed repository artifact ///artifact/extension.pom)
+ library-&-status (..hashed repository artifact extension)]
(\ promise.monad wrap
(do try.monad
[pom (\ encoding.utf8 decode pom)
pom (\ xml.codec decode pom)
profile (<xml>.run ///pom.parser pom)]
(wrap {#///package.origin #///package.Remote
- #///package.library library
- #///package.pom pom
- #///package.sha-1 sha-1
- #///package.md5 md5}))))))
+ #///package.library library-&-status
+ #///package.pom [pom pom-status]}))))))
(type: #export Resolution
(Dictionary Dependency Package))
diff --git a/stdlib/source/program/aedifex/package.lux b/stdlib/source/program/aedifex/package.lux
index de831555e..03f2c3994 100644
--- a/stdlib/source/program/aedifex/package.lux
+++ b/stdlib/source/program/aedifex/package.lux
@@ -15,7 +15,8 @@
[collection
[set (#+ Set)]]]]
["." // #_
- [dependency (#+ Dependency)]
+ [dependency (#+ Dependency)
+ ["#." status (#+ Status)]]
["/" profile]
["#." hash (#+ Hash SHA-1 MD5)]
["#." pom]])
@@ -34,14 +35,13 @@
(Equivalence Origin)
($_ sum.equivalence
..any-equivalence
- ..any-equivalence))
+ ..any-equivalence
+ ))
(type: #export Package
{#origin Origin
- #library Binary
- #pom XML
- #sha-1 (Hash SHA-1)
- #md5 (Hash MD5)})
+ #library [Binary Status]
+ #pom [XML Status]})
(template [<name> <tag>]
[(def: #export <name>
@@ -55,14 +55,13 @@
(def: #export (local pom library)
(-> XML Binary Package)
{#origin #Local
- #library library
- #pom pom
- #sha-1 (//hash.sha-1 library)
- #md5 (//hash.md5 library)})
+ #library [library #//status.Unverified]
+ #pom [pom #//status.Unverified]})
(def: #export dependencies
(-> Package (Try (Set Dependency)))
(|>> (get@ #pom)
+ product.left
(<xml>.run //pom.parser)
(try\map (get@ #/.dependencies))))
@@ -70,8 +69,6 @@
(Equivalence Package)
($_ product.equivalence
..origin-equivalence
- binary.equivalence
- xml.equivalence
- //hash.equivalence
- //hash.equivalence
+ (product.equivalence binary.equivalence //status.equivalence)
+ (product.equivalence xml.equivalence //status.equivalence)
))
diff --git a/stdlib/source/program/aedifex/repository.lux b/stdlib/source/program/aedifex/repository.lux
index c351e9d0c..351d1c066 100644
--- a/stdlib/source/program/aedifex/repository.lux
+++ b/stdlib/source/program/aedifex/repository.lux
@@ -13,8 +13,7 @@
[data
["." binary (#+ Binary)]
["." text
- ["%" format (#+ format)]
- ["." encoding]]
+ ["%" format (#+ format)]]
[number
["n" nat]]]
[tool
@@ -26,27 +25,19 @@
[world
[net (#+ URL)
["." uri (#+ URI)]]]]
- ["." // #_
- ["#." artifact (#+ Artifact)
- ["#/." extension (#+ Extension)]]])
+ ["." / #_
+ ["#." identity (#+ Identity)]
+ ["/#" // #_
+ ["#." artifact (#+ Artifact)
+ ["#/." extension (#+ Extension)]]]])
(type: #export Address
URL)
-(type: #export User
- Text)
-
-(type: #export Password
- Text)
-
-(type: #export Identity
- {#user User
- #password Password})
-
(signature: #export (Repository !)
(: (-> URI (! (Try Binary)))
download)
- (: (-> Identity URI Binary (! (Try Any)))
+ (: (-> URI Binary (! (Try Any)))
upload))
(def: #export (async repository)
@@ -55,14 +46,14 @@
(def: (download uri)
(promise.future (\ repository download uri)))
- (def: (upload identity uri content)
- (promise.future (\ repository upload identity uri content)))
+ (def: (upload uri content)
+ (promise.future (\ repository upload uri content)))
))
(signature: #export (Simulation s)
(: (-> URI s (Try [s Binary]))
on-download)
- (: (-> Identity URI Binary s (Try s))
+ (: (-> URI Binary s (Try s))
on-upload))
(def: #export (mock simulation init)
@@ -82,11 +73,11 @@
(#try.Failure error)
(wrap (#try.Failure error))))))
- (def: (upload identity uri content)
+ (def: (upload uri content)
(stm.commit
(do {! stm.monad}
[|state| (stm.read state)]
- (case (\ simulation on-upload identity uri content |state|)
+ (case (\ simulation on-upload uri content |state|)
(#try.Success |state|)
(do !
[_ (stm.write |state| state)]
@@ -126,28 +117,19 @@
(new [java/lang/String])
(openConnection [] #io #try java/net/URLConnection)])
-(import: java/util/Base64$Encoder
- ["#::."
- (encodeToString [[byte]] java/lang/String)])
-
-(import: java/util/Base64
- ["#::."
- (#static getEncoder [] java/util/Base64$Encoder)])
-
(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)]))
-(def: (basic-auth user password)
- (-> User Password Text)
- (format "Basic " (java/util/Base64$Encoder::encodeToString (\ encoding.utf8 encode (format user ":" password))
- (java/util/Base64::getEncoder))))
-
(def: #export (uri artifact extension)
(-> Artifact Extension URI)
(format (//artifact.uri artifact) extension))
@@ -158,8 +140,8 @@
(def: user-agent
(format "LuxAedifex/" (version.format language/lux.version)))
-(structure: #export (remote address)
- (All [s] (-> Address (Repository IO)))
+(structure: #export (remote identity address)
+ (All [s] (-> (Maybe Identity) Address (Repository IO)))
(def: (download uri)
(do {! (try.with io.monad)}
@@ -186,21 +168,26 @@
[chunk (\ io.monad wrap (binary.slice 0 (.nat bytes-read) buffer))]
(recur (\ binary.monoid compose output chunk)))))))))
- (def: (upload [user password] uri content)
- (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" (..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])))))
+ (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]))))))
)
diff --git a/stdlib/source/program/aedifex/repository/identity.lux b/stdlib/source/program/aedifex/repository/identity.lux
new file mode 100644
index 000000000..fbc93f367
--- /dev/null
+++ b/stdlib/source/program/aedifex/repository/identity.lux
@@ -0,0 +1,42 @@
+(.module:
+ [lux #*
+ ["." host (#+ import:)]
+ [abstract
+ [equivalence (#+ Equivalence)]]
+ [data
+ ["." product]
+ ["." text
+ ["%" format (#+ format)]
+ ["." encoding]]]])
+
+(type: #export User
+ Text)
+
+(type: #export Password
+ Text)
+
+(type: #export Identity
+ {#user User
+ #password Password})
+
+(def: #export equivalence
+ (Equivalence Identity)
+ ($_ product.equivalence
+ text.equivalence
+ text.equivalence
+ ))
+
+(import: java/util/Base64$Encoder
+ ["#::."
+ (encodeToString [[byte]] java/lang/String)])
+
+(import: java/util/Base64
+ ["#::."
+ (#static getEncoder [] java/util/Base64$Encoder)])
+
+(def: #export (basic-auth user password)
+ (-> User Password Text)
+ (let [credentials (\ encoding.utf8 encode (format user ":" password))]
+ (|> (java/util/Base64::getEncoder)
+ (java/util/Base64$Encoder::encodeToString credentials)
+ (format "Basic "))))