(.module:
  [lux #*
   ["." host (#+ import:)]
   [abstract
    [codec (#+ Codec)]
    [equivalence (#+ Equivalence)]
    [monad (#+ do)]]
   [control
    ["." try (#+ Try)]
    ["." exception (#+ exception:)]]
   [data
    ["." binary (#+ Binary)]
    ["." text
     ["%" format (#+ Format format)]
     ["." encoding]]
    [number
     ["." i64]
     ["n" nat]]]
   [type
    abstract]])

## TODO: Replace with pure-Lux implementations of these algorithms
## https://en.wikipedia.org/wiki/SHA-1#SHA-1_pseudocode
## https://en.wikipedia.org/wiki/MD5#Algorithm
(import: java/lang/String)

(import: java/security/MessageDigest
  ["#::."
   (#static getInstance [java/lang/String] java/security/MessageDigest)
   (digest [[byte]] [byte])])

(abstract: #export SHA-1 Any)
(abstract: #export MD5 Any)

(abstract: #export (Hash h)
  Binary

  (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))]

    [sha-1 ..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 sha-1::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_sha-1 ..sha-1::size]
    [not_a_md5 ..md5::size]
    )

  (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_sha-1 SHA-1 ..sha-1::size ..not_a_sha-1]
    [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>)))]

    [sha-1_codec SHA-1 ..sha-1::size ..as_sha-1]
    [md5_codec MD5 ..md5::size ..as_md5]
    )

  (structure: #export equivalence
    (All [h] (Equivalence (Hash h)))

    (def: (= reference subject)
      (\ binary.equivalence =
         (:representation reference)
         (:representation subject))))
  )