-- |
-- Module      : Crypto.Hash.Types
-- License     : BSD-style
-- Maintainer  : Vincent Hanquez <vincent@snarc.org>
-- Stability   : experimental
-- Portability : unknown
--
-- Crypto hash types definitions
--
{-# 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 representing hashing algorithms.
--
-- The interface presented here is update in place
-- and lowlevel. the Hash module takes care of
-- hidding the mutable interface properly.
class HashAlgorithm a where
    -- | Associated type for the block size of the hash algorithm
    type HashBlockSize a :: Nat
    -- | Associated type for the digest size of the hash algorithm
    type HashDigestSize a :: Nat
    -- | Associated type for the internal context size of the hash algorithm
    type HashInternalContextSize a :: Nat

    -- | Get the block size of a hash algorithm
    hashBlockSize           :: a -> Int
    -- | Get the digest size of a hash algorithm
    hashDigestSize          :: a -> Int
    -- | Get the size of the context used for a hash algorithm
    hashInternalContextSize :: a -> Int
    --hashAlgorithmFromProxy  :: Proxy a -> a

    -- | Initialize a context pointer to the initial state of a hash algorithm
    hashInternalInit     :: Ptr (Context a) -> IO ()
    -- | Update the context with some raw data
    hashInternalUpdate   :: Ptr (Context a) -> Ptr Word8 -> Word32 -> IO ()
    -- | Finalize the context and set the digest raw memory to the right value
    hashInternalFinalize :: Ptr (Context a) -> Ptr (Digest a) -> IO ()

-- | Hashing algorithms with a constant-time implementation.
class HashAlgorithm a => HashAlgorithmPrefix a where
    -- | Update the context with the first N bytes of a buffer and finalize this
    -- context.  The code path executed is independent from N and depends only
    -- on the complete buffer length.
    hashInternalFinalizePrefix :: Ptr (Context a)
                               -> Ptr Word8 -> Word32
                               -> Word32
                               -> Ptr (Digest a)
                               -> IO ()

{-
hashContextGetAlgorithm :: HashAlgorithm a => Context a -> a
hashContextGetAlgorithm = undefined
-}

-- | Represent a context for a given hash algorithm.
--
-- This type is an instance of 'ByteArrayAccess' for debugging purpose. Internal
-- layout is architecture dependent, may contain uninitialized data fragments,
-- and change in future versions.  The bytearray should not be used as input to
-- cryptographic algorithms.
newtype Context a = Context Bytes
    deriving (Context a -> Int
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 :: forall p. Context a -> Ptr p -> IO ()
$ccopyByteArrayToPtr :: forall a p. Context a -> Ptr p -> IO ()
withByteArray :: forall p a. 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 -> ()
forall a. Context a -> ()
forall a. (a -> ()) -> NFData a
rnf :: Context a -> ()
$crnf :: forall a. Context a -> ()
NFData)

-- | Represent a digest for a given hash algorithm.
--
-- This type is an instance of 'ByteArrayAccess' from package
-- <https://hackage.haskell.org/package/memory memory>.
-- Module "Data.ByteArray" provides many primitives to work with those values
-- including conversion to other types.
--
-- Creating a digest from a bytearray is also possible with function
-- 'Crypto.Hash.digestFromByteString'.
newtype Digest a = Digest (Block Word8)
    deriving (Digest a -> Digest a -> Bool
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,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
Ord,Digest a -> Int
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 :: forall p. Digest a -> Ptr p -> IO ()
$ccopyByteArrayToPtr :: forall a p. Digest a -> Ptr p -> IO ()
withByteArray :: forall p a. 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, Digest a -> DataType
Digest a -> Constr
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 (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))
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(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 (m :: * -> *).
MonadPlus m =>
(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 (m :: * -> *).
Monad m =>
(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 :: forall u. 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 u. (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 :: forall r r'.
(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 :: forall r r'.
(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 (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(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 (t :: * -> *) (c :: * -> *).
Typeable t =>
(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 (c :: * -> *).
(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 (c :: * -> *).
(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)
Data)

instance NFData (Digest a) where
    rnf :: Digest a -> ()
rnf (Digest Block Word8
u) = Block Word8
u forall a b. NormalForm a => a -> b -> b
`deepseq` ()

instance Show (Digest a) where
    show :: Digest a -> String
show (Digest Block Word8
bs) = forall a b. (a -> b) -> [a] -> [b]
map (forall a. Enum a => Int -> a
toEnum forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Integral a, Num b) => a -> b
fromIntegral)
                     forall a b. (a -> b) -> a -> b
$ forall a. ByteArrayAccess a => a -> [Word8]
B.unpack (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 a. (forall s. ST s a) -> a
runST forall a b. (a -> b) -> a -> b
$ do MutableBlock Word8 s
mut <- forall (prim :: * -> *) ty.
(PrimMonad prim, PrimType ty) =>
CountOf ty -> prim (MutableBlock ty (PrimState prim))
new (forall ty. Int -> CountOf ty
CountOf Int
len)
                                 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 = forall a. HashAlgorithm a => a -> Int
hashDigestSize (forall a. HasCallStack => a
undefined :: a)

        loop :: MutableBlock Word8 s -> Int -> String -> ST s [(Digest a, String)]
        loop :: forall s.
MutableBlock Word8 s -> Int -> String -> ST s [(Digest a, String)]
loop MutableBlock Word8 s
mut Int
0   String
cs          = (\Block Word8
b -> [(forall a. Block Word8 -> Digest a
Digest Block Word8
b, String
cs)]) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (prim :: * -> *) ty.
PrimMonad prim =>
MutableBlock ty (PrimState prim) -> prim (Block ty)
unsafeFreeze MutableBlock Word8 s
mut
        loop MutableBlock Word8 s
_   Int
_   []          = forall (m :: * -> *) a. Monad m => a -> m a
return []
        loop MutableBlock Word8 s
_   Int
_   [Char
_]         = 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) = forall (m :: * -> *) a. Monad m => a -> m a
return []
            | Bool -> Bool
not (Char -> Bool
isHexDigit Char
d) = forall (m :: * -> *) a. Monad m => a -> m a
return []
            | Bool
otherwise          = do
                let w8 :: Word8
w8 = forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ Char -> Int
digitToInt Char
c forall a. Num a => a -> a -> a
* Int
16 forall a. Num a => a -> a -> a
+ Char -> Int
digitToInt Char
d
                forall (prim :: * -> *) ty.
(PrimMonad prim, PrimType ty) =>
MutableBlock ty (PrimState prim) -> Offset ty -> ty -> prim ()
unsafeWrite MutableBlock Word8 s
mut (forall ty. Int -> Offset ty
Offset forall a b. (a -> b) -> a -> b
$ Int
len forall a. Num a => a -> a -> a
- Int
n) Word8
w8
                forall s.
MutableBlock Word8 s -> Int -> String -> ST s [(Digest a, String)]
loop MutableBlock Word8 s
mut (Int
n forall a. Num a => a -> a -> a
- Int
1) String
ds