diff options
Diffstat (limited to 'stdlib/source/program/aedifex')
| -rw-r--r-- | stdlib/source/program/aedifex/cache.lux | 84 | ||||
| -rw-r--r-- | stdlib/source/program/aedifex/cli.lux | 3 | ||||
| -rw-r--r-- | stdlib/source/program/aedifex/command/deploy.lux | 13 | ||||
| -rw-r--r-- | stdlib/source/program/aedifex/dependency/resolution.lux | 49 | ||||
| -rw-r--r-- | stdlib/source/program/aedifex/package.lux | 25 | ||||
| -rw-r--r-- | stdlib/source/program/aedifex/repository.lux | 93 | ||||
| -rw-r--r-- | stdlib/source/program/aedifex/repository/identity.lux | 42 |
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 ")))) |