(.module: [lux (#- Name Type) ["." host (#+ import:)] [abstract [monad (#+ do)] ["." equivalence (#+ Equivalence)] ["." 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 equivalence (Equivalence Dependency) ($_ equivalence.product //artifact.equivalence text.equivalence )) (def: #export hash (Hash Dependency) ($_ hash.product //artifact.hash text.hash )) (template [ ] [(def: #export Type )] ["tar" lux-library] ["jar" jvm-library] ["pom" pom] ) (import: java/lang/String) (import: java/lang/AutoCloseable (close [] #io #try void)) (import: java/io/InputStream) (import: java/net/URL (new [java/lang/String]) (openStream [] #io #try java/io/InputStream)) (import: 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))))