1-- |
2-- Module      : Crypto.Hash.Types
3-- License     : BSD-style
4-- Maintainer  : Vincent Hanquez <vincent@snarc.org>
5-- Stability   : experimental
6-- Portability : unknown
7--
8-- Crypto hash types definitions
9--
10{-# LANGUAGE GeneralizedNewtypeDeriving #-}
11{-# LANGUAGE DeriveDataTypeable #-}
12{-# LANGUAGE DataKinds #-}
13{-# LANGUAGE ScopedTypeVariables #-}
14{-# LANGUAGE TypeFamilies #-}
15module Crypto.Hash.Types
16    ( HashAlgorithm(..)
17    , Context(..)
18    , Digest(..)
19    ) where
20
21import           Crypto.Internal.Imports
22import           Crypto.Internal.ByteArray (ByteArrayAccess, Bytes)
23import qualified Crypto.Internal.ByteArray as B
24import           Control.Monad.ST
25import           Data.Char (digitToInt, isHexDigit)
26import           Foreign.Ptr (Ptr)
27import           Basement.Block (Block, unsafeFreeze)
28import           Basement.Block.Mutable (MutableBlock, new, unsafeWrite)
29import           Basement.NormalForm (deepseq)
30import           Basement.Types.OffsetSize (CountOf(..), Offset(..))
31import           GHC.TypeLits (Nat)
32import           Data.Data (Data)
33
34-- | Class representing hashing algorithms.
35--
36-- The interface presented here is update in place
37-- and lowlevel. the Hash module takes care of
38-- hidding the mutable interface properly.
39class HashAlgorithm a where
40    -- | Associated type for the block size of the hash algorithm
41    type HashBlockSize a :: Nat
42    -- | Associated type for the digest size of the hash algorithm
43    type HashDigestSize a :: Nat
44    -- | Associated type for the internal context size of the hash algorithm
45    type HashInternalContextSize a :: Nat
46
47    -- | Get the block size of a hash algorithm
48    hashBlockSize           :: a -> Int
49    -- | Get the digest size of a hash algorithm
50    hashDigestSize          :: a -> Int
51    -- | Get the size of the context used for a hash algorithm
52    hashInternalContextSize :: a -> Int
53    --hashAlgorithmFromProxy  :: Proxy a -> a
54
55    -- | Initialize a context pointer to the initial state of a hash algorithm
56    hashInternalInit     :: Ptr (Context a) -> IO ()
57    -- | Update the context with some raw data
58    hashInternalUpdate   :: Ptr (Context a) -> Ptr Word8 -> Word32 -> IO ()
59    -- | Finalize the context and set the digest raw memory to the right value
60    hashInternalFinalize :: Ptr (Context a) -> Ptr (Digest a) -> IO ()
61
62{-
63hashContextGetAlgorithm :: HashAlgorithm a => Context a -> a
64hashContextGetAlgorithm = undefined
65-}
66
67-- | Represent a context for a given hash algorithm.
68newtype Context a = Context Bytes
69    deriving (ByteArrayAccess,NFData)
70
71-- | Represent a digest for a given hash algorithm.
72--
73-- This type is an instance of 'ByteArrayAccess' from package
74-- <https://hackage.haskell.org/package/memory memory>.
75-- Module "Data.ByteArray" provides many primitives to work with those values
76-- including conversion to other types.
77--
78-- Creating a digest from a bytearray is also possible with function
79-- 'Crypto.Hash.digestFromByteString'.
80newtype Digest a = Digest (Block Word8)
81    deriving (Eq,Ord,ByteArrayAccess, Data)
82
83instance NFData (Digest a) where
84    rnf (Digest u) = u `deepseq` ()
85
86instance Show (Digest a) where
87    show (Digest bs) = map (toEnum . fromIntegral)
88                     $ B.unpack (B.convertToBase B.Base16 bs :: Bytes)
89
90instance HashAlgorithm a => Read (Digest a) where
91    readsPrec _ str = runST $ do mut <- new (CountOf len)
92                                 loop mut len str
93      where
94        len = hashDigestSize (undefined :: a)
95
96        loop :: MutableBlock Word8 s -> Int -> String -> ST s [(Digest a, String)]
97        loop mut 0   cs          = (\b -> [(Digest b, cs)]) <$> unsafeFreeze mut
98        loop _   _   []          = return []
99        loop _   _   [_]         = return []
100        loop mut n   (c:(d:ds))
101            | not (isHexDigit c) = return []
102            | not (isHexDigit d) = return []
103            | otherwise          = do
104                let w8 = fromIntegral $ digitToInt c * 16 + digitToInt d
105                unsafeWrite mut (Offset $ len - n) w8
106                loop mut (n - 1) ds
107