{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE ScopedTypeVariables #-}
module Crypto.MAC.KMAC
( HashSHAKE
, kmac
, KMAC(..)
, 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
cshakeInit :: forall a name string prefix . (HashSHAKE a, ByteArrayAccess name, ByteArrayAccess string, ByteArrayAccess prefix)
=> name -> string -> prefix -> H.Context a
cshakeInit :: forall a name string prefix.
(HashSHAKE a, ByteArrayAccess name, ByteArrayAccess string,
ByteArrayAccess prefix) =>
name -> string -> prefix -> Context a
cshakeInit name
n string
s prefix
p = forall a. Bytes -> Context a
H.Context forall a b. (a -> b) -> a -> b
$ forall a p. ByteArray a => Int -> (Ptr p -> IO ()) -> a
B.allocAndFreeze Int
c forall a b. (a -> b) -> a -> b
$ \(Ptr (Context a)
ptr :: Ptr (H.Context a)) -> do
forall a. HashAlgorithm a => Ptr (Context a) -> IO ()
hashInternalInit Ptr (Context a)
ptr
forall ba p a. ByteArrayAccess ba => ba -> (Ptr p -> IO a) -> IO a
B.withByteArray Bytes
b forall a b. (a -> b) -> a -> b
$ \Ptr Word8
d -> forall a.
HashAlgorithm a =>
Ptr (Context a) -> Ptr Word8 -> Word32 -> IO ()
hashInternalUpdate Ptr (Context a)
ptr Ptr Word8
d (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ forall ba. ByteArrayAccess ba => ba -> Int
B.length Bytes
b)
forall ba p a. ByteArrayAccess ba => ba -> (Ptr p -> IO a) -> IO a
B.withByteArray prefix
p forall a b. (a -> b) -> a -> b
$ \Ptr Word8
d -> forall a.
HashAlgorithm a =>
Ptr (Context a) -> Ptr Word8 -> Word32 -> IO ()
hashInternalUpdate Ptr (Context a)
ptr Ptr Word8
d (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ forall ba. ByteArrayAccess ba => ba -> Int
B.length prefix
p)
where
c :: Int
c = forall a. HashAlgorithm a => a -> Int
hashInternalContextSize (forall a. HasCallStack => a
undefined :: a)
w :: Int
w = forall a. HashAlgorithm a => a -> Int
hashBlockSize (forall a. HasCallStack => a
undefined :: a)
x :: Builder
x = forall bin. ByteArrayAccess bin => bin -> Builder
encodeString name
n forall a. Semigroup a => a -> a -> a
<> forall bin. ByteArrayAccess bin => bin -> Builder
encodeString string
s
b :: Bytes
b = forall ba. ByteArray ba => Builder -> ba
buildAndFreeze (Builder -> Int -> Builder
bytepad Builder
x Int
w) :: B.Bytes
cshakeUpdate :: (HashSHAKE a, ByteArrayAccess ba)
=> H.Context a -> ba -> H.Context a
cshakeUpdate :: forall a ba.
(HashSHAKE a, ByteArrayAccess ba) =>
Context a -> ba -> Context a
cshakeUpdate = forall ba a.
(ByteArrayAccess ba, HashAlgorithm a) =>
Context a -> ba -> Context a
H.hashUpdate
cshakeUpdates :: (HashSHAKE a, ByteArrayAccess ba)
=> H.Context a -> [ba] -> H.Context a
cshakeUpdates :: forall a ba.
(HashSHAKE a, ByteArrayAccess ba) =>
Context a -> [ba] -> Context a
cshakeUpdates = forall a ba.
(HashAlgorithm a, ByteArrayAccess ba) =>
Context a -> [ba] -> Context a
H.hashUpdates
cshakeFinalize :: forall a suffix . (HashSHAKE a, ByteArrayAccess suffix)
=> H.Context a -> suffix -> Digest a
cshakeFinalize :: forall a suffix.
(HashSHAKE a, ByteArrayAccess suffix) =>
Context a -> suffix -> Digest a
cshakeFinalize !Context a
c suffix
s =
forall a. Block Word8 -> Digest a
Digest forall a b. (a -> b) -> a -> b
$ forall a p. ByteArray a => Int -> (Ptr p -> IO ()) -> a
B.allocAndFreeze (forall a. HashAlgorithm a => a -> Int
hashDigestSize (forall a. HasCallStack => a
undefined :: a)) forall a b. (a -> b) -> a -> b
$ \Ptr (Digest a)
dig -> do
((!Bytes
_) :: B.Bytes) <- forall bs1 bs2 p.
(ByteArrayAccess bs1, ByteArray bs2) =>
bs1 -> (Ptr p -> IO ()) -> IO bs2
B.copy Context a
c forall a b. (a -> b) -> a -> b
$ \(Ptr (Context a)
ctx :: Ptr (H.Context a)) -> do
forall ba p a. ByteArrayAccess ba => ba -> (Ptr p -> IO a) -> IO a
B.withByteArray suffix
s forall a b. (a -> b) -> a -> b
$ \Ptr Word8
d ->
forall a.
HashAlgorithm a =>
Ptr (Context a) -> Ptr Word8 -> Word32 -> IO ()
hashInternalUpdate Ptr (Context a)
ctx Ptr Word8
d (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ forall ba. ByteArrayAccess ba => ba -> Int
B.length suffix
s)
forall a. HashSHAKE a => Ptr (Context a) -> Ptr (Digest a) -> IO ()
cshakeInternalFinalize Ptr (Context a)
ctx Ptr (Digest a)
dig
forall (m :: * -> *) a. Monad m => a -> m a
return ()
newtype KMAC a = KMAC { forall a. KMAC a -> Digest a
kmacGetDigest :: Digest a }
deriving (KMAC a -> Int
forall a. KMAC a -> Int
forall p. KMAC 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. KMAC a -> Ptr p -> IO ()
forall p a. KMAC a -> (Ptr p -> IO a) -> IO a
forall a p a. KMAC a -> (Ptr p -> IO a) -> IO a
copyByteArrayToPtr :: forall p. KMAC a -> Ptr p -> IO ()
$ccopyByteArrayToPtr :: forall a p. KMAC a -> Ptr p -> IO ()
withByteArray :: forall p a. KMAC a -> (Ptr p -> IO a) -> IO a
$cwithByteArray :: forall a p a. KMAC a -> (Ptr p -> IO a) -> IO a
length :: KMAC a -> Int
$clength :: forall a. KMAC a -> Int
ByteArrayAccess,KMAC a -> ()
forall a. KMAC a -> ()
forall a. (a -> ()) -> NFData a
rnf :: KMAC a -> ()
$crnf :: forall a. KMAC a -> ()
NFData)
instance Eq (KMAC a) where
(KMAC Digest a
b1) == :: KMAC a -> KMAC a -> Bool
== (KMAC Digest a
b2) = forall bs1 bs2.
(ByteArrayAccess bs1, ByteArrayAccess bs2) =>
bs1 -> bs2 -> Bool
B.constEq Digest a
b1 Digest a
b2
kmac :: (HashSHAKE a, ByteArrayAccess string, ByteArrayAccess key, ByteArrayAccess ba)
=> string -> key -> ba -> KMAC a
kmac :: forall a string key ba.
(HashSHAKE a, ByteArrayAccess string, ByteArrayAccess key,
ByteArrayAccess ba) =>
string -> key -> ba -> KMAC a
kmac string
str key
key ba
msg = forall a. HashSHAKE a => Context a -> KMAC a
finalize forall a b. (a -> b) -> a -> b
$ forall a ba.
(HashSHAKE a, ByteArrayAccess ba) =>
Context a -> [ba] -> Context a
updates (forall a string key.
(HashSHAKE a, ByteArrayAccess string, ByteArrayAccess key) =>
string -> key -> Context a
initialize string
str key
key) [ba
msg]
newtype Context a = Context (H.Context a)
initialize :: forall a string key . (HashSHAKE a, ByteArrayAccess string, ByteArrayAccess key)
=> string -> key -> Context a
initialize :: forall a string key.
(HashSHAKE a, ByteArrayAccess string, ByteArrayAccess key) =>
string -> key -> Context a
initialize string
str key
key = forall a. Context a -> Context a
Context forall a b. (a -> b) -> a -> b
$ forall a name string prefix.
(HashSHAKE a, ByteArrayAccess name, ByteArrayAccess string,
ByteArrayAccess prefix) =>
name -> string -> prefix -> Context a
cshakeInit Bytes
n string
str ScrubbedBytes
p
where
n :: Bytes
n = forall a. ByteArray a => [Word8] -> a
B.pack [Word8
75,Word8
77,Word8
65,Word8
67] :: B.Bytes
w :: Int
w = forall a. HashAlgorithm a => a -> Int
hashBlockSize (forall a. HasCallStack => a
undefined :: a)
p :: ScrubbedBytes
p = forall ba. ByteArray ba => Builder -> ba
buildAndFreeze (Builder -> Int -> Builder
bytepad (forall bin. ByteArrayAccess bin => bin -> Builder
encodeString key
key) Int
w) :: B.ScrubbedBytes
update :: (HashSHAKE a, ByteArrayAccess ba) => Context a -> ba -> Context a
update :: forall a ba.
(HashSHAKE a, ByteArrayAccess ba) =>
Context a -> ba -> Context a
update (Context Context a
ctx) = forall a. Context a -> Context a
Context forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a ba.
(HashSHAKE a, ByteArrayAccess ba) =>
Context a -> ba -> Context a
cshakeUpdate Context a
ctx
updates :: (HashSHAKE a, ByteArrayAccess ba) => Context a -> [ba] -> Context a
updates :: forall a ba.
(HashSHAKE a, ByteArrayAccess ba) =>
Context a -> [ba] -> Context a
updates (Context Context a
ctx) = forall a. Context a -> Context a
Context forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a ba.
(HashSHAKE a, ByteArrayAccess ba) =>
Context a -> [ba] -> Context a
cshakeUpdates Context a
ctx
finalize :: forall a . HashSHAKE a => Context a -> KMAC a
finalize :: forall a. HashSHAKE a => Context a -> KMAC a
finalize (Context Context a
ctx) = forall a. Digest a -> KMAC a
KMAC forall a b. (a -> b) -> a -> b
$ forall a suffix.
(HashSHAKE a, ByteArrayAccess suffix) =>
Context a -> suffix -> Digest a
cshakeFinalize Context a
ctx Bytes
suffix
where
l :: Int
l = forall a. HashSHAKE a => a -> Int
cshakeOutputLength (forall a. HasCallStack => a
undefined :: a)
suffix :: Bytes
suffix = forall ba. ByteArray ba => Builder -> ba
buildAndFreeze (Int -> Builder
rightEncode Int
l) :: B.Bytes
bytepad :: Builder -> Int -> Builder
bytepad :: Builder -> Int -> Builder
bytepad Builder
x Int
w = Builder
prefix forall a. Semigroup a => a -> a -> a
<> Builder
x forall a. Semigroup a => a -> a -> a
<> Int -> Builder
zero Int
padLen
where
prefix :: Builder
prefix = Int -> Builder
leftEncode Int
w
padLen :: Int
padLen = (Int
w forall a. Num a => a -> a -> a
- Builder -> Int
builderLength Builder
prefix forall a. Num a => a -> a -> a
- Builder -> Int
builderLength Builder
x) forall a. Integral a => a -> a -> a
`mod` Int
w
encodeString :: ByteArrayAccess bin => bin -> Builder
encodeString :: forall bin. ByteArrayAccess bin => bin -> Builder
encodeString bin
s = Int -> Builder
leftEncode (Int
8 forall a. Num a => a -> a -> a
* forall ba. ByteArrayAccess ba => ba -> Int
B.length bin
s) forall a. Semigroup a => a -> a -> a
<> forall bin. ByteArrayAccess bin => bin -> Builder
bytes bin
s
leftEncode :: Int -> Builder
leftEncode :: Int -> Builder
leftEncode Int
x = Word8 -> Builder
byte Word8
len forall a. Semigroup a => a -> a -> a
<> Builder
digits
where
digits :: Builder
digits = Int -> Builder
i2osp Int
x
len :: Word8
len = forall a b. (Integral a, Num b) => a -> b
fromIntegral (Builder -> Int
builderLength Builder
digits)
rightEncode :: Int -> Builder
rightEncode :: Int -> Builder
rightEncode Int
x = Builder
digits forall a. Semigroup a => a -> a -> a
<> Word8 -> Builder
byte Word8
len
where
digits :: Builder
digits = Int -> Builder
i2osp Int
x
len :: Word8
len = forall a b. (Integral a, Num b) => a -> b
fromIntegral (Builder -> Int
builderLength Builder
digits)
i2osp :: Int -> Builder
i2osp :: Int -> Builder
i2osp Int
i | Int
i forall a. Ord a => a -> a -> Bool
>= Int
256 = Int -> Builder
i2osp (forall a. Bits a => a -> Int -> a
shiftR Int
i Int
8) forall a. Semigroup a => a -> a -> a
<> Word8 -> Builder
byte (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
i)
| Bool
otherwise = Word8 -> Builder
byte (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
i)