From 155143611159e56792219989778d990817df543b Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Olivier=20Ch=C3=A9ron?= Date: Sun, 7 Apr 2019 09:49:31 +0200 Subject: [PATCH] Add KMAC --- Crypto/Hash/SHAKE.hs | 30 ++++++++- Crypto/MAC/KMAC.hs | 134 ++++++++++++++++++++++++++++++++++++++++ cbits/cryptonite_sha3.c | 17 +++-- cbits/cryptonite_sha3.h | 1 + cryptonite.cabal | 4 +- tests/KAT_KMAC.hs | 129 ++++++++++++++++++++++++++++++++++++++ tests/Tests.hs | 2 + 7 files changed, 311 insertions(+), 6 deletions(-) create mode 100644 Crypto/MAC/KMAC.hs create mode 100644 tests/KAT_KMAC.hs diff --git a/Crypto/Hash/SHAKE.hs b/Crypto/Hash/SHAKE.hs index 3298816..8639cdb 100644 --- a/Crypto/Hash/SHAKE.hs +++ b/Crypto/Hash/SHAKE.hs @@ -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 () diff --git a/Crypto/MAC/KMAC.hs b/Crypto/MAC/KMAC.hs new file mode 100644 index 0000000..25e640a --- /dev/null +++ b/Crypto/MAC/KMAC.hs @@ -0,0 +1,134 @@ +-- | +-- Module : Crypto.MAC.KMAC +-- License : BSD-style +-- Maintainer : Olivier Chéron +-- 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) diff --git a/cbits/cryptonite_sha3.c b/cbits/cryptonite_sha3.c index 02278e2..93f411a 100644 --- a/cbits/cryptonite_sha3.c +++ b/cbits/cryptonite_sha3.c @@ -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); diff --git a/cbits/cryptonite_sha3.h b/cbits/cryptonite_sha3.h index 4fe02eb..fbb2413 100644 --- a/cbits/cryptonite_sha3.h +++ b/cbits/cryptonite_sha3.h @@ -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); diff --git a/cryptonite.cabal b/cryptonite.cabal index 22f16c4..0c9b036 100644 --- a/cryptonite.cabal +++ b/cryptonite.cabal @@ -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 diff --git a/tests/KAT_KMAC.hs b/tests/KAT_KMAC.hs new file mode 100644 index 0000000..e5fa83c --- /dev/null +++ b/tests/KAT_KMAC.hs @@ -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 + ] diff --git a/tests/Tests.hs b/tests/Tests.hs index bd64ecc..3b9a09f 100644 --- a/tests/Tests.hs +++ b/tests/Tests.hs @@ -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