resumable hashing

Crypto/Hash.hs

@@ -40,6 +40,8 @@ module Crypto.Hash
     , hash
     , hashPrefix
     , hashlazy
+    , hashPutContext
+    , hashGetContext
     -- * Hash algorithms
     , module Crypto.Hash.Algorithms
     ) where
@@ -51,7 +53,7 @@ import           Crypto.Internal.Compat (unsafeDoIO)
 import           Crypto.Hash.Types
 import           Crypto.Hash.Algorithms
 import           Foreign.Ptr (Ptr, plusPtr)
-import           Crypto.Internal.ByteArray (ByteArrayAccess)
+import           Crypto.Internal.ByteArray (ByteArrayAccess, ByteArray)
 import qualified Crypto.Internal.ByteArray as B
 import qualified Data.ByteString.Lazy as L
 import           Data.Word (Word8)
@@ -159,3 +161,16 @@ digestFromByteString = from undefined
             unsafeFreeze muArray
           where
             count = CountOf (B.length ba)
+
+hashPutContext :: forall a ba. (HashAlgorithmResumable a, ByteArray ba) => Context a -> ba
+hashPutContext !c = B.allocAndFreeze (hashInternalContextSize (undefined :: a)) $ \(ptr :: Ptr Word8) ->
+  B.withByteArray c $ \(ctx :: Ptr (Context a)) -> hashInternalPutContextBE ctx ptr
+
+hashGetContext :: forall a ba. (HashAlgorithmResumable a, ByteArrayAccess ba) => ba -> Maybe (Context a)
+hashGetContext = from undefined
+  where
+        from :: a -> ba -> Maybe (Context a)
+        from alg bs
+          | B.length bs == (hashInternalContextSize alg) = Just $ Context $ B.allocAndFreeze (B.length bs) $ \(ctx :: Ptr (Context a)) ->
+              B.withByteArray bs $ \ptr -> hashInternalGetContextBE ptr ctx
+          | otherwise                                    = Nothing

Crypto/Hash/Algorithms.hs

@@ -10,6 +10,7 @@
 module Crypto.Hash.Algorithms
     ( HashAlgorithm
     , HashAlgorithmPrefix
+    , HashAlgorithmResumable
     -- * Hash algorithms
     , Blake2s_160(..)
     , Blake2s_224(..)
@@ -55,7 +56,7 @@ module Crypto.Hash.Algorithms
     , Whirlpool(..)
     ) where
 
-import           Crypto.Hash.Types (HashAlgorithm, HashAlgorithmPrefix)
+import           Crypto.Hash.Types (HashAlgorithm, HashAlgorithmPrefix, HashAlgorithmResumable)
 import           Crypto.Hash.Blake2s
 import           Crypto.Hash.Blake2sp
 import           Crypto.Hash.Blake2b

Crypto/Hash/Keccak.hs

@@ -37,6 +37,10 @@ instance HashAlgorithm Keccak_224 where
     hashInternalUpdate        = c_keccak_update
     hashInternalFinalize p    = c_keccak_finalize p 224
 
+instance HashAlgorithmResumable Keccak_224 where
+  hashInternalPutContextBE = c_sha3_ctx_to_be
+  hashInternalGetContextBE = c_sha3_be_to_ctx
+
 -- | Keccak (256 bits) cryptographic hash algorithm
 data Keccak_256 = Keccak_256
     deriving (Show,Data)
@@ -52,6 +56,10 @@ instance HashAlgorithm Keccak_256 where
     hashInternalUpdate        = c_keccak_update
     hashInternalFinalize p    = c_keccak_finalize p 256
 
+instance HashAlgorithmResumable Keccak_256 where
+  hashInternalPutContextBE = c_sha3_ctx_to_be
+  hashInternalGetContextBE = c_sha3_be_to_ctx
+
 -- | Keccak (384 bits) cryptographic hash algorithm
 data Keccak_384 = Keccak_384
     deriving (Show,Data)
@@ -67,6 +75,10 @@ instance HashAlgorithm Keccak_384 where
     hashInternalUpdate        = c_keccak_update
     hashInternalFinalize p    = c_keccak_finalize p 384
 
+instance HashAlgorithmResumable Keccak_384 where
+  hashInternalPutContextBE = c_sha3_ctx_to_be
+  hashInternalGetContextBE = c_sha3_be_to_ctx
+
 -- | Keccak (512 bits) cryptographic hash algorithm
 data Keccak_512 = Keccak_512
     deriving (Show,Data)
@@ -82,6 +94,10 @@ instance HashAlgorithm Keccak_512 where
     hashInternalUpdate        = c_keccak_update
     hashInternalFinalize p    = c_keccak_finalize p 512
 
+instance HashAlgorithmResumable Keccak_512 where
+  hashInternalPutContextBE = c_sha3_ctx_to_be
+  hashInternalGetContextBE = c_sha3_be_to_ctx
+
 
 foreign import ccall unsafe "cryptonite_keccak_init"
     c_keccak_init :: Ptr (Context a) -> Word32 -> IO ()
@@ -91,3 +107,9 @@ foreign import ccall "cryptonite_keccak_update"
 
 foreign import ccall unsafe "cryptonite_keccak_finalize"
     c_keccak_finalize :: Ptr (Context a) -> Word32 -> Ptr (Digest a) -> IO ()
+
+foreign import ccall unsafe "cryptonite_sha3_ctx_to_be"
+    c_sha3_ctx_to_be :: Ptr (Context a) -> Ptr Word8 -> IO ()
+
+foreign import ccall unsafe "cryptonite_sha3_be_to_ctx"
+    c_sha3_be_to_ctx :: Ptr Word8 -> Ptr (Context a) -> IO ()

Crypto/Hash/SHA3.hs

@@ -37,6 +37,10 @@ instance HashAlgorithm SHA3_224 where
     hashInternalUpdate        = c_sha3_update
     hashInternalFinalize p    = c_sha3_finalize p 224
 
+instance HashAlgorithmResumable SHA3_224 where
+  hashInternalPutContextBE = c_sha3_ctx_to_be
+  hashInternalGetContextBE = c_sha3_be_to_ctx
+
 -- | SHA3 (256 bits) cryptographic hash algorithm
 data SHA3_256 = SHA3_256
     deriving (Show,Data)
@@ -52,6 +56,10 @@ instance HashAlgorithm SHA3_256 where
     hashInternalUpdate        = c_sha3_update
     hashInternalFinalize p    = c_sha3_finalize p 256
 
+instance HashAlgorithmResumable SHA3_256 where
+  hashInternalPutContextBE = c_sha3_ctx_to_be
+  hashInternalGetContextBE = c_sha3_be_to_ctx
+
 -- | SHA3 (384 bits) cryptographic hash algorithm
 data SHA3_384 = SHA3_384
     deriving (Show,Data)
@@ -67,6 +75,10 @@ instance HashAlgorithm SHA3_384 where
     hashInternalUpdate        = c_sha3_update
     hashInternalFinalize p    = c_sha3_finalize p 384
 
+instance HashAlgorithmResumable SHA3_384 where
+  hashInternalPutContextBE = c_sha3_ctx_to_be
+  hashInternalGetContextBE = c_sha3_be_to_ctx
+
 -- | SHA3 (512 bits) cryptographic hash algorithm
 data SHA3_512 = SHA3_512
     deriving (Show,Data)
@@ -82,6 +94,10 @@ instance HashAlgorithm SHA3_512 where
     hashInternalUpdate        = c_sha3_update
     hashInternalFinalize p    = c_sha3_finalize p 512
 
+instance HashAlgorithmResumable SHA3_512 where
+  hashInternalPutContextBE = c_sha3_ctx_to_be
+  hashInternalGetContextBE = c_sha3_be_to_ctx
+
 
 foreign import ccall unsafe "cryptonite_sha3_init"
     c_sha3_init :: Ptr (Context a) -> Word32 -> IO ()
@@ -91,3 +107,9 @@ foreign import ccall "cryptonite_sha3_update"
 
 foreign import ccall unsafe "cryptonite_sha3_finalize"
     c_sha3_finalize :: Ptr (Context a) -> Word32 -> Ptr (Digest a) -> IO ()
+
+foreign import ccall unsafe "cryptonite_sha3_ctx_to_be"
+    c_sha3_ctx_to_be :: Ptr (Context a) -> Ptr Word8 -> IO ()
+
+foreign import ccall unsafe "cryptonite_sha3_be_to_ctx"
+    c_sha3_be_to_ctx :: Ptr Word8 -> Ptr (Context a) -> IO ()

Crypto/Hash/SHAKE.hs

@@ -62,6 +62,10 @@ instance KnownNat bitlen => HashSHAKE (SHAKE128 bitlen) where
     cshakeInternalFinalize = cshakeFinalizeOutput (Proxy :: Proxy bitlen)
     cshakeOutputLength _ = integralNatVal (Proxy :: Proxy bitlen)
 
+instance KnownNat bitlen => HashAlgorithmResumable (SHAKE128 bitlen) where
+  hashInternalPutContextBE = c_sha3_ctx_to_be
+  hashInternalGetContextBE = c_sha3_be_to_ctx
+
 -- | SHAKE256 (256 bits) extendable output function.  Supports an arbitrary
 -- digest size, to be specified as a type parameter of kind 'Nat'.
 --
@@ -86,6 +90,10 @@ instance KnownNat bitlen => HashSHAKE (SHAKE256 bitlen) where
     cshakeInternalFinalize = cshakeFinalizeOutput (Proxy :: Proxy bitlen)
     cshakeOutputLength _ = integralNatVal (Proxy :: Proxy bitlen)
 
+instance KnownNat bitlen => HashAlgorithmResumable (SHAKE256 bitlen) where
+  hashInternalPutContextBE = c_sha3_ctx_to_be
+  hashInternalGetContextBE = c_sha3_be_to_ctx
+
 shakeFinalizeOutput :: KnownNat bitlen
                     => proxy bitlen
                     -> Ptr (Context a)
@@ -129,3 +137,9 @@ foreign import ccall unsafe "cryptonite_sha3_finalize_cshake"
 
 foreign import ccall unsafe "cryptonite_sha3_output"
     c_sha3_output :: Ptr (Context a) -> Ptr (Digest a) -> Word32 -> IO ()
+
+foreign import ccall unsafe "cryptonite_sha3_ctx_to_be"
+    c_sha3_ctx_to_be :: Ptr (Context a) -> Ptr Word8 -> IO ()
+
+foreign import ccall unsafe "cryptonite_sha3_be_to_ctx"
+    c_sha3_be_to_ctx :: Ptr Word8 -> Ptr (Context a) -> IO ()

Crypto/Hash/Types.hs

@@ -15,6 +15,7 @@
 module Crypto.Hash.Types
     ( HashAlgorithm(..)
     , HashAlgorithmPrefix(..)
+    , HashAlgorithmResumable(..)
     , Context(..)
     , Digest(..)
     ) where
@@ -70,6 +71,9 @@ class HashAlgorithm a => HashAlgorithmPrefix a where
                                -> Word32
                                -> Ptr (Digest a)
                                -> IO ()
+class HashAlgorithm a => HashAlgorithmResumable a where
+  hashInternalPutContextBE :: Ptr (Context a) -> Ptr Word8 -> IO ()
+  hashInternalGetContextBE :: Ptr Word8 -> Ptr (Context a) -> IO ()
 
 {-
 hashContextGetAlgorithm :: HashAlgorithm a => Context a -> a

cbits/cryptonite_sha3.c

@@ -121,14 +121,14 @@ void cryptonite_sha3_update(struct sha3_ctx *ctx, const uint8_t *data, uint32_t
 	to_fill = ctx->bufsz - ctx->bufindex;
 
 	if (ctx->bufindex == ctx->bufsz) {
-		sha3_do_chunk(ctx->state, (uint64_t *) ctx->buf, ctx->bufsz / 8);
+		sha3_do_chunk(ctx->state, ctx->bufwords, ctx->bufsz / 8);
 		ctx->bufindex = 0;
 	}
 
 	/* process partial buffer if there's enough data to make a block */
 	if (ctx->bufindex && len >= to_fill) {
 		memcpy(ctx->buf + ctx->bufindex, data, to_fill);
-		sha3_do_chunk(ctx->state, (uint64_t *) ctx->buf, ctx->bufsz / 8);
+		sha3_do_chunk(ctx->state, ctx->bufwords, ctx->bufsz / 8);
 		len -= to_fill;
 		data += to_fill;
 		ctx->bufindex = 0;
@@ -159,7 +159,7 @@ void cryptonite_sha3_finalize_with_pad_byte(struct sha3_ctx *ctx, uint8_t pad_by
 {
 	/* process full buffer if needed */
 	if (ctx->bufindex == ctx->bufsz) {
-		sha3_do_chunk(ctx->state, (uint64_t *) ctx->buf, ctx->bufsz / 8);
+		sha3_do_chunk(ctx->state, ctx->bufwords, ctx->bufsz / 8);
 		ctx->bufindex = 0;
 	}
 
@@ -169,7 +169,7 @@ void cryptonite_sha3_finalize_with_pad_byte(struct sha3_ctx *ctx, uint8_t pad_by
 	ctx->buf[ctx->bufsz - 1] |= 0x80;
 
 	/* process */
-	sha3_do_chunk(ctx->state, (uint64_t *) ctx->buf, ctx->bufsz / 8);
+	sha3_do_chunk(ctx->state, ctx->bufwords, ctx->bufsz / 8);
 	ctx->bufindex = 0;
 }
 
@@ -250,3 +250,31 @@ void cryptonite_keccak_finalize(struct sha3_ctx *ctx, uint32_t hashlen, uint8_t
 	cryptonite_sha3_finalize_with_pad_byte(ctx, 1);
 	cryptonite_sha3_output(ctx, out, hashlen / 8);
 }
+
+
+void cryptonite_sha3_ctx_to_be(struct sha3_ctx *ctx, uint8_t *out)
+{
+	void *ptr = out;
+        const uint32_t bufindex_be = cpu_to_be32(ctx->bufindex);
+	memcpy(ptr, &bufindex_be, sizeof(uint32_t));
+	ptr += sizeof(uint32_t);
+        const uint32_t bufsz_be = cpu_to_be32(ctx->bufsz);
+	memcpy(ptr, &bufsz_be, sizeof(uint32_t));
+	ptr += sizeof(uint32_t);
+	cpu_to_be64_array((uint64_t *) ptr, ctx->state, 25);
+	ptr += 25 * sizeof(uint64_t);
+	cpu_to_be64_array((uint64_t *) ptr, ctx->bufwords, ctx->bufsz / sizeof(uint64_t));
+}
+
+void cryptonite_sha3_be_to_ctx(uint8_t *in, struct sha3_ctx *ctx)
+{
+  const uint32_t bufindex_cpu = be32_to_cpu(* (uint32_t *) in);
+	memcpy(&ctx->bufindex, &bufindex_cpu, sizeof(uint32_t));
+	in += sizeof(uint32_t);
+	const uint32_t bufsz_cpu = be32_to_cpu(* (uint32_t *) in);
+	memcpy(&ctx->bufsz, &bufsz_cpu, sizeof(uint32_t));
+	in += sizeof(uint32_t);
+	be64_to_cpu_array(ctx->state, (uint64_t *) in, 25);
+	in += 25 * sizeof(uint64_t);
+	be64_to_cpu_array(ctx->bufwords, (uint64_t *) in, ctx->bufsz / sizeof(uint64_t));
+}

cbits/cryptonite_sha3.h

@@ -29,9 +29,12 @@
 struct sha3_ctx
 {
 	uint32_t bufindex;
-	uint32_t bufsz;
+        uint32_t bufsz; /* size of buf, i.e. in bytes */
 	uint64_t state[25];
-	uint8_t  buf[0]; /* maximum SHAKE128 is 168 bytes, otherwise buffer can be decreased */
+        union { /* maximum SHAKE128 is 168 bytes, otherwise buffer can be decreased */
+	  uint8_t buf[0];
+	  uint64_t bufwords[0];
+	};
 };
 
 #define SHA3_CTX_SIZE		sizeof(struct sha3_ctx)
@@ -64,4 +67,7 @@ void cryptonite_keccak_init(struct sha3_ctx *ctx, uint32_t hashlen);
 void cryptonite_keccak_update(struct sha3_ctx *ctx, uint8_t *data, uint32_t len);
 void cryptonite_keccak_finalize(struct sha3_ctx *ctx, uint32_t hashlen, uint8_t *out);
 
+void cryptonite_sha3_ctx_to_be(struct sha3_ctx *ctx, uint8_t *out);
+void cryptonite_sha3_be_to_ctx(uint8_t *in, struct sha3_ctx *ctx);
+
 #endif

cryptonite.cabal

@@ -412,6 +412,7 @@ Test-Suite test-cryptonite
                      ECC.Edwards25519
                      ECDSA
                      Hash
+                     ResumableHash
                      Imports
                      KAT_AES.KATCBC
                      KAT_AES.KATECB

tests/ResumableHash.hs

@@ -0,0 +1,65 @@
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TupleSections #-}
+
+module ResumableHash (tests) where
+
+import Crypto.Hash ( SHAKE128(..), SHAKE256(..), SHA3_224(..), SHA3_256(..), SHA3_384(..), SHA3_512(..), Keccak_224(..), Keccak_256(..), Keccak_384(..), Keccak_512(..)
+                   , HashAlgorithm, HashAlgorithmResumable, Context, hashPutContext, hashGetContext)
+import qualified Crypto.Hash as Hash
+
+import qualified Data.ByteString as B
+import qualified Data.ByteString.Lazy as LB
+import qualified Data.ByteString.Builder as Builder
+
+import Data.Maybe (fromMaybe)
+
+import Imports
+
+data HashResume a = HashResume [ByteString] [ByteString] (Hash.Digest a)
+  deriving (Show, Eq)
+
+instance HashAlgorithm a => Arbitrary (HashResume a) where
+  arbitrary = do
+    (beforeChunks, afterChunks) <- oneof
+      [ ([], ) <$> (choose (1,20) >>= \n -> replicateM n (arbitraryBSof 1 99))
+      , (,) <$> (choose (1,20) >>= \n -> replicateM n (arbitraryBSof 1 99))
+            <*> (choose (1,20) >>= \n -> replicateM n (arbitraryBSof 1 99))
+      , (, []) <$> (choose (1,20) >>= \n -> replicateM n (arbitraryBSof 1 99))
+      , pure ([], [])
+      ]
+    return $ HashResume beforeChunks afterChunks (Hash.hashlazy . LB.fromChunks $ beforeChunks ++ afterChunks)
+
+resumeTests =
+    [ testResumeProperties "SHAKE128_256" (SHAKE128 :: SHAKE128 256)
+    , testResumeProperties "SHAKE256_256" (SHAKE256 :: SHAKE256 512)
+    , testResumeProperties "SHA3_224" SHA3_224
+    , testResumeProperties "SHA3_256" SHA3_256
+    , testResumeProperties "SHA3_384" SHA3_384
+    , testResumeProperties "SHA3_512" SHA3_512
+    , testResumeProperties "Keccak_224" Keccak_224
+    , testResumeProperties "Keccak_256" Keccak_256
+    , testResumeProperties "Keccak_384" Keccak_384
+    , testResumeProperties "Keccak_512" Keccak_512
+    , testCase "serializes big endian" $ test_is_be 168 (SHAKE128 :: SHAKE128 256)
+    ]
+  where
+        testResumeProperties :: HashAlgorithmResumable a => TestName -> a -> TestTree
+        testResumeProperties name a = testGroup name
+          [ testProperty "resume" (prop_resume_start a)
+          ]
+
+        prop_resume_start :: forall a. HashAlgorithmResumable a => a -> HashResume a -> Bool
+        prop_resume_start _ (HashResume beforeChunks afterChunks result) = fromMaybe False $ do
+          let beforeCtx = Hash.hashUpdates (Hash.hashInit :: Context a) beforeChunks
+          ctx <- hashGetContext (hashPutContext beforeCtx :: ByteString)
+          let afterCtx = Hash.hashUpdates ctx afterChunks
+          return $ result `assertEq` Hash.hashFinalize afterCtx
+
+        test_is_be :: forall a. HashAlgorithmResumable a => Word32 -> a -> Assertion
+        test_is_be size _ = slice @=? size_be
+          where size_be = LB.toStrict $ Builder.toLazyByteString $ Builder.word32BE size
+                serialized = hashPutContext (Hash.hashInit :: Context a) :: ByteString
+                slice = B.take 4 $ B.drop 4 serialized
+
+tests = testGroup "ResumableHash" resumeTests

tests/Tests.hs

@@ -13,6 +13,7 @@ import qualified ECC
 import qualified ECC.Edwards25519
 import qualified ECDSA
 import qualified Hash
+import qualified ResumableHash
 import qualified Poly1305
 import qualified Salsa
 import qualified XSalsa
@@ -54,6 +55,7 @@ tests = testGroup "cryptonite"
     , Number.tests
     , Number.F2m.tests
     , Hash.tests
+    , ResumableHash.tests
     , Padding.tests
     , testGroup "ConstructHash"
         [ KAT_MiyaguchiPreneel.tests