Merge pull request #257 from ocheron/hash-shake-truncate

SHAKE with output length not divisible by 8

.haskell-ci

@@ -1,20 +1,20 @@
 # compiler supported and their equivalent LTS
 compiler: ghc-8.0 lts-9.21
-compiler: ghc-8.2 lts-11.6
-compiler: ghc-8.4 ghc-8.4.2
+compiler: ghc-8.2 lts-11.22
+compiler: ghc-8.4 lts-12.15
+compiler: ghc-8.6 nightly-2018-10-21
 
 # options
 # option: alias x=y z=v
-option: testdeps extradep=QuickCheck-2.11.3 extradep=ansi-terminal-0.8.0.1 extradep=async-2.1.1.1 extradep=call-stack-0.1.0 extradep=clock-0.7.2 extradep=optparse-applicative-0.14.0.0 extradep=random-1.1 extradep=tagged-0.8.5 extradep=unbounded-delays-0.1.1.0 extradep=tasty-1.0.0.1 extradep=tasty-hunit-0.10.0.1 extradep=tasty-kat-0.0.3 extradep=tasty-quickcheck-0.9.2 extradep=ansi-wl-pprint-0.6.8.2 extradep=colour-2.3.4 extradep=tf-random-0.5 extradep=transformers-compat-0.5.1.4 extradep=primitive-0.6.3.0 allow-newer
 option: gaugedeps extradep=gauge-0.2.1
-
 option: basementmin extradep=basement-0.0.6 extradep=foundation-0.0.19 extradep=memory-0.14.14
 
 # builds
-build: ghc-8.2 basementmin gaugedeps
+build: ghc-8.2
 build: ghc-8.0 basementmin gaugedeps
 build: ghc-8.0 basementmin gaugedeps os=osx
-build: ghc-8.4 basementmin testdeps gaugedeps extradep=vector-0.12.0.1
+build: ghc-8.4
+build: ghc-8.6
 
 # packages
 package: '.'

.travis.yml

@@ -1,4 +1,4 @@
-# ~*~ auto-generated by haskell-ci with config : 7d7fe90696706f37292f4d718fa1a63b938490d653e3abf049623087b2e6e901 ~*~
+# ~*~ auto-generated by haskell-ci with config : c5de1915986b17c62e2a4cbe1fb7b3d47a6b1dc45a8f4d4fa78654695dfd1f43 ~*~
 
 # Use new container infrastructure to enable caching
 sudo: false
@@ -16,6 +16,7 @@ matrix:
   - { env: BUILD=stack RESOLVER=ghc-8.0, compiler: ghc-8.0, language: generic, addons: { apt: { packages: [ libgmp-dev ] } } }
   - { env: BUILD=stack RESOLVER=ghc-8.0, compiler: ghc-8.0, language: generic, addons: { apt: { packages: [ libgmp-dev ] } }, os: osx }
   - { env: BUILD=stack RESOLVER=ghc-8.4, compiler: ghc-8.4, language: generic, addons: { apt: { packages: [ libgmp-dev ] } } }
+  - { env: BUILD=stack RESOLVER=ghc-8.6, compiler: ghc-8.6, language: generic, addons: { apt: { packages: [ libgmp-dev ] } } }
   - { env: BUILD=hlint, compiler: hlint, language: generic }
   - { env: BUILD=weeder, compiler: weeder, language: generic, addons: { apt: { packages: [ libgmp-dev ] } } }
   allow_failures:
@@ -48,7 +49,7 @@ script:
       # create the build stack.yaml
       case "$RESOLVER" in
       ghc-8.2)
-        echo "{ resolver: lts-11.6, packages: [ '.' ], extra-deps: [ basement-0.0.6, foundation-0.0.19, memory-0.14.14, gauge-0.2.1 ], flags: {} }" > stack.yaml
+        echo "{ resolver: lts-11.22, packages: [ '.' ], extra-deps: [], flags: {} }" > stack.yaml
         stack --no-terminal build --install-ghc --coverage --test --bench --no-run-benchmarks --haddock --no-haddock-deps
         ;;
       ghc-8.0)
@@ -60,7 +61,11 @@ script:
         stack --no-terminal build --install-ghc --coverage --test --bench --no-run-benchmarks --haddock --no-haddock-deps
         ;;
       ghc-8.4)
-        echo "{ resolver: ghc-8.4.2, packages: [ '.' ], extra-deps: [ vector-0.12.0.1, basement-0.0.6, foundation-0.0.19, memory-0.14.14, QuickCheck-2.11.3, ansi-terminal-0.8.0.1, async-2.1.1.1, call-stack-0.1.0, clock-0.7.2, optparse-applicative-0.14.0.0, random-1.1, tagged-0.8.5, unbounded-delays-0.1.1.0, tasty-1.0.0.1, tasty-hunit-0.10.0.1, tasty-kat-0.0.3, tasty-quickcheck-0.9.2, ansi-wl-pprint-0.6.8.2, colour-2.3.4, tf-random-0.5, transformers-compat-0.5.1.4, primitive-0.6.3.0, gauge-0.2.1 ], flags: {}, allow-newer: true }" > stack.yaml
+        echo "{ resolver: lts-12.15, packages: [ '.' ], extra-deps: [], flags: {} }" > stack.yaml
+        stack --no-terminal build --install-ghc --coverage --test --bench --no-run-benchmarks --haddock --no-haddock-deps
+        ;;
+      ghc-8.6)
+        echo "{ resolver: nightly-2018-10-21, packages: [ '.' ], extra-deps: [], flags: {} }" > stack.yaml
         stack --no-terminal build --install-ghc --coverage --test --bench --no-run-benchmarks --haddock --no-haddock-deps
         ;;
       esac
@@ -75,4 +80,3 @@ script:
   esac
   set +ex
 
-

Crypto/Hash/SHAKE.hs

@@ -12,7 +12,6 @@
 {-# LANGUAGE DeriveDataTypeable #-}
 {-# LANGUAGE KindSignatures #-}
 {-# LANGUAGE DataKinds #-}
-{-# LANGUAGE ConstraintKinds #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE TypeOperators #-}
 {-# LANGUAGE TypeFamilies #-}
@@ -21,28 +20,31 @@ module Crypto.Hash.SHAKE
     (  SHAKE128 (..), SHAKE256 (..)
     ) where
 
+import           Control.Monad (when)
 import           Crypto.Hash.Types
-import           Foreign.Ptr (Ptr)
+import           Foreign.Ptr (Ptr, castPtr)
+import           Foreign.Storable (Storable(..))
+import           Data.Bits
+import           Data.Data
 import           Data.Typeable
 import           Data.Word (Word8, Word32)
 
 import           Data.Proxy (Proxy(..))
-import           GHC.TypeLits (Nat, KnownNat, natVal)
+import           GHC.TypeLits (Nat, KnownNat, type (+))
 import           Crypto.Internal.Nat
 
 -- | SHAKE128 (128 bits) extendable output function.  Supports an arbitrary
--- digest size (multiple of 8 bits), to be specified as a type parameter
--- of kind 'Nat'.
+-- digest size, to be specified as a type parameter of kind 'Nat'.
 --
 -- Note: outputs from @'SHAKE128' n@ and @'SHAKE128' m@ for the same input are
 -- correlated (one being a prefix of the other).  Results are unrelated to
 -- 'SHAKE256' results.
 data SHAKE128 (bitlen :: Nat) = SHAKE128
-    deriving (Show, Typeable)
+    deriving (Show, Data, Typeable)
 
-instance (IsDivisibleBy8 bitlen, KnownNat bitlen) => HashAlgorithm (SHAKE128 bitlen) where
+instance KnownNat bitlen => HashAlgorithm (SHAKE128 bitlen) where
     type HashBlockSize           (SHAKE128 bitlen)  = 168
-    type HashDigestSize          (SHAKE128 bitlen) = Div8 bitlen
+    type HashDigestSize          (SHAKE128 bitlen) = Div8 (bitlen + 7)
     type HashInternalContextSize (SHAKE128 bitlen) = 376
     hashBlockSize  _          = 168
     hashDigestSize _          = byteLen (Proxy :: Proxy bitlen)
@@ -52,18 +54,17 @@ instance (IsDivisibleBy8 bitlen, KnownNat bitlen) => HashAlgorithm (SHAKE128 bit
     hashInternalFinalize      = shakeFinalizeOutput (Proxy :: Proxy bitlen)
 
 -- | SHAKE256 (256 bits) extendable output function.  Supports an arbitrary
--- digest size (multiple of 8 bits), to be specified as a type parameter
--- of kind 'Nat'.
+-- digest size, to be specified as a type parameter of kind 'Nat'.
 --
 -- Note: outputs from @'SHAKE256' n@ and @'SHAKE256' m@ for the same input are
 -- correlated (one being a prefix of the other).  Results are unrelated to
 -- 'SHAKE128' results.
 data SHAKE256 (bitlen :: Nat) = SHAKE256
-    deriving (Show, Typeable)
+    deriving (Show, Data, Typeable)
 
-instance (IsDivisibleBy8 bitlen, KnownNat bitlen) => HashAlgorithm (SHAKE256 bitlen) where
+instance KnownNat bitlen => HashAlgorithm (SHAKE256 bitlen) where
     type HashBlockSize           (SHAKE256 bitlen) = 136
-    type HashDigestSize          (SHAKE256 bitlen) = Div8 bitlen
+    type HashDigestSize          (SHAKE256 bitlen) = Div8 (bitlen + 7)
     type HashInternalContextSize (SHAKE256 bitlen) = 344
     hashBlockSize  _          = 136
     hashDigestSize _          = byteLen (Proxy :: Proxy bitlen)
@@ -72,7 +73,7 @@ instance (IsDivisibleBy8 bitlen, KnownNat bitlen) => HashAlgorithm (SHAKE256 bit
     hashInternalUpdate        = c_sha3_update
     hashInternalFinalize      = shakeFinalizeOutput (Proxy :: Proxy bitlen)
 
-shakeFinalizeOutput :: (IsDivisibleBy8 bitlen, KnownNat bitlen)
+shakeFinalizeOutput :: KnownNat bitlen
                     => proxy bitlen
                     -> Ptr (Context a)
                     -> Ptr (Digest a)
@@ -80,6 +81,16 @@ shakeFinalizeOutput :: (IsDivisibleBy8 bitlen, KnownNat bitlen)
 shakeFinalizeOutput d ctx dig = do
     c_sha3_finalize_shake 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
+        byte <- peekElemOff ptr index
+        pokeElemOff ptr index (byte .&. mask)
+  where
+    mask = (1 `shiftL` bits) - 1
+    (index, bits) = integralNatVal d `divMod` 8
 
 foreign import ccall unsafe "cryptonite_sha3_init"
     c_sha3_init :: Ptr (Context a) -> Word32 -> IO ()

Crypto/Internal/Nat.hs

@@ -15,8 +15,8 @@ module Crypto.Internal.Nat
 
 import           GHC.TypeLits
 
-byteLen :: (KnownNat bitlen, IsDivisibleBy8 bitlen, Num a) => proxy bitlen -> a
-byteLen d = fromInteger (natVal d `div` 8)
+byteLen :: (KnownNat bitlen, Num a) => proxy bitlen -> a
+byteLen d = fromInteger ((natVal d + 7) `div` 8)
 
 integralNatVal :: (KnownNat bitlen, Num a) => proxy bitlen -> a
 integralNatVal = fromInteger . natVal

cryptonite.cabal

@@ -36,7 +36,7 @@ Build-Type:          Simple
 Homepage:            https://github.com/haskell-crypto/cryptonite
 Bug-reports:         https://github.com/haskell-crypto/cryptonite/issues
 Cabal-Version:       >=1.18
-tested-with:         GHC==8.4.2, GHC==8.2.2, GHC==8.0.2
+tested-with:         GHC==8.6.1, GHC==8.4.4, GHC==8.2.2, GHC==8.0.2
 extra-doc-files:     README.md CHANGELOG.md
 extra-source-files:  cbits/*.h
                      cbits/aes/*.h

stack.yaml

@@ -0,0 +1,3 @@
+# ~*~ auto-generated by haskell-ci with config : c5de1915986b17c62e2a4cbe1fb7b3d47a6b1dc45a8f4d4fa78654695dfd1f43 ~*~
+{ resolver: lts-12.15, packages: [ '.' ], extra-deps: [], flags: {} }
+

tests/Hash.hs

@@ -1,5 +1,4 @@
 {-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE ViewPatterns #-}
 {-# LANGUAGE ExistentialQuantification #-}
 {-# LANGUAGE DataKinds #-}
 module Hash
@@ -9,7 +8,9 @@ module Hash
 import Crypto.Hash
 
 import qualified Data.ByteString as B
+import           Data.ByteArray (convert)
 import qualified Data.ByteArray.Encoding as B (convertToBase, Base(..))
+import           GHC.TypeLits
 import Imports
 
 v0,v1,v2 :: ByteString
@@ -235,7 +236,25 @@ makeTestChunk (hashName, hashAlg, _) =
         runhash hashAlg inp `propertyEq` runhashinc hashAlg (chunkS ckLen inp)
     ]
 
+-- SHAKE128 truncation example with expected byte at final position
+-- <https://csrc.nist.gov/CSRC/media/Projects/Cryptographic-Standards-and-Guidelines/documents/examples/ShakeTruncation.pdf>
+shake128TruncationBytes = [0x01, 0x03, 0x07, 0x0f, 0x0f, 0x2f, 0x6f, 0x6f]
+
+makeTestSHAKE128Truncation i byte =
+    testCase (show i) $ xof 4088 `B.snoc` byte @=? xof (4088 + i)
+  where
+    hashEmpty :: KnownNat n => proxy n -> Digest (SHAKE128 n)
+    hashEmpty _ = hash B.empty
+
+    xof n = case someNatVal n of
+                Nothing          -> error ("invalid Nat: " ++ show n)
+                Just (SomeNat p) -> convert (hashEmpty p)
+
 tests = testGroup "hash"
     [ testGroup "KATs" (map makeTestAlg expected)
     , testGroup "Chunking" (concatMap makeTestChunk expected)
+    , testGroup "Truncating"
+        [ testGroup "SHAKE128"
+            (zipWith makeTestSHAKE128Truncation [1..] shake128TruncationBytes)
+        ]
     ]