From c8f9f42a258f1f2f961c7f8c5571cce843e97a0a Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Wed, 26 Aug 2020 23:04:27 -0400 Subject: Download and catch dependencies in Aedifex. --- stdlib/source/program/aedifex/dependency.lux | 276 ++++++++++++++++++++++++++- 1 file changed, 275 insertions(+), 1 deletion(-) (limited to 'stdlib/source/program/aedifex/dependency.lux') diff --git a/stdlib/source/program/aedifex/dependency.lux b/stdlib/source/program/aedifex/dependency.lux index 473d5498e..7c40bf2ae 100644 --- a/stdlib/source/program/aedifex/dependency.lux +++ b/stdlib/source/program/aedifex/dependency.lux @@ -1,12 +1,55 @@ (.module: - [lux (#- Type)] + [lux (#- Name Type) + ["." host (#+ import:)] + [abstract + [monad (#+ do)] + ["." hash (#+ Hash)]] + [control + ["." io (#+ IO)] + ["." try (#+ Try)] + ["." exception (#+ Exception exception:)] + ["<>" parser + ["" xml (#+ Parser)]]] + [data + ["." binary (#+ Binary)] + ["." name] + ["." maybe] + ["." text + ["%" format (#+ format)] + ["." encoding]] + [number + ["." i64] + ["n" nat]] + [format + ["." xml (#+ Tag XML)]] + [collection + ["." dictionary (#+ Dictionary)]]] + [world + [net (#+ URL) + ["." uri]]]] ["." // #_ + ["#." extension] + ["#." artifact (#+ Artifact)] ["#." hash]]) +(type: #export Repository + URL) + ## https://maven.apache.org/ref/3.6.3/maven-core/artifact-handlers.html (type: #export Type Text) +(type: #export Dependency + {#artifact Artifact + #type ..Type}) + +(def: #export hash + (Hash Dependency) + ($_ hash.product + //artifact.hash + text.hash + )) + (template [ ] [(def: #export Type @@ -15,3 +58,234 @@ ["tar" lux-library] ["jar" jvm-library] ) + +(import: #long java/lang/String) + +(import: #long java/lang/AutoCloseable + (close [] #io #try void)) + +(import: #long java/io/InputStream) + +(import: #long java/net/URL + (new [java/lang/String]) + (openStream [] #io #try java/io/InputStream)) + +(import: #long java/io/BufferedInputStream + (new [java/io/InputStream]) + (read [[byte] int int] #io #try int)) + +(def: buffer-size + (n.* 512 1,024)) + +(def: (download url) + (-> URL (IO (Try Binary))) + (do {@ (try.with io.monad)} + [input (|> (java/net/URL::new url) + java/net/URL::openStream + (:: @ map (|>> java/io/BufferedInputStream::new))) + #let [buffer (binary.create ..buffer-size)]] + (loop [output (:: binary.monoid identity)] + (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)) + _ (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))))))))) + +(def: hex-per-byte + 2) + +(def: hex-per-nat + (n.* hex-per-byte i64.bytes-per-i64)) + +(type: Hash-Reader + (-> Binary (Try //hash.Hash))) + +(def: (sha1 input) + Hash-Reader + (do try.monad + [input (encoding.from-utf8 input) + [left input] (try.from-maybe (text.split ..hex-per-nat input)) + [middle right] (try.from-maybe (text.split ..hex-per-nat input)) + #let [output (:: binary.monoid identity)] + left (:: n.hex decode left) + output (binary.write/64 0 left output) + middle (:: n.hex decode middle) + output (binary.write/64 i64.bytes-per-i64 middle output) + right (:: n.hex decode right)] + (binary.write/64 (n.* 2 i64.bytes-per-i64) right output))) + +(def: (md5 input) + Hash-Reader + (do try.monad + [input (encoding.from-utf8 input) + [left right] (try.from-maybe (text.split ..hex-per-nat input)) + #let [output (:: binary.monoid identity)] + left (:: n.hex decode left) + output (binary.write/64 0 left output) + right (:: n.hex decode right)] + (binary.write/64 i64.bytes-per-i64 right output))) + +(template [] + [(exception: #export ( {dependency Dependency} {hash Text}) + (let [artifact (get@ #artifact dependency) + type (get@ #type dependency)] + (exception.report + ["Artifact" (format (get@ #//artifact.group artifact) + " " (get@ #//artifact.name artifact) + " " (get@ #//artifact.version artifact))] + ["Type" (%.text type)] + ["Hash" (%.text hash)])))] + + [sha1-does-not-match] + [md5-does-not-match] + ) + +(type: #export Package + {#library Binary + #pom XML + #dependencies (List Dependency) + #sha1 Text + #md5 Text}) + +(def: (verified-hash dependency library url hash reader exception) + (-> Dependency Binary URL (-> Binary //hash.Hash) Hash-Reader (Exception [Dependency Text]) + (IO (Try Text))) + (do (try.with io.monad) + [#let [reference (hash library)] + actual (..download url)] + (:: io.monad wrap + (do try.monad + [output (encoding.from-utf8 actual) + actual (reader actual) + _ (exception.assert exception [dependency output] + (:: binary.equivalence = reference actual))] + (wrap output))))) + +(def: parse-property + (Parser [Tag Text]) + (do <>.monad + [property .tag + _ (.node property) + value (.children .text)] + (wrap [property value]))) + +(def: parse-dependency + (Parser Dependency) + (do {@ <>.monad} + [properties (:: @ map (dictionary.from-list name.hash) + (.children (<>.some ..parse-property)))] + (<| <>.lift + try.from-maybe + (do maybe.monad + [group (dictionary.get ["" "groupId"] properties) + artifact (dictionary.get ["" "artifactId"] properties) + version (dictionary.get ["" "version"] properties)] + (wrap {#artifact {#//artifact.group group + #//artifact.name artifact + #//artifact.version version} + #type (|> properties + (dictionary.get ["" "type"]) + (maybe.default ..lux-library))}))))) + +(def: parse-dependencies + (Parser (List Dependency)) + (do {@ <>.monad} + [_ (.node ["" "dependencies"])] + (.children (<>.some ..parse-dependency)))) + +(def: #export from-pom + (-> XML (Try (List Dependency))) + (.run (do {@ <>.monad} + [_ (.node ["" "project"])] + (.children (loop [_ []] + (do @ + [?dependencies (<>.or ..parse-dependencies + (<>.maybe .ignore))] + (case ?dependencies + (#.Left dependencies) + (wrap dependencies) + + (#.Right #.None) + (wrap (: (List Dependency) + (list))) + + (#.Right (#.Some _)) + (recur [])))))))) + +(def: #export (resolve repository dependency) + (-> Repository Dependency (IO (Try Package))) + (let [[artifact type] dependency + prefix (format repository uri.separator (//artifact.path artifact))] + (do (try.with io.monad) + [library (..download (format prefix "." type)) + sha1 (..verified-hash dependency library (format prefix //extension.sha1) //hash.sha1 ..sha1 ..sha1-does-not-match) + md5 (..verified-hash dependency library (format prefix //extension.md5) //hash.md5 ..md5 ..md5-does-not-match) + pom (..download (format prefix //extension.pom))] + (:: io.monad wrap + (do try.monad + [pom (encoding.from-utf8 pom) + pom (:: xml.codec decode pom) + dependencies (..from-pom pom)] + (wrap {#library library + #pom pom + #dependencies dependencies + #sha1 sha1 + #md5 md5})))))) + +(type: #export Resolution + (Dictionary Dependency Package)) + +(def: #export empty + Resolution + (dictionary.new ..hash)) + +(exception: #export (cannot-resolve {dependency Dependency}) + (let [artifact (get@ #artifact dependency) + type (get@ #type dependency)] + (exception.report + ["Artifact" (format (get@ #//artifact.group artifact) + " " (get@ #//artifact.name artifact) + " " (get@ #//artifact.version artifact))] + ["Type" (%.text type)]))) + +(def: (resolve-any repositories dependency) + (-> (List Repository) Dependency (IO (Try Package))) + (case repositories + #.Nil + (|> dependency + (exception.throw ..cannot-resolve) + (:: io.monad wrap)) + + (#.Cons repository alternatives) + (do io.monad + [outcome (..resolve repository dependency)] + (case outcome + (#try.Success package) + (wrap outcome) + + (#try.Failure error) + (resolve-any alternatives dependency))))) + +(def: #export (resolve-all repositories dependencies resolution) + (-> (List Repository) (List Dependency) Resolution (IO (Try Resolution))) + (case dependencies + #.Nil + (:: (try.with io.monad) wrap resolution) + + (#.Cons head tail) + (do (try.with io.monad) + [package (case (dictionary.get head resolution) + (#.Some package) + (wrap package) + + #.None + (..resolve-any repositories head)) + #let [resolution (dictionary.put head package resolution)] + resolution (resolve-all repositories (get@ #dependencies package) resolution)] + (resolve-all repositories tail resolution)))) -- cgit v1.2.3