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/command/deploy.lux4
-rw-r--r--stdlib/source/program/aedifex/dependency.lux54
-rw-r--r--stdlib/source/program/aedifex/hash.lux164
-rw-r--r--stdlib/source/program/aedifex/local.lux8
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)))