-- |
-- Module      : Crypto.Longshot.Hasher
-- License     : MIT
-- Maintainer  : Francis Lim <thyeem@gmail.com>
-- Stability   : experimental
-- Portability : unknown
--
module Crypto.Longshot.Hasher
  ( Hasher
  , getHasher
  )
where

import           GHC.TypeLits                   ( Nat )
import           Data.ByteString                ( ByteString )
import qualified Data.ByteArray                as B
import qualified Crypto.Hash                   as X
import qualified Crypto.Hash.SHA256            as S
import qualified Crypto.Hash.BLAKE2.BLAKE2s    as Blake2s
import qualified Crypto.Hash.BLAKE2.BLAKE2b    as Blake2b
import qualified BLAKE3                        as Blake3

-- | Type for hash functions available
type Hasher = ByteString -> ByteString

type Blake3_256 = ByteString -> Blake3.Digest (32 :: Nat)
type Blake3_384 = ByteString -> Blake3.Digest (48 :: Nat)
type Blake3_512 = ByteString -> Blake3.Digest (64 :: Nat)

-- | Select hasher by defined name
getHasher :: String -> Hasher
getHasher :: String -> Hasher
getHasher String
name = case String
name of
  String
"md5"         -> Digest MD5 -> ByteString
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
B.convert (Digest MD5 -> ByteString) -> (ByteString -> Digest MD5) -> Hasher
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MD5 -> ByteString -> Digest MD5
forall ba alg.
(ByteArrayAccess ba, HashAlgorithm alg) =>
alg -> ba -> Digest alg
X.hashWith MD5
X.MD5
  String
"sha1"        -> Digest SHA1 -> ByteString
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
B.convert (Digest SHA1 -> ByteString)
-> (ByteString -> Digest SHA1) -> Hasher
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SHA1 -> ByteString -> Digest SHA1
forall ba alg.
(ByteArrayAccess ba, HashAlgorithm alg) =>
alg -> ba -> Digest alg
X.hashWith SHA1
X.SHA1
  String
"ripemd160"   -> Digest RIPEMD160 -> ByteString
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
B.convert (Digest RIPEMD160 -> ByteString)
-> (ByteString -> Digest RIPEMD160) -> Hasher
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RIPEMD160 -> ByteString -> Digest RIPEMD160
forall ba alg.
(ByteArrayAccess ba, HashAlgorithm alg) =>
alg -> ba -> Digest alg
X.hashWith RIPEMD160
X.RIPEMD160
  String
"whirlpool"   -> Digest Whirlpool -> ByteString
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
B.convert (Digest Whirlpool -> ByteString)
-> (ByteString -> Digest Whirlpool) -> Hasher
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Whirlpool -> ByteString -> Digest Whirlpool
forall ba alg.
(ByteArrayAccess ba, HashAlgorithm alg) =>
alg -> ba -> Digest alg
X.hashWith Whirlpool
X.Whirlpool
  String
"sha256"      -> Hasher
S.hash
  String
"sha3_256"    -> Digest SHA3_256 -> ByteString
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
B.convert (Digest SHA3_256 -> ByteString)
-> (ByteString -> Digest SHA3_256) -> Hasher
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SHA3_256 -> ByteString -> Digest SHA3_256
forall ba alg.
(ByteArrayAccess ba, HashAlgorithm alg) =>
alg -> ba -> Digest alg
X.hashWith SHA3_256
X.SHA3_256
  String
"sha3_384"    -> Digest SHA3_384 -> ByteString
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
B.convert (Digest SHA3_384 -> ByteString)
-> (ByteString -> Digest SHA3_384) -> Hasher
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SHA3_384 -> ByteString -> Digest SHA3_384
forall ba alg.
(ByteArrayAccess ba, HashAlgorithm alg) =>
alg -> ba -> Digest alg
X.hashWith SHA3_384
X.SHA3_384
  String
"sha3_512"    -> Digest SHA3_512 -> ByteString
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
B.convert (Digest SHA3_512 -> ByteString)
-> (ByteString -> Digest SHA3_512) -> Hasher
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SHA3_512 -> ByteString -> Digest SHA3_512
forall ba alg.
(ByteArrayAccess ba, HashAlgorithm alg) =>
alg -> ba -> Digest alg
X.hashWith SHA3_512
X.SHA3_512
  String
"blake2s_256" -> Int -> ByteString -> Hasher
Blake2s.hash Int
32 ByteString
forall a. Monoid a => a
mempty
  String
"blake2b_256" -> Int -> ByteString -> Hasher
Blake2b.hash Int
32 ByteString
forall a. Monoid a => a
mempty
  String
"blake2b_384" -> Int -> ByteString -> Hasher
Blake2b.hash Int
48 ByteString
forall a. Monoid a => a
mempty
  String
"blake2b_512" -> Int -> ByteString -> Hasher
Blake2b.hash Int
64 ByteString
forall a. Monoid a => a
mempty
  String
"blake3_256"  -> Digest 32 -> ByteString
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
B.convert (Digest 32 -> ByteString) -> (ByteString -> Digest 32) -> Hasher
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([ByteString] -> Digest 32
forall (len :: Nat) bin.
(KnownNat len, ByteArrayAccess bin) =>
[bin] -> Digest len
Blake3.hash ([ByteString] -> Digest 32)
-> (ByteString -> [ByteString]) -> ByteString -> Digest 32
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ByteString -> [ByteString] -> [ByteString]
forall a. a -> [a] -> [a]
: []) :: Blake3_256)
  String
"blake3_384"  -> Digest 48 -> ByteString
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
B.convert (Digest 48 -> ByteString) -> (ByteString -> Digest 48) -> Hasher
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([ByteString] -> Digest 48
forall (len :: Nat) bin.
(KnownNat len, ByteArrayAccess bin) =>
[bin] -> Digest len
Blake3.hash ([ByteString] -> Digest 48)
-> (ByteString -> [ByteString]) -> ByteString -> Digest 48
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ByteString -> [ByteString] -> [ByteString]
forall a. a -> [a] -> [a]
: []) :: Blake3_384)
  String
"blake3_512"  -> Digest 64 -> ByteString
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
B.convert (Digest 64 -> ByteString) -> (ByteString -> Digest 64) -> Hasher
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([ByteString] -> Digest 64
forall (len :: Nat) bin.
(KnownNat len, ByteArrayAccess bin) =>
[bin] -> Digest len
Blake3.hash ([ByteString] -> Digest 64)
-> (ByteString -> [ByteString]) -> ByteString -> Digest 64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ByteString -> [ByteString] -> [ByteString]
forall a. a -> [a] -> [a]
: []) :: Blake3_512)
  String
"keccak_256"  -> Digest Keccak_256 -> ByteString
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
B.convert (Digest Keccak_256 -> ByteString)
-> (ByteString -> Digest Keccak_256) -> Hasher
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Keccak_256 -> ByteString -> Digest Keccak_256
forall ba alg.
(ByteArrayAccess ba, HashAlgorithm alg) =>
alg -> ba -> Digest alg
X.hashWith Keccak_256
X.Keccak_256
  String
"keccak_384"  -> Digest Keccak_384 -> ByteString
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
B.convert (Digest Keccak_384 -> ByteString)
-> (ByteString -> Digest Keccak_384) -> Hasher
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Keccak_384 -> ByteString -> Digest Keccak_384
forall ba alg.
(ByteArrayAccess ba, HashAlgorithm alg) =>
alg -> ba -> Digest alg
X.hashWith Keccak_384
X.Keccak_384
  String
"keccak_512"  -> Digest Keccak_512 -> ByteString
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
B.convert (Digest Keccak_512 -> ByteString)
-> (ByteString -> Digest Keccak_512) -> Hasher
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Keccak_512 -> ByteString -> Digest Keccak_512
forall ba alg.
(ByteArrayAccess ba, HashAlgorithm alg) =>
alg -> ba -> Digest alg
X.hashWith Keccak_512
X.Keccak_512
  String
"skein_256"   -> Digest Skein256_256 -> ByteString
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
B.convert (Digest Skein256_256 -> ByteString)
-> (ByteString -> Digest Skein256_256) -> Hasher
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Skein256_256 -> ByteString -> Digest Skein256_256
forall ba alg.
(ByteArrayAccess ba, HashAlgorithm alg) =>
alg -> ba -> Digest alg
X.hashWith Skein256_256
X.Skein256_256
  String
"skein_384"   -> Digest Skein512_384 -> ByteString
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
B.convert (Digest Skein512_384 -> ByteString)
-> (ByteString -> Digest Skein512_384) -> Hasher
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Skein512_384 -> ByteString -> Digest Skein512_384
forall ba alg.
(ByteArrayAccess ba, HashAlgorithm alg) =>
alg -> ba -> Digest alg
X.hashWith Skein512_384
X.Skein512_384
  String
"skein_512"   -> Digest Skein512_512 -> ByteString
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
B.convert (Digest Skein512_512 -> ByteString)
-> (ByteString -> Digest Skein512_512) -> Hasher
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Skein512_512 -> ByteString -> Digest Skein512_512
forall ba alg.
(ByteArrayAccess ba, HashAlgorithm alg) =>
alg -> ba -> Digest alg
X.hashWith Skein512_512
X.Skein512_512
  String
a             -> String -> Hasher
forall a. String -> a
errorWithoutStackTrace (String -> Hasher) -> String -> Hasher
forall a b. (a -> b) -> a -> b
$ String
"Not allowed hash algorithm  " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
a