module Z.Crypto.Hash(
HashType(..)
, Hash, hashName, hashSize
, newHash
, updateHash
, finalHash
, copyHash
, clearHash
, hash, hashChunks
, sinkToHash
, hashTypeToCBytes
, withHash
) where
import GHC.Generics (Generic)
import System.IO.Unsafe (unsafePerformIO)
import Z.Botan.Exception (HasCallStack, throwBotanIfMinus_)
import Z.Botan.FFI
import Z.Data.CBytes as CB
import Z.Data.JSON (JSON)
import qualified Z.Data.Text as T
import qualified Z.Data.Vector as V
import Z.Foreign
import Z.IO.BIO (pattern EOF, Sink)
data HashType
= BLAKE2b Int
| BLAKE2b256
| BLAKE2b512
| Keccak1600_224
| Keccak1600_256
| Keccak1600_384
| Keccak1600_512
| MD4
| MD5
| RIPEMD160
| SHA160
| SHA256
| SHA224
| SHA512
| SHA384
| SHA512_256
| SHA3_224
| SHA3_256
| SHA3_384
| SHA3_512
| SHAKE128 Int
| SHAKE256 Int
| SM3
| Skein512 Int CBytes
| Streebog256
| Streebog512
| Whirlpool
| Parallel HashType HashType
| Comb4P HashType HashType
| Adler32
| CRC24
| CRC32
deriving (Int -> HashType -> ShowS
[HashType] -> ShowS
HashType -> String
(Int -> HashType -> ShowS)
-> (HashType -> String) -> ([HashType] -> ShowS) -> Show HashType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [HashType] -> ShowS
$cshowList :: [HashType] -> ShowS
show :: HashType -> String
$cshow :: HashType -> String
showsPrec :: Int -> HashType -> ShowS
$cshowsPrec :: Int -> HashType -> ShowS
Show, ReadPrec [HashType]
ReadPrec HashType
Int -> ReadS HashType
ReadS [HashType]
(Int -> ReadS HashType)
-> ReadS [HashType]
-> ReadPrec HashType
-> ReadPrec [HashType]
-> Read HashType
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [HashType]
$creadListPrec :: ReadPrec [HashType]
readPrec :: ReadPrec HashType
$creadPrec :: ReadPrec HashType
readList :: ReadS [HashType]
$creadList :: ReadS [HashType]
readsPrec :: Int -> ReadS HashType
$creadsPrec :: Int -> ReadS HashType
Read, HashType -> HashType -> Bool
(HashType -> HashType -> Bool)
-> (HashType -> HashType -> Bool) -> Eq HashType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: HashType -> HashType -> Bool
$c/= :: HashType -> HashType -> Bool
== :: HashType -> HashType -> Bool
$c== :: HashType -> HashType -> Bool
Eq, Eq HashType
Eq HashType
-> (HashType -> HashType -> Ordering)
-> (HashType -> HashType -> Bool)
-> (HashType -> HashType -> Bool)
-> (HashType -> HashType -> Bool)
-> (HashType -> HashType -> Bool)
-> (HashType -> HashType -> HashType)
-> (HashType -> HashType -> HashType)
-> Ord HashType
HashType -> HashType -> Bool
HashType -> HashType -> Ordering
HashType -> HashType -> HashType
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: HashType -> HashType -> HashType
$cmin :: HashType -> HashType -> HashType
max :: HashType -> HashType -> HashType
$cmax :: HashType -> HashType -> HashType
>= :: HashType -> HashType -> Bool
$c>= :: HashType -> HashType -> Bool
> :: HashType -> HashType -> Bool
$c> :: HashType -> HashType -> Bool
<= :: HashType -> HashType -> Bool
$c<= :: HashType -> HashType -> Bool
< :: HashType -> HashType -> Bool
$c< :: HashType -> HashType -> Bool
compare :: HashType -> HashType -> Ordering
$ccompare :: HashType -> HashType -> Ordering
$cp1Ord :: Eq HashType
Ord, (forall x. HashType -> Rep HashType x)
-> (forall x. Rep HashType x -> HashType) -> Generic HashType
forall x. Rep HashType x -> HashType
forall x. HashType -> Rep HashType x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep HashType x -> HashType
$cfrom :: forall x. HashType -> Rep HashType x
Generic)
deriving anyclass (Int -> HashType -> Builder ()
(Int -> HashType -> Builder ()) -> Print HashType
forall a. (Int -> a -> Builder ()) -> Print a
toUTF8BuilderP :: Int -> HashType -> Builder ()
$ctoUTF8BuilderP :: Int -> HashType -> Builder ()
T.Print, Value -> Converter HashType
HashType -> Value
HashType -> Builder ()
(Value -> Converter HashType)
-> (HashType -> Value) -> (HashType -> Builder ()) -> JSON HashType
forall a.
(Value -> Converter a)
-> (a -> Value) -> (a -> Builder ()) -> JSON a
encodeJSON :: HashType -> Builder ()
$cencodeJSON :: HashType -> Builder ()
toValue :: HashType -> Value
$ctoValue :: HashType -> Value
fromValue :: Value -> Converter HashType
$cfromValue :: Value -> Converter HashType
JSON)
hashTypeToCBytes :: HashType -> CBytes
hashTypeToCBytes :: HashType -> CBytes
hashTypeToCBytes HashType
h = case HashType
h of
BLAKE2b Int
siz -> [CBytes] -> CBytes
CB.concat [ CBytes
"Blake2b(" , Int -> CBytes
sizeCBytes Int
siz, CBytes
")"]
HashType
BLAKE2b256 -> CBytes
"Blake2b(256)"
HashType
BLAKE2b512 -> CBytes
"Blake2b(512)"
HashType
Keccak1600_224 -> CBytes
"Keccak-1600(224)"
HashType
Keccak1600_256 -> CBytes
"Keccak-1600(256)"
HashType
Keccak1600_384 -> CBytes
"Keccak-1600(384)"
HashType
Keccak1600_512 -> CBytes
"Keccak-1600(512)"
HashType
MD4 -> CBytes
"MD4"
HashType
MD5 -> CBytes
"MD5"
HashType
RIPEMD160 -> CBytes
"RIPEMD-160"
HashType
SHA160 -> CBytes
"SHA-160"
HashType
SHA224 -> CBytes
"SHA-224"
HashType
SHA256 -> CBytes
"SHA-256"
HashType
SHA512 -> CBytes
"SHA-512"
HashType
SHA384 -> CBytes
"SHA-384"
HashType
SHA512_256 -> CBytes
"SHA-512-256"
HashType
SHA3_224 -> CBytes
"SHA-3(224)"
HashType
SHA3_256 -> CBytes
"SHA-3(256)"
HashType
SHA3_384 -> CBytes
"SHA-3(384)"
HashType
SHA3_512 -> CBytes
"SHA-3(512)"
SHAKE128 Int
siz -> [CBytes] -> CBytes
CB.concat [ CBytes
"SHAKE-128(" , Int -> CBytes
sizeCBytes Int
siz , CBytes
")"]
SHAKE256 Int
siz -> [CBytes] -> CBytes
CB.concat [ CBytes
"SHAKE-256(" , Int -> CBytes
sizeCBytes Int
siz , CBytes
")"]
HashType
SM3 -> CBytes
"SM3"
Skein512 Int
siz CBytes
b -> [CBytes] -> CBytes
CB.concat [ CBytes
"Skein-512(" , Int -> CBytes
sizeCBytes Int
siz, CBytes
"," , CBytes
b , CBytes
")"]
HashType
Streebog256 -> CBytes
"Streebog-256"
HashType
Streebog512 -> CBytes
"Streebog-512"
HashType
Whirlpool -> CBytes
"Whirlpool"
Parallel HashType
h1 HashType
h2 -> [CBytes] -> CBytes
CB.concat [ CBytes
"Parallel("
, HashType -> CBytes
hashTypeToCBytes HashType
h1
, CBytes
","
, HashType -> CBytes
hashTypeToCBytes HashType
h2
, CBytes
")"]
Comb4P HashType
h1 HashType
h2 -> [CBytes] -> CBytes
CB.concat [ CBytes
"Comb4P("
, HashType -> CBytes
hashTypeToCBytes HashType
h1
, CBytes
","
, HashType -> CBytes
hashTypeToCBytes HashType
h2
, CBytes
")"]
HashType
Adler32 -> CBytes
"Adler32"
HashType
CRC24 -> CBytes
"CRC24"
HashType
CRC32 -> CBytes
"CRC32"
where
sizeCBytes :: Int -> CBytes
sizeCBytes = Text -> CBytes
CB.fromText (Text -> CBytes) -> (Int -> Text) -> Int -> CBytes
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Text
forall a. Print a => a -> Text
T.toText
data Hash = Hash
{ Hash -> BotanStruct
hashStruct :: {-# UNPACK #-} !BotanStruct
, Hash -> CBytes
hashName :: {-# UNPACK #-} !CBytes
, Hash -> Int
hashSize :: {-# UNPACK #-} !Int
}
deriving (Int -> Hash -> ShowS
[Hash] -> ShowS
Hash -> String
(Int -> Hash -> ShowS)
-> (Hash -> String) -> ([Hash] -> ShowS) -> Show Hash
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Hash] -> ShowS
$cshowList :: [Hash] -> ShowS
show :: Hash -> String
$cshow :: Hash -> String
showsPrec :: Int -> Hash -> ShowS
$cshowsPrec :: Int -> Hash -> ShowS
Show, (forall x. Hash -> Rep Hash x)
-> (forall x. Rep Hash x -> Hash) -> Generic Hash
forall x. Rep Hash x -> Hash
forall x. Hash -> Rep Hash x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Hash x -> Hash
$cfrom :: forall x. Hash -> Rep Hash x
Generic)
deriving anyclass Int -> Hash -> Builder ()
(Int -> Hash -> Builder ()) -> Print Hash
forall a. (Int -> a -> Builder ()) -> Print a
toUTF8BuilderP :: Int -> Hash -> Builder ()
$ctoUTF8BuilderP :: Int -> Hash -> Builder ()
T.Print
withHash :: HasCallStack => Hash -> (BotanStructT -> IO r) -> IO r
withHash :: Hash -> (BotanStructT -> IO r) -> IO r
withHash (Hash BotanStruct
h CBytes
_ Int
_) = BotanStruct -> (BotanStructT -> IO r) -> IO r
forall a. BotanStruct -> (BotanStructT -> IO a) -> IO a
withBotanStruct BotanStruct
h
newHash :: HasCallStack => HashType -> IO Hash
newHash :: HashType -> IO Hash
newHash HashType
typ = do
let name :: CBytes
name = HashType -> CBytes
hashTypeToCBytes HashType
typ
BotanStruct
bs <- (MBA# BotanStructT -> IO CInt)
-> FunPtr (BotanStructT -> IO ()) -> IO BotanStruct
forall a.
HasCallStack =>
(MBA# BotanStructT -> IO CInt)
-> FunPtr (BotanStructT -> IO a) -> IO BotanStruct
newBotanStruct
(\ MBA# BotanStructT
bts -> CBytes -> (BA# Word8 -> IO CInt) -> IO CInt
forall a. CBytes -> (BA# Word8 -> IO a) -> IO a
withCBytesUnsafe CBytes
name ((BA# Word8 -> IO CInt) -> IO CInt)
-> (BA# Word8 -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ \ BA# Word8
pt ->
(MBA# BotanStructT -> BA# Word8 -> Word32 -> IO CInt
botan_hash_init MBA# BotanStructT
bts BA# Word8
pt Word32
0))
FunPtr (BotanStructT -> IO ())
botan_hash_destroy
(CSize
osiz, CInt
_) <- BotanStruct
-> (BotanStructT -> IO (CSize, CInt)) -> IO (CSize, CInt)
forall a. BotanStruct -> (BotanStructT -> IO a) -> IO a
withBotanStruct BotanStruct
bs ((BotanStructT -> IO (CSize, CInt)) -> IO (CSize, CInt))
-> (BotanStructT -> IO (CSize, CInt)) -> IO (CSize, CInt)
forall a b. (a -> b) -> a -> b
$ \ BotanStructT
pbs ->
forall b.
Prim CSize =>
(MBA# BotanStructT -> IO b) -> IO (CSize, b)
forall a b. Prim a => (MBA# BotanStructT -> IO b) -> IO (a, b)
allocPrimUnsafe @CSize ((MBA# BotanStructT -> IO CInt) -> IO (CSize, CInt))
-> (MBA# BotanStructT -> IO CInt) -> IO (CSize, CInt)
forall a b. (a -> b) -> a -> b
$ \ MBA# BotanStructT
pl ->
BotanStructT -> MBA# BotanStructT -> IO CInt
botan_hash_output_length BotanStructT
pbs MBA# BotanStructT
pl
Hash -> IO Hash
forall (m :: * -> *) a. Monad m => a -> m a
return (BotanStruct -> CBytes -> Int -> Hash
Hash BotanStruct
bs CBytes
name (CSize -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CSize
osiz))
copyHash :: HasCallStack => Hash -> IO Hash
copyHash :: Hash -> IO Hash
copyHash (Hash BotanStruct
bts0 CBytes
name Int
siz) = do
BotanStruct
s <- (MBA# BotanStructT -> IO CInt)
-> FunPtr (BotanStructT -> IO ()) -> IO BotanStruct
forall a.
HasCallStack =>
(MBA# BotanStructT -> IO CInt)
-> FunPtr (BotanStructT -> IO a) -> IO BotanStruct
newBotanStruct
(\ MBA# BotanStructT
bts -> BotanStruct -> (BotanStructT -> IO CInt) -> IO CInt
forall a. BotanStruct -> (BotanStructT -> IO a) -> IO a
withBotanStruct BotanStruct
bts0 ((BotanStructT -> IO CInt) -> IO CInt)
-> (BotanStructT -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ \ BotanStructT
pbts0 ->
MBA# BotanStructT -> BotanStructT -> IO CInt
botan_hash_copy_state MBA# BotanStructT
bts BotanStructT
pbts0)
FunPtr (BotanStructT -> IO ())
botan_hash_destroy
Hash -> IO Hash
forall (m :: * -> *) a. Monad m => a -> m a
return (BotanStruct -> CBytes -> Int -> Hash
Hash BotanStruct
s CBytes
name Int
siz)
clearHash :: HasCallStack => Hash -> IO ()
clearHash :: Hash -> IO ()
clearHash (Hash BotanStruct
bts CBytes
_ Int
_) =
IO CInt -> IO ()
forall a. (HasCallStack, Integral a) => IO a -> IO ()
throwBotanIfMinus_ (BotanStruct -> (BotanStructT -> IO CInt) -> IO CInt
forall a. BotanStruct -> (BotanStructT -> IO a) -> IO a
withBotanStruct BotanStruct
bts BotanStructT -> IO CInt
botan_hash_clear)
updateHash :: Hash -> V.Bytes -> IO ()
updateHash :: Hash -> Bytes -> IO ()
updateHash (Hash BotanStruct
bts CBytes
_ Int
_) Bytes
bs =
BotanStruct -> (BotanStructT -> IO ()) -> IO ()
forall a. BotanStruct -> (BotanStructT -> IO a) -> IO a
withBotanStruct BotanStruct
bts ((BotanStructT -> IO ()) -> IO ())
-> (BotanStructT -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \ BotanStructT
pbts ->
Bytes -> (BA# Word8 -> Int -> Int -> IO ()) -> IO ()
forall a b.
Prim a =>
PrimVector a -> (BA# Word8 -> Int -> Int -> IO b) -> IO b
withPrimVectorUnsafe Bytes
bs ((BA# Word8 -> Int -> Int -> IO ()) -> IO ())
-> (BA# Word8 -> Int -> Int -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \ BA# Word8
pbs Int
off Int
len ->
IO CInt -> IO ()
forall a. (HasCallStack, Integral a) => IO a -> IO ()
throwBotanIfMinus_ (BotanStructT -> BA# Word8 -> Int -> Int -> IO CInt
hs_botan_hash_update BotanStructT
pbts BA# Word8
pbs Int
off Int
len)
finalHash :: HasCallStack => Hash -> IO V.Bytes
{-# INLINABLE finalHash #-}
finalHash :: Hash -> IO Bytes
finalHash (Hash BotanStruct
bts CBytes
_ Int
siz) =
BotanStruct -> (BotanStructT -> IO Bytes) -> IO Bytes
forall a. BotanStruct -> (BotanStructT -> IO a) -> IO a
withBotanStruct BotanStruct
bts ((BotanStructT -> IO Bytes) -> IO Bytes)
-> (BotanStructT -> IO Bytes) -> IO Bytes
forall a b. (a -> b) -> a -> b
$ \ BotanStructT
pbts -> do
(Bytes, ()) -> Bytes
forall a b. (a, b) -> a
fst ((Bytes, ()) -> Bytes) -> IO (Bytes, ()) -> IO Bytes
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> (MBA# BotanStructT -> IO ()) -> IO (Bytes, ())
forall a b.
Prim a =>
Int -> (MBA# BotanStructT -> IO b) -> IO (PrimVector a, b)
allocPrimVectorUnsafe Int
siz (\ MBA# BotanStructT
pout ->
IO CInt -> IO ()
forall a. (HasCallStack, Integral a) => IO a -> IO ()
throwBotanIfMinus_ (BotanStructT -> MBA# BotanStructT -> IO CInt
botan_hash_final BotanStructT
pbts MBA# BotanStructT
pout))
sinkToHash :: HasCallStack => Hash -> Sink V.Bytes
{-# INLINABLE sinkToHash #-}
sinkToHash :: Hash -> Sink Bytes
sinkToHash Hash
h = \ Maybe Void -> IO ()
k Maybe Bytes
mbs -> case Maybe Bytes
mbs of
Just Bytes
bs -> Hash -> Bytes -> IO ()
updateHash Hash
h Bytes
bs
Maybe Bytes
_ -> Maybe Void -> IO ()
k Maybe Void
forall a. Maybe a
EOF
hash :: HasCallStack => HashType -> V.Bytes -> V.Bytes
{-# INLINABLE hash #-}
hash :: HashType -> Bytes -> Bytes
hash HashType
ht Bytes
inp = IO Bytes -> Bytes
forall a. IO a -> a
unsafePerformIO (IO Bytes -> Bytes) -> IO Bytes -> Bytes
forall a b. (a -> b) -> a -> b
$ do
Hash
h <- HasCallStack => HashType -> IO Hash
HashType -> IO Hash
newHash HashType
ht
Hash -> Bytes -> IO ()
updateHash Hash
h Bytes
inp
HasCallStack => Hash -> IO Bytes
Hash -> IO Bytes
finalHash Hash
h
hashChunks:: HasCallStack => HashType -> [V.Bytes] -> V.Bytes
{-# INLINABLE hashChunks #-}
hashChunks :: HashType -> [Bytes] -> Bytes
hashChunks HashType
ht [Bytes]
inp = IO Bytes -> Bytes
forall a. IO a -> a
unsafePerformIO (IO Bytes -> Bytes) -> IO Bytes -> Bytes
forall a b. (a -> b) -> a -> b
$ do
Hash
h <- HasCallStack => HashType -> IO Hash
HashType -> IO Hash
newHash HashType
ht
(Bytes -> IO ()) -> [Bytes] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (Hash -> Bytes -> IO ()
updateHash Hash
h) [Bytes]
inp
HasCallStack => Hash -> IO Bytes
Hash -> IO Bytes
finalHash Hash
h