haskell/cryptonite
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Add KMAC

Browse Source
This commit is contained in:
Olivier Chéron 2019-04-07 09:49:31 +02:00
parent c9f8dac6b0
commit 1551436111
7 changed files with 311 additions and 6 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

30
Crypto/Hash/SHAKE.hs
View File

@ -17,7 +17,7 @@
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UndecidableInstances #-}
module Crypto.Hash.SHAKE
( SHAKE128 (..), SHAKE256 (..)
( SHAKE128 (..), SHAKE256 (..), HashSHAKE (..)
) where
import Control.Monad (when)
@ -32,6 +32,13 @@ import Data.Proxy (Proxy(..))
import GHC.TypeLits (Nat, KnownNat, type (+))
import Crypto.Internal.Nat
-- | Type class of SHAKE algorithms.
class HashAlgorithm a => HashSHAKE a where
-- | Alternate finalization needed for cSHAKE
cshakeInternalFinalize :: Ptr (Context a) -> Ptr (Digest a) -> IO ()
-- | Get the digest bit length
cshakeOutputLength :: a -> Int
-- | SHAKE128 (128 bits) extendable output function. Supports an arbitrary
-- digest size, to be specified as a type parameter of kind 'Nat'.
--
@ -52,6 +59,10 @@ instance KnownNat bitlen => HashAlgorithm (SHAKE128 bitlen) where
hashInternalUpdate = c_sha3_update
hashInternalFinalize = shakeFinalizeOutput (Proxy :: Proxy bitlen)
instance KnownNat bitlen => HashSHAKE (SHAKE128 bitlen) where
cshakeInternalFinalize = cshakeFinalizeOutput (Proxy :: Proxy bitlen)
cshakeOutputLength _ = integralNatVal (Proxy :: Proxy bitlen)
-- | SHAKE256 (256 bits) extendable output function. Supports an arbitrary
-- digest size, to be specified as a type parameter of kind 'Nat'.
--
@ -72,6 +83,10 @@ instance KnownNat bitlen => HashAlgorithm (SHAKE256 bitlen) where
hashInternalUpdate = c_sha3_update
hashInternalFinalize = shakeFinalizeOutput (Proxy :: Proxy bitlen)
instance KnownNat bitlen => HashSHAKE (SHAKE256 bitlen) where
cshakeInternalFinalize = cshakeFinalizeOutput (Proxy :: Proxy bitlen)
cshakeOutputLength _ = integralNatVal (Proxy :: Proxy bitlen)
shakeFinalizeOutput :: KnownNat bitlen
=> proxy bitlen
-> Ptr (Context a)
@ -82,6 +97,16 @@ shakeFinalizeOutput d ctx dig = do
c_sha3_output ctx dig (byteLen d)
shakeTruncate d (castPtr dig)
cshakeFinalizeOutput :: KnownNat bitlen
=> proxy bitlen
-> Ptr (Context a)
-> Ptr (Digest a)
-> IO ()
cshakeFinalizeOutput d ctx dig = do
c_sha3_finalize_cshake ctx
c_sha3_output ctx dig (byteLen d)
shakeTruncate d (castPtr dig)
shakeTruncate :: KnownNat bitlen => proxy bitlen -> Ptr Word8 -> IO ()
shakeTruncate d ptr =
when (bits > 0) $ do
@ -100,5 +125,8 @@ foreign import ccall "cryptonite_sha3_update"
foreign import ccall unsafe "cryptonite_sha3_finalize_shake"
c_sha3_finalize_shake :: Ptr (Context a) -> IO ()
foreign import ccall unsafe "cryptonite_sha3_finalize_cshake"
c_sha3_finalize_cshake :: Ptr (Context a) -> IO ()
foreign import ccall unsafe "cryptonite_sha3_output"
c_sha3_output :: Ptr (Context a) -> Ptr (Digest a) -> Word32 -> IO ()

134
Crypto/MAC/KMAC.hs Normal file
View File

@ -0,0 +1,134 @@
-- |
-- 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.Number.Serialize
import Foreign.Ptr (Ptr)
import Data.ByteArray (ByteArray, ByteArrayAccess)
import qualified Data.ByteArray as B
-- cSHAKE
cshakeInit :: forall a name string . (HashSHAKE a, ByteArrayAccess name, ByteArrayAccess string)
=> name -> string -> H.Context a
cshakeInit n s = H.Context $ B.allocAndFreeze c $ \(ptr :: Ptr (H.Context a)) -> do
hashInternalInit ptr
B.withByteArray b $ \d -> hashInternalUpdate ptr d (fromIntegral $ B.length b)
where
c = hashInternalContextSize (undefined :: a)
w = hashBlockSize (undefined :: a)
x = encodeString n `B.append` encodeString s :: B.Bytes
b = bytepad x w
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 . HashSHAKE a => H.Context a -> Digest a
cshakeFinalize !c =
Digest $ B.allocAndFreeze (hashDigestSize (undefined :: a)) $ \dig -> do
((!_) :: B.Bytes) <- B.copy c $ \(ctx :: Ptr (H.Context a)) ->
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
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 $ cshakeUpdate (cshakeInit n str) prefix
where
n = B.pack [75,77,65,67] :: B.Bytes -- "KMAC"
w = hashBlockSize (undefined :: a)
prefix = bytepad (encodeString key) w :: B.Bytes
-- | 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 $ cshakeUpdate ctx suffix
where
l = cshakeOutputLength (undefined :: a)
suffix = rightEncode l :: B.Bytes
-- Utilities
bytepad :: ByteArray ba => ba -> Int -> ba
bytepad x w = B.concat [ prefix, x, B.zero padLen ]
where
prefix = leftEncode w
padLen = (w - B.length prefix - B.length x) `mod` w
encodeString :: (ByteArrayAccess bin, ByteArray bout) => bin -> bout
encodeString s = leftEncode (8 * B.length s) `B.append` B.convert s
leftEncode :: ByteArray ba => Int -> ba
leftEncode x = B.cons len digits
where
digits = i2osp (toInteger x)
len = fromIntegral (B.length digits)
rightEncode :: ByteArray ba => Int -> ba
rightEncode x = B.snoc digits len
where
digits = i2osp (toInteger x)
len = fromIntegral (B.length digits)

17
cbits/cryptonite_sha3.c
View File

@ -99,8 +99,11 @@ static inline void sha3_do_chunk(uint64_t state[25], uint64_t buf[], int bufsz)
}
/*
* Initialize a SHA-3 / SHAKE context: hashlen is the security level (and
* half the capacity) in bits
* Initialize a SHA-3 / SHAKE / cSHAKE context: hashlen is the security level
* (and half the capacity) in bits.
*
* In case of cSHAKE, the message prefix with encoded N and S must be added with
* cryptonite_sha3_update.
*/
void cryptonite_sha3_init(struct sha3_ctx *ctx, uint32_t hashlen)
{
@ -110,7 +113,7 @@ void cryptonite_sha3_init(struct sha3_ctx *ctx, uint32_t hashlen)
ctx->bufsz = bufsz;
}
/* Update a SHA-3 / SHAKE context */
/* Update a SHA-3 / SHAKE / cSHAKE context */
void cryptonite_sha3_update(struct sha3_ctx *ctx, const uint8_t *data, uint32_t len)
{
uint32_t to_fill;
@ -171,7 +174,7 @@ void cryptonite_sha3_finalize_with_pad_byte(struct sha3_ctx *ctx, uint8_t pad_by
}
/*
* Extract some bytes from a finalized SHA-3 / SHAKE context.
* Extract some bytes from a finalized SHA-3 / SHAKE / cSHAKE context.
* May be called multiple times.
*/
void cryptonite_sha3_output(struct sha3_ctx *ctx, uint8_t *out, uint32_t len)
@ -226,6 +229,12 @@ void cryptonite_sha3_finalize_shake(struct sha3_ctx *ctx)
cryptonite_sha3_finalize_with_pad_byte(ctx, 0x1F);
}
/* Finalize a cSHAKE context. Output is read using cryptonite_sha3_output. */
void cryptonite_sha3_finalize_cshake(struct sha3_ctx *ctx)
{
cryptonite_sha3_finalize_with_pad_byte(ctx, 0x04);
}
void cryptonite_keccak_init(struct sha3_ctx *ctx, uint32_t hashlen)
{
cryptonite_sha3_init(ctx, hashlen);

1
cbits/cryptonite_sha3.h
View File

@ -57,6 +57,7 @@ void cryptonite_sha3_update(struct sha3_ctx *ctx, const uint8_t *data, uint32_t
void cryptonite_sha3_finalize(struct sha3_ctx *ctx, uint32_t hashlen, uint8_t *out);
void cryptonite_sha3_finalize_shake(struct sha3_ctx *ctx);
void cryptonite_sha3_finalize_cshake(struct sha3_ctx *ctx);
void cryptonite_sha3_output(struct sha3_ctx *ctx, uint8_t *out, uint32_t len);
void cryptonite_keccak_init(struct sha3_ctx *ctx, uint32_t hashlen);

4
cryptonite.cabal
View File

@ -8,7 +8,7 @@ Description:
.
* Hash: SHA1, SHA2, SHA3, SHAKE, MD2, MD4, MD5, Keccak, Skein, Ripemd, Tiger, Whirlpool, Blake2
.
* MAC: HMAC, Poly1305
* MAC: HMAC, KMAC, Poly1305
.
* Asymmetric crypto: DSA, RSA, DH, ECDH, ECDSA, ECC, Curve25519, Curve448, Ed25519, Ed448
.
@ -126,6 +126,7 @@ Library
Crypto.MAC.CMAC
Crypto.MAC.Poly1305
Crypto.MAC.HMAC
Crypto.MAC.KMAC
Crypto.Number.Basic
Crypto.Number.F2m
Crypto.Number.Generate
@ -404,6 +405,7 @@ Test-Suite test-cryptonite
KAT_CMAC
KAT_HKDF
KAT_HMAC
KAT_KMAC
KAT_MiyaguchiPreneel
KAT_PBKDF2
KAT_OTP

129
tests/KAT_KMAC.hs Normal file
View File

@ -0,0 +1,129 @@
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
module KAT_KMAC (tests) where
import Crypto.Hash (SHAKE128(..), SHAKE256(..),
HashAlgorithm, digestFromByteString)
import qualified Crypto.MAC.KMAC as KMAC
import qualified Data.ByteString as B
import Imports
data MACVector hash = MACVector
{ macString :: ByteString
, macKey :: ByteString
, macSecret :: ByteString
, macResult :: KMAC.KMAC hash
}
instance Show (KMAC.KMAC a) where
show (KMAC.KMAC d) = show d
digest :: HashAlgorithm hash => ByteString -> KMAC.KMAC hash
digest = maybe (error "cannot get digest") KMAC.KMAC . digestFromByteString
vectors128 :: [MACVector (SHAKE128 256)]
vectors128 =
[ MACVector
{ macString = ""
, macKey = B.pack [ 0x40 .. 0x5f ]
, macSecret = B.pack [ 0x00 .. 0x03 ]
, macResult = digest "\xe5\x78\x0b\x0d\x3e\xa6\xf7\xd3\xa4\x29\xc5\x70\x6a\xa4\x3a\x00\xfa\xdb\xd7\xd4\x96\x28\x83\x9e\x31\x87\x24\x3f\x45\x6e\xe1\x4e"
}
, MACVector
{ macString = "My Tagged Application"
, macKey = B.pack [ 0x40 .. 0x5f ]
, macSecret = B.pack [ 0x00 .. 0x03 ]
, macResult = digest "\x3b\x1f\xba\x96\x3c\xd8\xb0\xb5\x9e\x8c\x1a\x6d\x71\x88\x8b\x71\x43\x65\x1a\xf8\xba\x0a\x70\x70\xc0\x97\x9e\x28\x11\x32\x4a\xa5"
}
, MACVector
{ macString = "My Tagged Application"
, macKey = B.pack [ 0x40 .. 0x5f ]
, macSecret = B.pack [ 0x00 .. 0xc7 ]
, macResult = digest "\x1f\x5b\x4e\x6c\xca\x02\x20\x9e\x0d\xcb\x5c\xa6\x35\xb8\x9a\x15\xe2\x71\xec\xc7\x60\x07\x1d\xfd\x80\x5f\xaa\x38\xf9\x72\x92\x30"
}
]
vectors256 :: [MACVector (SHAKE256 512)]
vectors256 =
[ MACVector
{ macString = "My Tagged Application"
, macKey = B.pack [ 0x40 .. 0x5f ]
, macSecret = B.pack [ 0x00 .. 0x03 ]
, macResult = digest "\x20\xc5\x70\xc3\x13\x46\xf7\x03\xc9\xac\x36\xc6\x1c\x03\xcb\x64\xc3\x97\x0d\x0c\xfc\x78\x7e\x9b\x79\x59\x9d\x27\x3a\x68\xd2\xf7\xf6\x9d\x4c\xc3\xde\x9d\x10\x4a\x35\x16\x89\xf2\x7c\xf6\xf5\x95\x1f\x01\x03\xf3\x3f\x4f\x24\x87\x10\x24\xd9\xc2\x77\x73\xa8\xdd"
}
, MACVector
{ macString = ""
, macKey = B.pack [ 0x40 .. 0x5f ]
, macSecret = B.pack [ 0x00 .. 0xc7 ]
, macResult = digest "\x75\x35\x8c\xf3\x9e\x41\x49\x4e\x94\x97\x07\x92\x7c\xee\x0a\xf2\x0a\x3f\xf5\x53\x90\x4c\x86\xb0\x8f\x21\xcc\x41\x4b\xcf\xd6\x91\x58\x9d\x27\xcf\x5e\x15\x36\x9c\xbb\xff\x8b\x9a\x4c\x2e\xb1\x78\x00\x85\x5d\x02\x35\xff\x63\x5d\xa8\x25\x33\xec\x6b\x75\x9b\x69"
}
, MACVector
{ macString = "My Tagged Application"
, macKey = B.pack [ 0x40 .. 0x5f ]
, macSecret = B.pack [ 0x00 .. 0xc7 ]
, macResult = digest "\xb5\x86\x18\xf7\x1f\x92\xe1\xd5\x6c\x1b\x8c\x55\xdd\xd7\xcd\x18\x8b\x97\xb4\xca\x4d\x99\x83\x1e\xb2\x69\x9a\x83\x7d\xa2\xe4\xd9\x70\xfb\xac\xfd\xe5\x00\x33\xae\xa5\x85\xf1\xa2\x70\x85\x10\xc3\x2d\x07\x88\x08\x01\xbd\x18\x28\x98\xfe\x47\x68\x76\xfc\x89\x65"
}
]
macTests :: [TestTree]
macTests =
[ testGroup "SHAKE128" (concatMap toMACTest $ zip is vectors128)
, testGroup "SHAKE256" (concatMap toMACTest $ zip is vectors256)
]
where toMACTest (i, MACVector{..}) =
[ testCase (show i) (macResult @=? KMAC.kmac macString macKey macSecret)
, testCase ("incr-" ++ show i) (macResult @=?
KMAC.finalize (KMAC.update (KMAC.initialize macString macKey) macSecret))
]
is :: [Int]
is = [1..]
data MacIncremental a = MacIncremental ByteString ByteString ByteString (KMAC.KMAC a)
deriving (Show,Eq)
instance KMAC.HashSHAKE a => Arbitrary (MacIncremental a) where
arbitrary = do
str <- arbitraryBSof 0 49
key <- arbitraryBSof 1 89
msg <- arbitraryBSof 1 99
return $ MacIncremental str key msg (KMAC.kmac str key msg)
data MacIncrementalList a = MacIncrementalList ByteString ByteString [ByteString] (KMAC.KMAC a)
deriving (Show,Eq)
instance KMAC.HashSHAKE a => Arbitrary (MacIncrementalList a) where
arbitrary = do
str <- arbitraryBSof 0 49
key <- arbitraryBSof 1 89
msgs <- choose (1,20) >>= \n -> replicateM n (arbitraryBSof 1 99)
return $ MacIncrementalList str key msgs (KMAC.kmac str key (B.concat msgs))
macIncrementalTests :: [TestTree]
macIncrementalTests =
[ testIncrProperties "SHAKE128_256" (SHAKE128 :: SHAKE128 256)
, testIncrProperties "SHAKE256_512" (SHAKE256 :: SHAKE256 512)
]
where
testIncrProperties :: KMAC.HashSHAKE a => TestName -> a -> TestTree
testIncrProperties name a = testGroup name
[ testProperty "list-one" (prop_inc0 a)
, testProperty "list-multi" (prop_inc1 a)
]
prop_inc0 :: KMAC.HashSHAKE a => a -> MacIncremental a -> Bool
prop_inc0 _ (MacIncremental str secret msg result) =
result `assertEq` KMAC.finalize (KMAC.update (KMAC.initialize str secret) msg)
prop_inc1 :: KMAC.HashSHAKE a => a -> MacIncrementalList a -> Bool
prop_inc1 _ (MacIncrementalList str secret msgs result) =
result `assertEq` KMAC.finalize (foldl' KMAC.update (KMAC.initialize str secret) msgs)
tests = testGroup "KMAC"
[ testGroup "KATs" macTests
, testGroup "properties" macIncrementalTests
]

2
tests/Tests.hs
View File

@ -18,6 +18,7 @@ import qualified ChaChaPoly1305
import qualified KAT_MiyaguchiPreneel
import qualified KAT_CMAC
import qualified KAT_HMAC
import qualified KAT_KMAC
import qualified KAT_HKDF
import qualified KAT_Argon2
import qualified KAT_PBKDF2
@ -53,6 +54,7 @@ tests = testGroup "cryptonite"
[ Poly1305.tests
, KAT_CMAC.tests
, KAT_HMAC.tests
, KAT_KMAC.tests
]
, KAT_Curve25519.tests
, KAT_Curve448.tests