diff options
Diffstat (limited to 'stdlib/source/program/aedifex')
| -rw-r--r-- | stdlib/source/program/aedifex/command/deploy.lux | 4 | ||||
| -rw-r--r-- | stdlib/source/program/aedifex/dependency.lux | 54 | ||||
| -rw-r--r-- | stdlib/source/program/aedifex/hash.lux | 164 | ||||
| -rw-r--r-- | stdlib/source/program/aedifex/local.lux | 8 |
4 files changed, 163 insertions, 67 deletions
diff --git a/stdlib/source/program/aedifex/command/deploy.lux b/stdlib/source/program/aedifex/command/deploy.lux index a4b076733..b63aa2972 100644 --- a/stdlib/source/program/aedifex/command/deploy.lux +++ b/stdlib/source/program/aedifex/command/deploy.lux @@ -69,6 +69,6 @@ pom (promise@wrap (///pom.project profile)) _ (deploy! ///artifact/type.pom (|> pom (:: xml.codec encode) encoding.to-utf8)) _ (deploy! ///artifact/type.lux-library library) - _ (deploy! "sha1" (///hash.sha1 library)) - _ (deploy! "md5" (///hash.md5 library))] + _ (deploy! "sha1" (///hash.data (///hash.sha1 library))) + _ (deploy! "md5" (///hash.data (///hash.md5 library)))] (wrap []))))) diff --git a/stdlib/source/program/aedifex/dependency.lux b/stdlib/source/program/aedifex/dependency.lux index 52a1f00c5..de6a1e4cf 100644 --- a/stdlib/source/program/aedifex/dependency.lux +++ b/stdlib/source/program/aedifex/dependency.lux @@ -2,6 +2,7 @@ [lux (#- Name) ["." host (#+ import:)] [abstract + [codec (#+ Codec)] [monad (#+ do)] ["." equivalence (#+ Equivalence)] ["." hash (#+ Hash)]] @@ -93,40 +94,6 @@ [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 [<name>] [(exception: #export (<name> {dependency Dependency} {hash Text}) (let [artifact (get@ #artifact dependency) @@ -149,18 +116,21 @@ #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))) +(def: (verified-hash dependency library url hash codec exception) + (All [h] + (-> Dependency Binary URL + (-> Binary (//hash.Hash h)) (Codec Text (//hash.Hash h)) + (Exception [Dependency Text]) + (IO (Try Text)))) (do (try.with io.monad) - [#let [reference (hash library)] + [#let [expected (hash library)] actual (..download url)] (:: io.monad wrap (do try.monad [output (encoding.from-utf8 actual) - actual (reader actual) + actual (:: codec decode output) _ (exception.assert exception [dependency output] - (:: binary.equivalence = reference actual))] + (:: //hash.equivalence = expected actual))] (wrap output))))) (def: parse-property @@ -220,8 +190,8 @@ prefix (format repository uri.separator (//artifact.path artifact))] (do (try.with io.monad) [library (..download (format prefix (//artifact/extension.extension type))) - sha1 (..verified-hash dependency library (format prefix //artifact/extension.sha1) //hash.sha1 ..sha1 ..sha1-does-not-match) - md5 (..verified-hash dependency library (format prefix //artifact/extension.md5) //hash.md5 ..md5 ..md5-does-not-match) + sha1 (..verified-hash dependency library (format prefix //artifact/extension.sha1) //hash.sha1 //hash.sha1-codec ..sha1-does-not-match) + md5 (..verified-hash dependency library (format prefix //artifact/extension.md5) //hash.md5 //hash.md5-codec ..md5-does-not-match) pom (..download (format prefix //artifact/extension.pom))] (:: io.monad wrap (do try.monad diff --git a/stdlib/source/program/aedifex/hash.lux b/stdlib/source/program/aedifex/hash.lux index 86fe4319d..2f63d0edd 100644 --- a/stdlib/source/program/aedifex/hash.lux +++ b/stdlib/source/program/aedifex/hash.lux @@ -1,12 +1,23 @@ (.module: [lux #* ["." host (#+ import:)] + [abstract + [codec (#+ Codec)] + [equivalence (#+ Equivalence)] + [monad (#+ do)]] + [control + ["." try (#+ Try)] + ["." exception (#+ exception:)]] [data ["." binary (#+ Binary)] ["." text - ["%" format (#+ format)]] + ["%" format (#+ Format format)] + ["." encoding]] [number - ["." nat]]]]) + ["." i64] + ["n" nat]]] + [type + abstract]]) ## TODO: Replace with pure-Lux implementations of these algorithms ## https://en.wikipedia.org/wiki/SHA-1#SHA-1_pseudocode @@ -17,25 +28,136 @@ (#static getInstance [java/lang/String] java/security/MessageDigest) (digest [[byte]] [byte])) -(type: #export Hash - Binary) +(abstract: #export SHA-1 Any) +(abstract: #export MD5 Any) -(template [<name> <algorithm>] - [(def: #export (<name> value) - (-> Binary Hash) - (|> (java/security/MessageDigest::getInstance [<algorithm>]) - (java/security/MessageDigest::digest [value])))] +(abstract: #export (Hash h) + Binary - [sha1 "SHA-1"] - [md5 "MD5"] - ) + (def: #export data + (All [h] (-> (Hash h) Binary)) + (|>> :representation)) + + (template [<name> <kind> <algorithm>] + [(def: #export (<name> value) + (-> Binary (Hash <kind>)) + (|> (java/security/MessageDigest::getInstance [<algorithm>]) + (java/security/MessageDigest::digest [value]) + :abstraction))] + + [sha1 ..SHA-1 "SHA-1"] + [md5 ..MD5 "MD5"] + ) + + (def: encode + (Format Binary) + (binary.fold (function (_ byte representation) + (let [hex (:: n.hex encode byte) + hex (case (text.size hex) + 1 (format "0" hex) + _ hex)] + (format representation hex))) + "")) + + (template [<factor> <name>] + [(def: <name> + Nat + <factor>)] + + [20 sha1::size] + [16 md5::size] + ) + + (def: hex-per-byte + 2) + + (def: hex-per-chunk + (n.* hex-per-byte i64.bytes-per-i64)) + + (exception: #export (not-a-hash {size Nat} {value Text}) + (exception.report + ["Pseudo hash" (%.text value)] + ["Expected size" (%.nat size)] + ["Actual size" (%.nat (text.size value))])) + + (template [<name> <size>] + [(exception: #export (<name> {data Binary}) + (exception.report + ["Pseudo hash" (%.text (..encode data))] + ["Expected size" (%.nat <size>)] + ["Actual size" (%.nat (binary.size data))]))] + + [not-a-sha1 ..sha1::size] + [not-a-md5 ..md5::size] + ) -(def: #export representation - (-> Hash Text) - (binary.fold (function (_ byte representation) - (let [hex (:: nat.hex encode byte) - hex (case (text.size hex) - 1 (format "0" hex) - _ hex)] - (format representation hex))) - "")) + (template [<name> <kind> <size> <exception>] + [(def: #export (<name> data) + (-> Binary (Try (Hash <kind>))) + (if (n.= <size> (binary.size data)) + (#try.Success (:abstraction data)) + (exception.throw <exception> [data])))] + + [as-sha1 SHA-1 ..sha1::size ..not-a-sha1] + [as-md5 MD5 ..md5::size ..not-a-md5] + ) + + (def: hash-size + (-> Text Nat) + (|>> text.size (n./ ..hex-per-byte))) + + (def: encoding-size + (-> Nat Nat) + (n.* ..hex-per-byte)) + + (def: (decode size constructor encoded) + (All [h] + (-> Nat (-> Binary (Try (Hash h))) + (-> Text (Try (Hash h))))) + (let [hash-size (..hash-size encoded)] + (if (n.= size hash-size) + (loop [input encoded + chunk 0 + output (binary.create hash-size)] + (let [index (n.* chunk i64.bytes-per-i64)] + (case (text.split ..hex-per-chunk input) + (#.Some [head tail]) + (do try.monad + [head (:: n.hex decode head) + output (binary.write/64 index head output)] + (recur tail (inc chunk) output)) + + #.None + (case (..hash-size input) + 0 (constructor output) + (^template [<size> <write>] + <size> + (do try.monad + [head (:: n.hex decode input) + output (<write> index head output)] + (constructor output))) + ([1 binary.write/8] + [2 binary.write/16] + [4 binary.write/32]) + _ (exception.throw ..not-a-hash [(..encoding-size size) encoded]))))) + (exception.throw ..not-a-hash [(..encoding-size size) encoded])))) + + (template [<codec> <hash> <nat> <constructor>] + [(structure: #export <codec> + (Codec Text (Hash <hash>)) + + (def: encode (|>> :representation ..encode)) + (def: decode (..decode <nat> <constructor>)))] + + [sha1-codec SHA-1 ..sha1::size ..as-sha1] + [md5-codec MD5 ..md5::size ..as-md5] + ) + + (structure: #export equivalence + (All [h] (Equivalence (Hash h))) + + (def: (= reference subject) + (:: binary.equivalence = + (:representation reference) + (:representation subject)))) + ) diff --git a/stdlib/source/program/aedifex/local.lux b/stdlib/source/program/aedifex/local.lux index affbb659e..626996ef3 100644 --- a/stdlib/source/program/aedifex/local.lux +++ b/stdlib/source/program/aedifex/local.lux @@ -141,8 +141,12 @@ (wrap {#//dependency.library library #//dependency.pom pom #//dependency.dependencies dependencies - #//dependency.sha1 (//hash.representation sha1) - #//dependency.md5 (//hash.representation md5)}))) + #//dependency.sha1 (|> sha1 + (:coerce (//hash.Hash //hash.SHA-1)) + (:: //hash.sha1-codec encode)) + #//dependency.md5 (|> md5 + (:coerce (//hash.Hash //hash.MD5)) + (:: //hash.md5-codec encode))}))) (def: #export (all-cached system dependencies resolution) (-> (file.System Promise) (List Dependency) Resolution (Promise (Try Resolution))) |