1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
|
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE RoleAnnotations #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeFamilies #-}
-- |
-- Module : Crypto.Hash.Types
-- License : BSD-style
-- Maintainer : Vincent Hanquez <vincent@snarc.org>
-- Stability : experimental
-- Portability : unknown
--
-- Crypto hash types definitions
module Crypto.Hash.Types (
HashAlgorithm (..),
HashAlgorithmPrefix (..),
Context (..),
Digest (..),
) where
import Basement.Block (Block, unsafeFreeze)
import Basement.Block.Mutable (MutableBlock, new, unsafeWrite)
import Basement.NormalForm (deepseq)
import Basement.Types.OffsetSize (CountOf (..), Offset (..))
import Control.Monad.ST
import Crypto.Internal.ByteArray (ByteArrayAccess, Bytes)
import qualified Crypto.Internal.ByteArray as B
import Crypto.Internal.Imports
import Data.Char (digitToInt, isHexDigit)
import Data.Data (Data)
import Foreign.Ptr (Ptr)
import GHC.TypeLits (Nat)
-- | 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 (ByteArrayAccess, 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 (Eq, Ord, ByteArrayAccess, Data)
type role Digest nominal
instance NFData (Digest a) where
rnf (Digest u) = u `deepseq` ()
instance Show (Digest a) where
show (Digest bs) =
map (toEnum . fromIntegral) $
B.unpack (B.convertToBase B.Base16 bs :: Bytes)
instance HashAlgorithm a => Read (Digest a) where
readsPrec _ str = runST $ do
mut <- new (CountOf len)
loop mut len str
where
len = hashDigestSize (undefined :: a)
loop :: MutableBlock Word8 s -> Int -> String -> ST s [(Digest a, String)]
loop mut 0 cs = (\b -> [(Digest b, cs)]) <$> unsafeFreeze mut
loop _ _ [] = return []
loop _ _ [_] = return []
loop mut n (c : (d : ds))
| not (isHexDigit c) = return []
| not (isHexDigit d) = return []
| otherwise = do
let w8 = fromIntegral $ digitToInt c * 16 + digitToInt d
unsafeWrite mut (Offset $ len - n) w8
loop mut (n - 1) ds
|
