(.require
 [library
  [lux (.except)
   ["[0]" ffi (.only import)]
   [abstract
    [codec (.only Codec)]
    [equivalence (.only Equivalence)]
    [monad (.only do)]]
   [control
    ["[0]" try (.only Try)]
    ["[0]" exception (.only Exception)]]
   [data
    ["[0]" binary (.only Binary)]
    ["[0]" text (.only)
     ["%" \\format (.only Format format)]
     ["[0]" encoding]]]
   [math
    [number
     ["n" nat]
     ["[0]" i64]]]
   [meta
    [macro
     ["^" pattern]]
    [type
     ["[0]" nominal (.except def)]]]]])

... 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
  "[1]::[0]")

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

(nominal.def .public SHA1 Any)
(nominal.def .public MD5 Any)

(nominal.def .public (Hash h)
  Binary

  (def .public data
    (All (_ h) (-> (Hash h) Binary))
    (|>> representation))

  (with_template [<name> <kind> <algorithm>]
    [(def .public (<name> value)
       (-> Binary (Hash <kind>))
       (|> (java/security/MessageDigest::getInstance [(ffi.as_string <algorithm>)])
           (java/security/MessageDigest::digest [value])
           abstraction))]

    [sha1 ..SHA1 "SHA1"]
    [md5 ..MD5 "MD5"]
    )

  (def encoded
    (Format Binary)
    (binary.mix (function (_ byte representation)
                  (let [hex (at n.hex encoded byte)
                        hex (when (text.size hex)
                              1 (format "0" hex)
                              _ hex)]
                    (format representation hex)))
                ""))

  (with_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.def .public (not_a_hash [size value])
    (Exception [Nat Text])
    (exception.report
     (list ["Pseudo hash" (%.text value)]
           ["Expected size" (%.nat size)]
           ["Actual size" (%.nat (text.size value))])))
  
  (with_template [<name> <size>]
    [(exception.def .public (<name> data)
       (Exception Binary)
       (exception.report
        (list ["Pseudo hash" (%.text (..encoded data))]
              ["Expected size" (%.nat <size>)]
              ["Actual size" (%.nat (binary.size data))])))]

    [not_a_sha1 ..sha1::size]
    [not_a_md5 ..md5::size]
    )

  (with_template [<name> <kind> <size> <exception>]
    [(def .public (<name> data)
       (-> Binary (Try (Hash <kind>)))
       (if (n.= <size> (binary.size data))
         {try.#Success (abstraction data)}
         (exception.except <exception> [data])))]

    [as_sha1 SHA1 ..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 (decoded 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 (again [input encoded
                      chunk 0
                      output (binary.empty hash_size)])
          (let [index (n.* chunk i64.bytes_per_i64)]
            (when (text.split_at ..hex_per_chunk input)
              {.#Some [head tail]}
              (do try.monad
                [head (at n.hex decoded head)
                 output (binary.has_64! index head output)]
                (again tail (++ chunk) output))
              
              {.#None}
              (when (..hash_size input)
                0 (constructor output)
                (^.with_template [<size> <write>]
                  [<size>
                   (do try.monad
                     [head (at n.hex decoded input)
                      output (<write> index head output)]
                     (constructor output))])
                ([1 binary.has_8!]
                 [2 binary.has_16!]
                 [4 binary.has_32!])
                _ (exception.except ..not_a_hash [(..encoding_size size) encoded])))))
        (exception.except ..not_a_hash [(..encoding_size size) encoded]))))

  (with_template [<codec> <hash> <nat> <constructor>]
    [(def .public <codec>
       (Codec Text (Hash <hash>))
       (implementation
        (def encoded (|>> representation ..encoded))
        (def decoded (..decoded <nat> <constructor>))))]

    [sha1_codec SHA1 ..sha1::size ..as_sha1]
    [md5_codec MD5 ..md5::size ..as_md5]
    )

  (def .public equivalence
    (All (_ h) (Equivalence (Hash h)))
    (implementation
     (def (= reference subject)
       (at binary.equivalence =
           (representation reference)
           (representation subject)))))
  )