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
138
139
140
141
142
143
144
|
-- |
-- Module : Crypto.MAC.KMAC
-- License : BSD-style
-- Maintainer : Olivier Chéron <olivier.cheron@gmail.com>
-- Stability : experimental
-- Portability : unknown
--
-- Provide the KMAC (Keccak Message Authentication Code) algorithm, derived from
-- the SHA-3 base algorithm Keccak and defined in NIST SP800-185.
--
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE ScopedTypeVariables #-}
module Crypto.MAC.KMAC
( HashSHAKE
, kmac
, KMAC(..)
-- * Incremental
, Context
, initialize
, update
, updates
, finalize
) where
import qualified Crypto.Hash as H
import Crypto.Hash.SHAKE (HashSHAKE(..))
import Crypto.Hash.Types (HashAlgorithm(..), Digest(..))
import qualified Crypto.Hash.Types as H
import Crypto.Internal.Builder
import Crypto.Internal.Imports
import Foreign.Ptr (Ptr)
import Data.Bits (shiftR)
import Data.ByteArray (ByteArrayAccess)
import qualified Data.ByteArray as B
-- cSHAKE
cshakeInit :: forall a name string prefix . (HashSHAKE a, ByteArrayAccess name, ByteArrayAccess string, ByteArrayAccess prefix)
=> name -> string -> prefix -> H.Context a
cshakeInit n s p = H.Context $ B.allocAndFreeze c $ \(ptr :: Ptr (H.Context a)) -> do
hashInternalInit ptr
B.withByteArray b $ \d -> hashInternalUpdate ptr d (fromIntegral $ B.length b)
B.withByteArray p $ \d -> hashInternalUpdate ptr d (fromIntegral $ B.length p)
where
c = hashInternalContextSize (undefined :: a)
w = hashBlockSize (undefined :: a)
x = encodeString n <> encodeString s
b = buildAndFreeze (bytepad x w) :: B.Bytes
cshakeUpdate :: (HashSHAKE a, ByteArrayAccess ba)
=> H.Context a -> ba -> H.Context a
cshakeUpdate = H.hashUpdate
cshakeUpdates :: (HashSHAKE a, ByteArrayAccess ba)
=> H.Context a -> [ba] -> H.Context a
cshakeUpdates = H.hashUpdates
cshakeFinalize :: forall a suffix . (HashSHAKE a, ByteArrayAccess suffix)
=> H.Context a -> suffix -> Digest a
cshakeFinalize !c s =
Digest $ B.allocAndFreeze (hashDigestSize (undefined :: a)) $ \dig -> do
((!_) :: B.Bytes) <- B.copy c $ \(ctx :: Ptr (H.Context a)) -> do
B.withByteArray s $ \d ->
hashInternalUpdate ctx d (fromIntegral $ B.length s)
cshakeInternalFinalize ctx dig
return ()
-- KMAC
-- | Represent a KMAC that is a phantom type with the hash used to produce the
-- mac.
--
-- The Eq instance is constant time. No Show instance is provided, to avoid
-- printing by mistake.
newtype KMAC a = KMAC { kmacGetDigest :: Digest a }
deriving (ByteArrayAccess,NFData)
instance Eq (KMAC a) where
(KMAC b1) == (KMAC b2) = B.constEq b1 b2
-- | Compute a KMAC using the supplied customization string and key.
kmac :: (HashSHAKE a, ByteArrayAccess string, ByteArrayAccess key, ByteArrayAccess ba)
=> string -> key -> ba -> KMAC a
kmac str key msg = finalize $ updates (initialize str key) [msg]
-- | Represent an ongoing KMAC state, that can be appended with 'update' and
-- finalized to a 'KMAC' with 'finalize'.
newtype Context a = Context (H.Context a)
-- | Initialize a new incremental KMAC context with the supplied customization
-- string and key.
initialize :: forall a string key . (HashSHAKE a, ByteArrayAccess string, ByteArrayAccess key)
=> string -> key -> Context a
initialize str key = Context $ cshakeInit n str p
where
n = B.pack [75,77,65,67] :: B.Bytes -- "KMAC"
w = hashBlockSize (undefined :: a)
p = buildAndFreeze (bytepad (encodeString key) w) :: B.ScrubbedBytes
-- | Incrementally update a KMAC context.
update :: (HashSHAKE a, ByteArrayAccess ba) => Context a -> ba -> Context a
update (Context ctx) = Context . cshakeUpdate ctx
-- | Incrementally update a KMAC context with multiple inputs.
updates :: (HashSHAKE a, ByteArrayAccess ba) => Context a -> [ba] -> Context a
updates (Context ctx) = Context . cshakeUpdates ctx
-- | Finalize a KMAC context and return the KMAC.
finalize :: forall a . HashSHAKE a => Context a -> KMAC a
finalize (Context ctx) = KMAC $ cshakeFinalize ctx suffix
where
l = cshakeOutputLength (undefined :: a)
suffix = buildAndFreeze (rightEncode l) :: B.Bytes
-- Utilities
bytepad :: Builder -> Int -> Builder
bytepad x w = prefix <> x <> zero padLen
where
prefix = leftEncode w
padLen = (w - builderLength prefix - builderLength x) `mod` w
encodeString :: ByteArrayAccess bin => bin -> Builder
encodeString s = leftEncode (8 * B.length s) <> bytes s
leftEncode :: Int -> Builder
leftEncode x = byte len <> digits
where
digits = i2osp x
len = fromIntegral (builderLength digits)
rightEncode :: Int -> Builder
rightEncode x = digits <> byte len
where
digits = i2osp x
len = fromIntegral (builderLength digits)
i2osp :: Int -> Builder
i2osp i | i >= 256 = i2osp (shiftR i 8) <> byte (fromIntegral i)
| otherwise = byte (fromIntegral i)
|
