{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeFamilies #-}
module Crypto.Hash.Types
( HashAlgorithm(..)
, HashAlgorithmPrefix(..)
, Context(..)
, Digest(..)
) where
import Crypto.Internal.Imports
import Crypto.Internal.ByteArray (ByteArrayAccess, Bytes)
import qualified Crypto.Internal.ByteArray as B
import Control.Monad.ST
import Data.Char (digitToInt, isHexDigit)
import Foreign.Ptr (Ptr)
import Basement.Block (Block, unsafeFreeze)
import Basement.Block.Mutable (MutableBlock, new, unsafeWrite)
import Basement.NormalForm (deepseq)
import Basement.Types.OffsetSize (CountOf(..), Offset(..))
import GHC.TypeLits (Nat)
import Data.Data (Data)
class HashAlgorithm a where
type HashBlockSize a :: Nat
type HashDigestSize a :: Nat
type HashInternalContextSize a :: Nat
hashBlockSize :: a -> Int
hashDigestSize :: a -> Int
hashInternalContextSize :: a -> Int
hashInternalInit :: Ptr (Context a) -> IO ()
hashInternalUpdate :: Ptr (Context a) -> Ptr Word8 -> Word32 -> IO ()
hashInternalFinalize :: Ptr (Context a) -> Ptr (Digest a) -> IO ()
class HashAlgorithm a => HashAlgorithmPrefix a where
hashInternalFinalizePrefix :: Ptr (Context a)
-> Ptr Word8 -> Word32
-> Word32
-> Ptr (Digest a)
-> IO ()
newtype Context a = Context Bytes
deriving (Context a -> Int
Context a -> Ptr p -> IO ()
Context a -> (Ptr p -> IO a) -> IO a
(Context a -> Int)
-> (forall p a. Context a -> (Ptr p -> IO a) -> IO a)
-> (forall p. Context a -> Ptr p -> IO ())
-> ByteArrayAccess (Context a)
forall a. Context a -> Int
forall p. Context a -> Ptr p -> IO ()
forall ba.
(ba -> Int)
-> (forall p a. ba -> (Ptr p -> IO a) -> IO a)
-> (forall p. ba -> Ptr p -> IO ())
-> ByteArrayAccess ba
forall a p. Context a -> Ptr p -> IO ()
forall p a. Context a -> (Ptr p -> IO a) -> IO a
forall a p a. Context a -> (Ptr p -> IO a) -> IO a
copyByteArrayToPtr :: Context a -> Ptr p -> IO ()
$ccopyByteArrayToPtr :: forall a p. Context a -> Ptr p -> IO ()
withByteArray :: Context a -> (Ptr p -> IO a) -> IO a
$cwithByteArray :: forall a p a. Context a -> (Ptr p -> IO a) -> IO a
length :: Context a -> Int
$clength :: forall a. Context a -> Int
ByteArrayAccess,Context a -> ()
(Context a -> ()) -> NFData (Context a)
forall a. Context a -> ()
forall a. (a -> ()) -> NFData a
rnf :: Context a -> ()
$crnf :: forall a. Context a -> ()
NFData)
newtype Digest a = Digest (Block Word8)
deriving (Digest a -> Digest a -> Bool
(Digest a -> Digest a -> Bool)
-> (Digest a -> Digest a -> Bool) -> Eq (Digest a)
forall a. Digest a -> Digest a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Digest a -> Digest a -> Bool
$c/= :: forall a. Digest a -> Digest a -> Bool
== :: Digest a -> Digest a -> Bool
$c== :: forall a. Digest a -> Digest a -> Bool
Eq,Eq (Digest a)
Eq (Digest a)
-> (Digest a -> Digest a -> Ordering)
-> (Digest a -> Digest a -> Bool)
-> (Digest a -> Digest a -> Bool)
-> (Digest a -> Digest a -> Bool)
-> (Digest a -> Digest a -> Bool)
-> (Digest a -> Digest a -> Digest a)
-> (Digest a -> Digest a -> Digest a)
-> Ord (Digest a)
Digest a -> Digest a -> Bool
Digest a -> Digest a -> Ordering
Digest a -> Digest a -> Digest a
forall a. Eq (Digest a)
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
forall a. Digest a -> Digest a -> Bool
forall a. Digest a -> Digest a -> Ordering
forall a. Digest a -> Digest a -> Digest a
min :: Digest a -> Digest a -> Digest a
$cmin :: forall a. Digest a -> Digest a -> Digest a
max :: Digest a -> Digest a -> Digest a
$cmax :: forall a. Digest a -> Digest a -> Digest a
>= :: Digest a -> Digest a -> Bool
$c>= :: forall a. Digest a -> Digest a -> Bool
> :: Digest a -> Digest a -> Bool
$c> :: forall a. Digest a -> Digest a -> Bool
<= :: Digest a -> Digest a -> Bool
$c<= :: forall a. Digest a -> Digest a -> Bool
< :: Digest a -> Digest a -> Bool
$c< :: forall a. Digest a -> Digest a -> Bool
compare :: Digest a -> Digest a -> Ordering
$ccompare :: forall a. Digest a -> Digest a -> Ordering
$cp1Ord :: forall a. Eq (Digest a)
Ord,Digest a -> Int
Digest a -> Ptr p -> IO ()
Digest a -> (Ptr p -> IO a) -> IO a
(Digest a -> Int)
-> (forall p a. Digest a -> (Ptr p -> IO a) -> IO a)
-> (forall p. Digest a -> Ptr p -> IO ())
-> ByteArrayAccess (Digest a)
forall a. Digest a -> Int
forall p. Digest a -> Ptr p -> IO ()
forall ba.
(ba -> Int)
-> (forall p a. ba -> (Ptr p -> IO a) -> IO a)
-> (forall p. ba -> Ptr p -> IO ())
-> ByteArrayAccess ba
forall a p. Digest a -> Ptr p -> IO ()
forall p a. Digest a -> (Ptr p -> IO a) -> IO a
forall a p a. Digest a -> (Ptr p -> IO a) -> IO a
copyByteArrayToPtr :: Digest a -> Ptr p -> IO ()
$ccopyByteArrayToPtr :: forall a p. Digest a -> Ptr p -> IO ()
withByteArray :: Digest a -> (Ptr p -> IO a) -> IO a
$cwithByteArray :: forall a p a. Digest a -> (Ptr p -> IO a) -> IO a
length :: Digest a -> Int
$clength :: forall a. Digest a -> Int
ByteArrayAccess, Typeable (Digest a)
DataType
Constr
Typeable (Digest a)
-> (forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Digest a -> c (Digest a))
-> (forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Digest a))
-> (Digest a -> Constr)
-> (Digest a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c (Digest a)))
-> (forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (Digest a)))
-> ((forall b. Data b => b -> b) -> Digest a -> Digest a)
-> (forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Digest a -> r)
-> (forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Digest a -> r)
-> (forall u. (forall d. Data d => d -> u) -> Digest a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> Digest a -> u)
-> (forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Digest a -> m (Digest a))
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Digest a -> m (Digest a))
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Digest a -> m (Digest a))
-> Data (Digest a)
Digest a -> DataType
Digest a -> Constr
(forall d. Data d => c (t d)) -> Maybe (c (Digest a))
(forall b. Data b => b -> b) -> Digest a -> Digest a
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Digest a -> c (Digest a)
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Digest a)
forall a. Data a => Typeable (Digest a)
forall a. Data a => Digest a -> DataType
forall a. Data a => Digest a -> Constr
forall a.
Data a =>
(forall b. Data b => b -> b) -> Digest a -> Digest a
forall a u.
Data a =>
Int -> (forall d. Data d => d -> u) -> Digest a -> u
forall a u.
Data a =>
(forall d. Data d => d -> u) -> Digest a -> [u]
forall a r r'.
Data a =>
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Digest a -> r
forall a r r'.
Data a =>
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Digest a -> r
forall a (m :: * -> *).
(Data a, Monad m) =>
(forall d. Data d => d -> m d) -> Digest a -> m (Digest a)
forall a (m :: * -> *).
(Data a, MonadPlus m) =>
(forall d. Data d => d -> m d) -> Digest a -> m (Digest a)
forall a (c :: * -> *).
Data a =>
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Digest a)
forall a (c :: * -> *).
Data a =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Digest a -> c (Digest a)
forall a (t :: * -> *) (c :: * -> *).
(Data a, Typeable t) =>
(forall d. Data d => c (t d)) -> Maybe (c (Digest a))
forall a (t :: * -> * -> *) (c :: * -> *).
(Data a, Typeable t) =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c (Digest a))
forall a.
Typeable a
-> (forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> Digest a -> u
forall u. (forall d. Data d => d -> u) -> Digest a -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Digest a -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Digest a -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Digest a -> m (Digest a)
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Digest a -> m (Digest a)
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Digest a)
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Digest a -> c (Digest a)
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c (Digest a))
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c (Digest a))
$cDigest :: Constr
$tDigest :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> Digest a -> m (Digest a)
$cgmapMo :: forall a (m :: * -> *).
(Data a, MonadPlus m) =>
(forall d. Data d => d -> m d) -> Digest a -> m (Digest a)
gmapMp :: (forall d. Data d => d -> m d) -> Digest a -> m (Digest a)
$cgmapMp :: forall a (m :: * -> *).
(Data a, MonadPlus m) =>
(forall d. Data d => d -> m d) -> Digest a -> m (Digest a)
gmapM :: (forall d. Data d => d -> m d) -> Digest a -> m (Digest a)
$cgmapM :: forall a (m :: * -> *).
(Data a, Monad m) =>
(forall d. Data d => d -> m d) -> Digest a -> m (Digest a)
gmapQi :: Int -> (forall d. Data d => d -> u) -> Digest a -> u
$cgmapQi :: forall a u.
Data a =>
Int -> (forall d. Data d => d -> u) -> Digest a -> u
gmapQ :: (forall d. Data d => d -> u) -> Digest a -> [u]
$cgmapQ :: forall a u.
Data a =>
(forall d. Data d => d -> u) -> Digest a -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Digest a -> r
$cgmapQr :: forall a r r'.
Data a =>
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Digest a -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Digest a -> r
$cgmapQl :: forall a r r'.
Data a =>
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Digest a -> r
gmapT :: (forall b. Data b => b -> b) -> Digest a -> Digest a
$cgmapT :: forall a.
Data a =>
(forall b. Data b => b -> b) -> Digest a -> Digest a
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c (Digest a))
$cdataCast2 :: forall a (t :: * -> * -> *) (c :: * -> *).
(Data a, Typeable t) =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c (Digest a))
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c (Digest a))
$cdataCast1 :: forall a (t :: * -> *) (c :: * -> *).
(Data a, Typeable t) =>
(forall d. Data d => c (t d)) -> Maybe (c (Digest a))
dataTypeOf :: Digest a -> DataType
$cdataTypeOf :: forall a. Data a => Digest a -> DataType
toConstr :: Digest a -> Constr
$ctoConstr :: forall a. Data a => Digest a -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Digest a)
$cgunfold :: forall a (c :: * -> *).
Data a =>
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Digest a)
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Digest a -> c (Digest a)
$cgfoldl :: forall a (c :: * -> *).
Data a =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Digest a -> c (Digest a)
$cp1Data :: forall a. Data a => Typeable (Digest a)
Data)
instance NFData (Digest a) where
rnf :: Digest a -> ()
rnf (Digest Block Word8
u) = Block Word8
u Block Word8 -> () -> ()
forall a b. NormalForm a => a -> b -> b
`deepseq` ()
instance Show (Digest a) where
show :: Digest a -> String
show (Digest Block Word8
bs) = (Word8 -> Char) -> [Word8] -> String
forall a b. (a -> b) -> [a] -> [b]
map (Int -> Char
forall a. Enum a => Int -> a
toEnum (Int -> Char) -> (Word8 -> Int) -> Word8 -> Char
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral)
([Word8] -> String) -> [Word8] -> String
forall a b. (a -> b) -> a -> b
$ Bytes -> [Word8]
forall a. ByteArrayAccess a => a -> [Word8]
B.unpack (Base -> Block Word8 -> Bytes
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
Base -> bin -> bout
B.convertToBase Base
B.Base16 Block Word8
bs :: Bytes)
instance HashAlgorithm a => Read (Digest a) where
readsPrec :: Int -> ReadS (Digest a)
readsPrec Int
_ String
str = (forall s. ST s [(Digest a, String)]) -> [(Digest a, String)]
forall a. (forall s. ST s a) -> a
runST ((forall s. ST s [(Digest a, String)]) -> [(Digest a, String)])
-> (forall s. ST s [(Digest a, String)]) -> [(Digest a, String)]
forall a b. (a -> b) -> a -> b
$ do MutableBlock Word8 s
mut <- CountOf Word8 -> ST s (MutableBlock Word8 (PrimState (ST s)))
forall (prim :: * -> *) ty.
(PrimMonad prim, PrimType ty) =>
CountOf ty -> prim (MutableBlock ty (PrimState prim))
new (Int -> CountOf Word8
forall ty. Int -> CountOf ty
CountOf Int
len)
MutableBlock Word8 s -> Int -> String -> ST s [(Digest a, String)]
forall s.
MutableBlock Word8 s -> Int -> String -> ST s [(Digest a, String)]
loop MutableBlock Word8 s
mut Int
len String
str
where
len :: Int
len = a -> Int
forall a. HashAlgorithm a => a -> Int
hashDigestSize (a
forall a. HasCallStack => a
undefined :: a)
loop :: MutableBlock Word8 s -> Int -> String -> ST s [(Digest a, String)]
loop :: MutableBlock Word8 s -> Int -> String -> ST s [(Digest a, String)]
loop MutableBlock Word8 s
mut Int
0 String
cs = (\Block Word8
b -> [(Block Word8 -> Digest a
forall a. Block Word8 -> Digest a
Digest Block Word8
b, String
cs)]) (Block Word8 -> [(Digest a, String)])
-> ST s (Block Word8) -> ST s [(Digest a, String)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> MutableBlock Word8 (PrimState (ST s)) -> ST s (Block Word8)
forall (prim :: * -> *) ty.
PrimMonad prim =>
MutableBlock ty (PrimState prim) -> prim (Block ty)
unsafeFreeze MutableBlock Word8 s
MutableBlock Word8 (PrimState (ST s))
mut
loop MutableBlock Word8 s
_ Int
_ [] = [(Digest a, String)] -> ST s [(Digest a, String)]
forall (m :: * -> *) a. Monad m => a -> m a
return []
loop MutableBlock Word8 s
_ Int
_ [Char
_] = [(Digest a, String)] -> ST s [(Digest a, String)]
forall (m :: * -> *) a. Monad m => a -> m a
return []
loop MutableBlock Word8 s
mut Int
n (Char
c:(Char
d:String
ds))
| Bool -> Bool
not (Char -> Bool
isHexDigit Char
c) = [(Digest a, String)] -> ST s [(Digest a, String)]
forall (m :: * -> *) a. Monad m => a -> m a
return []
| Bool -> Bool
not (Char -> Bool
isHexDigit Char
d) = [(Digest a, String)] -> ST s [(Digest a, String)]
forall (m :: * -> *) a. Monad m => a -> m a
return []
| Bool
otherwise = do
let w8 :: Word8
w8 = Int -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word8) -> Int -> Word8
forall a b. (a -> b) -> a -> b
$ Char -> Int
digitToInt Char
c Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
16 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Char -> Int
digitToInt Char
d
MutableBlock Word8 (PrimState (ST s))
-> Offset Word8 -> Word8 -> ST s ()
forall (prim :: * -> *) ty.
(PrimMonad prim, PrimType ty) =>
MutableBlock ty (PrimState prim) -> Offset ty -> ty -> prim ()
unsafeWrite MutableBlock Word8 s
MutableBlock Word8 (PrimState (ST s))
mut (Int -> Offset Word8
forall ty. Int -> Offset ty
Offset (Int -> Offset Word8) -> Int -> Offset Word8
forall a b. (a -> b) -> a -> b
$ Int
len Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
n) Word8
w8
MutableBlock Word8 s -> Int -> String -> ST s [(Digest a, String)]
forall s.
MutableBlock Word8 s -> Int -> String -> ST s [(Digest a, String)]
loop MutableBlock Word8 s
mut (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) String
ds