diff --git a/changelog.md b/changelog.md --- a/changelog.md +++ b/changelog.md @@ -1,3 +1,10 @@ +## 0.11.102.0 + + - Add Eq instance for Ctx + - Add start and startlazy producing Ctx + - Introduce new `use-cbits` cabal flag in order to + add support for FFI-less `cryptohash-sha256-pure` pass-thru + ## 0.11.101.0 - Add `hkdf` function providing HKDF-SHA256 conforming to RFC5869 diff --git a/cryptohash-sha256.cabal b/cryptohash-sha256.cabal --- a/cryptohash-sha256.cabal +++ b/cryptohash-sha256.cabal @@ -1,6 +1,6 @@ -cabal-version: 1.12 +cabal-version: 2.0 name: cryptohash-sha256 -version: 0.11.101.0 +version: 0.11.102.0 synopsis: Fast, pure and practical SHA-256 implementation description: { @@ -53,7 +53,11 @@ , GHC == 7.8.4 , GHC == 7.10.3 , GHC == 8.0.2 - , GHC == 8.2.1 + , GHC == 8.2.2 + , GHC == 8.4.4 + , GHC == 8.6.5 + , GHC == 8.8.3 + , GHC == 8.10.1 extra-source-files: cbits/hs_sha256.h changelog.md @@ -67,35 +71,49 @@ manual: True default: False +flag use-cbits + description: Use fast optimized C routines via FFI; if flag is disabled falls back to non-FFI Haskell optimized implementation. + manual: True + default: True + library default-language: Haskell2010 - other-extensions: BangPatterns - CApiFFI - Trustworthy - Unsafe - build-depends: base >= 4.5 && < 4.11 - , bytestring >= 0.9.2 && < 0.11 - ghc-options: -Wall - hs-source-dirs: src + build-depends: base >= 4.5 && < 4.15 + exposed-modules: Crypto.Hash.SHA256 - other-modules: Crypto.Hash.SHA256.FFI - include-dirs: cbits + if flag(use-cbits) + build-depends: bytestring ^>= 0.9.2 || ^>= 0.10.0 || ^>= 0.11.0 + + other-extensions: BangPatterns + CApiFFI + CPP + Trustworthy + Unsafe + + hs-source-dirs: src + other-modules: Crypto.Hash.SHA256.FFI + Compat + include-dirs: cbits + else + hs-source-dirs: src-pure + build-depends: cryptohash-sha256-pure ^>= 0.1.0 + executable sha256sum + default-language: Haskell2010 hs-source-dirs: src-exe main-is: sha256sum.hs ghc-options: -Wall -threaded if flag(exe) - default-language: Haskell2010 other-extensions: RecordWildCards build-depends: cryptohash-sha256 , base , bytestring - , base16-bytestring >= 0.1.1 && < 0.2 + , base16-bytestring ^>= 0.1.1 || ^>= 1.0.0 else buildable: False @@ -110,11 +128,11 @@ , base , bytestring - , base16-bytestring >= 0.1.1 && < 0.2 - , SHA >= 1.6.4 && < 1.7 - , tasty == 0.11.* - , tasty-quickcheck == 0.8.* - , tasty-hunit == 0.9.* + , base16-bytestring ^>= 0.1.1 || ^>= 1.0.0 + , SHA ^>= 1.6.4 + , tasty ^>= 1.1 + , tasty-quickcheck ^>= 0.10 + , tasty-hunit ^>= 0.10 benchmark bench-sha256 default-language: Haskell2010 @@ -123,6 +141,8 @@ main-is: bench-sha256.hs hs-source-dirs: src-bench build-depends: cryptohash-sha256 + , cryptohash-sha256-pure ^>= 0.1.0 + , SHA ^>= 1.6.4 , base , bytestring - , criterion == 1.1.* + , criterion ^>= 1.5 diff --git a/src-bench/bench-sha256.hs b/src-bench/bench-sha256.hs --- a/src-bench/bench-sha256.hs +++ b/src-bench/bench-sha256.hs @@ -1,36 +1,82 @@ {-# LANGUAGE BangPatterns #-} +{-# LANGUAGE PackageImports #-} import Criterion.Main -import qualified Crypto.Hash.SHA256 as SHA256 + +import qualified "cryptohash-sha256" Crypto.Hash.SHA256 as IUT +import qualified "cryptohash-sha256-pure" Crypto.Hash.SHA256.Legacy as Pure +import qualified Data.Digest.Pure.SHA as REF + import qualified Data.ByteString as B import qualified Data.ByteString.Lazy as L -benchSize :: Int -> Benchmark -benchSize sz = bs `seq` bench msg (whnf SHA256.hash bs) +benchSize'IUT :: Int -> Benchmark +benchSize'IUT sz = bs `seq` bench msg (whnf IUT.hash bs) where bs = B.replicate sz 0 msg = "bs-" ++ show sz +benchSize'Pure :: Int -> Benchmark +benchSize'Pure sz = bs `seq` bench msg (whnf Pure.hash bs) + where + bs = B.replicate sz 0 + msg = "bs-" ++ show sz + +benchSize'REF :: Int -> Benchmark +benchSize'REF sz = bs `seq` bench msg (whnf REF.sha256 bs) + where + bs = L.fromStrict (B.replicate sz 0) + msg = "bs-" ++ show sz + + main :: IO () main = do let !lbs64x256 = L.fromChunks $ replicate 4 (B.replicate 64 0) !lbs64x4096 = L.fromChunks $ replicate 64 (B.replicate 64 0) defaultMain [ bgroup "cryptohash-sha256" - [ benchSize 0 - , benchSize 8 - , benchSize 32 - , benchSize 64 - , benchSize 128 - , benchSize 256 - , benchSize 1024 - , benchSize 4096 - , benchSize (128*1024) - , benchSize (1024*1024) - , benchSize (2*1024*1024) - , benchSize (4*1024*1024) + [ benchSize'IUT 0 + , benchSize'IUT 32 + , benchSize'IUT 64 + , benchSize'IUT 128 + , benchSize'IUT 1024 + , benchSize'IUT 4096 + , benchSize'IUT (32*1024) + , benchSize'IUT (128*1024) + , benchSize'IUT (1024*1024) + , benchSize'IUT (2*1024*1024) + , benchSize'IUT (4*1024*1024) - , L.length lbs64x256 `seq` bench "lbs64x256" (whnf SHA256.hashlazy lbs64x256) - , L.length lbs64x4096 `seq` bench "lbs64x4096" (whnf SHA256.hashlazy lbs64x4096) + , L.length lbs64x256 `seq` bench "lbs64x256" (whnf IUT.hashlazy lbs64x256) + , L.length lbs64x4096 `seq` bench "lbs64x4096" (whnf IUT.hashlazy lbs64x4096) + ] + , bgroup "cryptohash-sha256-pure" + [ benchSize'Pure 0 + , benchSize'Pure 32 + , benchSize'Pure 64 + , benchSize'Pure 128 + , benchSize'Pure 1024 + , benchSize'Pure 4096 + , benchSize'Pure (32*1024) + , benchSize'Pure (128*1024) + , benchSize'Pure (1024*1024) + , benchSize'Pure (2*1024*1024) + , benchSize'Pure (4*1024*1024) + + , L.length lbs64x256 `seq` bench "lbs64x256" (whnf Pure.hashlazy lbs64x256) + , L.length lbs64x4096 `seq` bench "lbs64x4096" (whnf Pure.hashlazy lbs64x4096) + ] + , bgroup "SHA" + [ benchSize'REF 0 + , benchSize'REF 32 + , benchSize'REF 64 + , benchSize'REF 128 + , benchSize'REF 1024 + , benchSize'REF 4096 + , benchSize'REF (32*1024) + , benchSize'REF (128*1024) + , benchSize'REF (1024*1024) + , benchSize'REF (2*1024*1024) + , benchSize'REF (4*1024*1024) ] ] diff --git a/src-pure/Crypto/Hash/SHA256.hs b/src-pure/Crypto/Hash/SHA256.hs new file mode 100644 --- /dev/null +++ b/src-pure/Crypto/Hash/SHA256.hs @@ -0,0 +1,93 @@ +{-# LANGUAGE BangPatterns #-} +{-# LANGUAGE Trustworthy #-} + +-- | +-- Module : Crypto.Hash.SHA256 +-- License : BSD-3 +-- Maintainer : Herbert Valerio Riedel +-- Stability : stable +-- +-- A module containing bindings +-- +module Crypto.Hash.SHA256 + ( + + -- * Incremental API + -- + -- | This API is based on 4 different functions, similar to the + -- lowlevel operations of a typical hash: + -- + -- - 'init': create a new hash context + -- - 'update': update non-destructively a new hash context with a strict bytestring + -- - 'updates': same as update, except that it takes a list of strict bytestrings + -- - 'finalize': finalize the context and returns a digest bytestring. + -- + -- all those operations are completely pure, and instead of + -- changing the context as usual in others language, it + -- re-allocates a new context each time. + -- + -- Example: + -- + -- > import qualified Data.ByteString + -- > import qualified Crypto.Hash.SHA256 as SHA256 + -- > + -- > main = print digest + -- > where + -- > digest = SHA256.finalize ctx + -- > ctx = foldl SHA256.update ctx0 (map Data.ByteString.pack [ [1,2,3], [4,5,6] ]) + -- > ctx0 = SHA256.init + + Ctx(..) + , init -- :: Ctx + , update -- :: Ctx -> ByteString -> Ctx + , updates -- :: Ctx -> [ByteString] -> Ctx + , finalize -- :: Ctx -> ByteString + , finalizeAndLength -- :: Ctx -> (ByteString,Word64) + , start -- :: ByteString -> Ct + , startlazy -- :: L.ByteString -> Ctx + + -- * Single Pass API + -- + -- | This API use the incremental API under the hood to provide + -- the common all-in-one operations to create digests out of a + -- 'ByteString' and lazy 'L.ByteString'. + -- + -- - 'hash': create a digest ('init' + 'update' + 'finalize') from a strict 'ByteString' + -- - 'hashlazy': create a digest ('init' + 'update' + 'finalize') from a lazy 'L.ByteString' + -- - 'hashlazyAndLength': create a digest ('init' + 'update' + 'finalizeAndLength') from a lazy 'L.ByteString' + -- + -- Example: + -- + -- > import qualified Data.ByteString + -- > import qualified Crypto.Hash.SHA256 as SHA256 + -- > + -- > main = print $ SHA256.hash (Data.ByteString.pack [0..255]) + -- + -- __NOTE__: The returned digest is a binary 'ByteString'. For + -- converting to a base16/hex encoded digest the + -- + -- package is recommended. + + , hash -- :: ByteString -> ByteString + , hashlazy -- :: L.ByteString -> ByteString + , hashlazyAndLength -- :: L.ByteString -> (ByteString,Int64) + + -- ** HMAC-SHA-256 + -- + -- | -compatible + -- -SHA-256 digests + + , hmac -- :: ByteString -> ByteString -> ByteString + , hmaclazy -- :: ByteString -> L.ByteString -> ByteString + , hmaclazyAndLength -- :: ByteString -> L.ByteString -> (ByteString,Word64) + + -- ** HKDF-SHA-256 + -- + -- | -compatible + -- -SHA-256 key derivation function + + , hkdf + ) where + +import Prelude () +import Crypto.Hash.SHA256.Legacy diff --git a/src-tests/test-sha256.hs b/src-tests/test-sha256.hs --- a/src-tests/test-sha256.hs +++ b/src-tests/test-sha256.hs @@ -1,10 +1,14 @@ {-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE FlexibleInstances #-} module Main (main) where import Data.ByteString (ByteString) import qualified Data.ByteString as B import qualified Data.ByteString.Base16 as B16 +-- before bytestring-0.10 instance IsString ByteString +-- was imported only from Char8 module +import Data.ByteString.Char8 () import qualified Data.ByteString.Lazy as BL import Data.Word @@ -46,11 +50,12 @@ katTests :: [TestTree] katTests - | length vectors == length answers = map makeTest (zip3 [1::Int ..] vectors answers) ++ [xltest] + | length vectors == length answers = map makeTest (zip3 [1::Int ..] vectors answers) ++ [xltest, xltest'] | otherwise = error "vectors/answers length mismatch" where makeTest (i, v, r) = testGroup ("vec"++show i) $ [ testCase "one-pass" (r @=? runTest v) + , testCase "one-pass'" (r @=? runTest' v) , testCase "inc-1" (r @=? runTestInc 1 v) , testCase "inc-2" (r @=? runTestInc 2 v) , testCase "inc-3" (r @=? runTestInc 3 v) @@ -65,25 +70,43 @@ , testCase "lazy-7" (r @=? runTestLazy 7 v) , testCase "lazy-8" (r @=? runTestLazy 8 v) , testCase "lazy-16" (r @=? runTestLazy 16 v) + , testCase "lazy-1'" (r @=? runTestLazy' 1 v) + , testCase "lazy-2'" (r @=? runTestLazy' 2 v) + , testCase "lazy-7'" (r @=? runTestLazy' 7 v) + , testCase "lazy-8'" (r @=? runTestLazy' 8 v) + , testCase "lazy-16'" (r @=? runTestLazy' 16 v) ] ++ [ testCase "lazy-63u" (r @=? runTestLazyU 63 v) | B.length v > 63 ] ++ [ testCase "lazy-65u" (r @=? runTestLazyU 65 v) | B.length v > 65 ] ++ [ testCase "lazy-97u" (r @=? runTestLazyU 97 v) | B.length v > 97 ] ++ - [ testCase "lazy-131u" (r @=? runTestLazyU 131 v) | B.length v > 131 ] + [ testCase "lazy-131u" (r @=? runTestLazyU 131 v) | B.length v > 131] ++ + [ testCase "lazy-63u'" (r @=? runTestLazyU' 63 v) | B.length v > 63 ] ++ + [ testCase "lazy-65u'" (r @=? runTestLazyU' 65 v) | B.length v > 65 ] ++ + [ testCase "lazy-97u'" (r @=? runTestLazyU' 97 v) | B.length v > 97 ] ++ + [ testCase "lazy-131u'" (r @=? runTestLazyU' 131 v) | B.length v > 131 ] runTest :: ByteString -> ByteString runTest = B16.encode . IUT.hash + runTest' :: ByteString -> ByteString + runTest' = B16.encode . IUT.finalize . IUT.start + runTestInc :: Int -> ByteString -> ByteString runTestInc i = B16.encode . IUT.finalize . myfoldl' IUT.update IUT.init . splitB i runTestLazy :: Int -> ByteString -> ByteString runTestLazy i = B16.encode . IUT.hashlazy . BL.fromChunks . splitB i + runTestLazy' :: Int -> ByteString -> ByteString + runTestLazy' i = B16.encode . IUT.finalize . IUT.startlazy . BL.fromChunks . splitB i + -- force unaligned md5-blocks runTestLazyU :: Int -> ByteString -> ByteString runTestLazyU i = B16.encode . IUT.hashlazy . BL.fromChunks . map B.copy . splitB i + runTestLazyU' :: Int -> ByteString -> ByteString + runTestLazyU' i = B16.encode . IUT.finalize . IUT.startlazy . BL.fromChunks . map B.copy . splitB i + ---- xltest = testGroup "XL-vec" @@ -91,6 +114,11 @@ where vecXL = BL.fromChunks (replicate 16777216 "abcdefghbcdefghicdefghijdefghijkefghijklfghijklmghijklmnhijklmno") + xltest' = testGroup "XL-vec'" + [ testCase "inc'" (ansXLTest @=? (B16.encode . IUT.finalize . IUT.startlazy) vecXL) ] + where + vecXL = BL.fromChunks (replicate 16777216 "abcdefghbcdefghicdefghijdefghijkefghijklfghijklmghijklmnhijklmno") + splitB :: Int -> ByteString -> [ByteString] splitB l b | B.length b > l = b1 : splitB l b2 @@ -98,7 +126,15 @@ where (b1, b2) = B.splitAt l b +-- Minor hack to paper over backward incompat changes introduced in base16-bytestring-1.0 +class B16DecRes a where b16DecRes :: a -> ByteString +instance B16DecRes (Either String ByteString) where b16DecRes = either error id +instance B16DecRes (ByteString, ByteString) where b16DecRes = fst +b16decode :: ByteString -> ByteString +b16decode = b16DecRes . B16.decode + + rfc4231Vectors :: [(ByteString,ByteString,ByteString)] rfc4231Vectors = -- (secrect,msg,mac) [ (rep 20 0x0b, "Hi There", x"b0344c61d8db38535ca8afceaf0bf12b881dc200c9833da726e9376c2e32cff7") @@ -110,7 +146,7 @@ , (rep 131 0xaa, "This is a test using a larger than block-size key and a larger than block-size data. The key needs to be hashed before being used by the HMAC algorithm.", x"9b09ffa71b942fcb27635fbcd5b0e944bfdc63644f0713938a7f51535c3a35e2") ] where - x = fst.B16.decode + x = b16decode rep n c = B.replicate n c rfc4231Tests :: [TestTree] @@ -137,7 +173,7 @@ , ( 42, rep 22 0x0b, "", "", x"8da4e775a563c18f715f802a063c5a31b8a11f5c5ee1879ec3454e5f3c738d2d9d201395faa4b61a96c8") ] where - x = fst.B16.decode + x = b16decode rep n c = B.replicate n c rfc5869Tests :: [TestTree] @@ -178,7 +214,9 @@ refImplTests :: [TestTree] refImplTests = [ testProperty "hash" prop_hash + , testProperty "start" prop_start , testProperty "hashlazy" prop_hashlazy + , testProperty "startlazy" prop_startlazy , testProperty "hashlazyAndLength" prop_hashlazyAndLength , testProperty "hmac" prop_hmac , testProperty "hmaclazy" prop_hmaclazy @@ -188,8 +226,14 @@ prop_hash (RandBS bs) = ref_hash bs == IUT.hash bs + prop_start (RandBS bs) + = ref_hash bs == (IUT.finalize $ IUT.start bs) + prop_hashlazy (RandLBS bs) = ref_hashlazy bs == IUT.hashlazy bs + + prop_startlazy (RandLBS bs) + = ref_hashlazy bs == (IUT.finalize $ IUT.startlazy bs) prop_hashlazyAndLength (RandLBS bs) = ref_hashlazyAndLength bs == IUT.hashlazyAndLength bs diff --git a/src/Compat.hs b/src/Compat.hs new file mode 100644 --- /dev/null +++ b/src/Compat.hs @@ -0,0 +1,24 @@ +{-# LANGUAGE CPP #-} +{-# LANGUAGE Trustworthy #-} + +-- | +-- Module : Compat +-- License : BSD-3 +-- Maintainer : Herbert Valerio Riedel +-- Stability : stable +-- +-- Compat layer to reduce code exposure to CPP to a bare minimum +-- +module Compat (constructBS) where + +import Foreign.ForeignPtr (ForeignPtr) +import Data.Word (Word8) +import Data.ByteString.Internal (ByteString (..)) + +-- | Directly construct a 'ByteString', unsafely +constructBS :: ForeignPtr Word8 -> Int -> ByteString +#if MIN_VERSION_bytestring(0,11,0) +constructBS = BS +#else +constructBS = \fp -> PS fp 0 +#endif diff --git a/src/Crypto/Hash/SHA256.hs b/src/Crypto/Hash/SHA256.hs --- a/src/Crypto/Hash/SHA256.hs +++ b/src/Crypto/Hash/SHA256.hs @@ -43,6 +43,8 @@ , updates -- :: Ctx -> [ByteString] -> Ctx , finalize -- :: Ctx -> ByteString , finalizeAndLength -- :: Ctx -> (ByteString,Word64) + , start -- :: ByteString -> Ct + , startlazy -- :: L.ByteString -> Ctx -- * Single Pass API -- @@ -90,7 +92,7 @@ import Data.Bits (xor) import Data.ByteString (ByteString) import qualified Data.ByteString as B -import Data.ByteString.Internal (ByteString (PS), create, +import Data.ByteString.Internal (create, createAndTrim, mallocByteString, memcpy, toForeignPtr) import qualified Data.ByteString.Lazy as L @@ -103,6 +105,7 @@ import Prelude hiding (init) import System.IO.Unsafe (unsafeDupablePerformIO) +import Compat (constructBS) import Crypto.Hash.SHA256.FFI -- | perform IO for hashes that do allocation and ffi. @@ -134,7 +137,7 @@ create' l f = do fp <- mallocByteString l x <- withForeignPtr fp $ \p -> f p - let bs = PS fp 0 l + let bs = constructBS fp l return $! x `seq` bs `seq` (bs,x) copyCtx :: Ptr Ctx -> Ptr Ctx -> IO () @@ -228,11 +231,23 @@ -- hash d = unsafeDoIO $ withCtxNewThrow $ \ptr -> c_sha256_init ptr >> updateInternalIO ptr d >> finalizeInternalIO ptr hash d = unsafeDoIO $ unsafeUseAsCStringLen d $ \(cs, len) -> create digestSize (c_sha256_hash (castPtr cs) (fromIntegral len)) +{-# NOINLINE start #-} +-- | hash a strict bytestring into a Ctx +start :: ByteString -> Ctx +start d = unsafeDoIO $ withCtxNew $ \ptr -> c_sha256_init ptr >> updateInternalIO ptr d + + {-# NOINLINE hashlazy #-} -- | hash a lazy bytestring into a digest bytestring (32 bytes) hashlazy :: L.ByteString -> ByteString hashlazy l = unsafeDoIO $ withCtxNewThrow $ \ptr -> c_sha256_init ptr >> mapM_ (updateInternalIO ptr) (L.toChunks l) >> finalizeInternalIO ptr + +{-# NOINLINE startlazy #-} +-- | hash a lazy bytestring into a Ctx +startlazy :: L.ByteString -> Ctx +startlazy l = unsafeDoIO $ withCtxNew $ \ptr -> + c_sha256_init ptr >> mapM_ (updateInternalIO ptr) (L.toChunks l) {-# NOINLINE hashlazyAndLength #-} -- | Variant of 'hashlazy' which simultaneously computes the hash and length of a lazy bytestring. diff --git a/src/Crypto/Hash/SHA256/FFI.hs b/src/Crypto/Hash/SHA256/FFI.hs --- a/src/Crypto/Hash/SHA256/FFI.hs +++ b/src/Crypto/Hash/SHA256/FFI.hs @@ -38,6 +38,7 @@ -- -- Consequently, a SHA-256 digest as produced by 'hash', 'hashlazy', or 'finalize' is 32 bytes long. newtype Ctx = Ctx ByteString + deriving (Eq) foreign import capi unsafe "hs_sha256.h hs_cryptohash_sha256_init" c_sha256_init :: Ptr Ctx -> IO ()