From 924d0109218f04f4a34bbfe1f5d18b75e1d9a66d Mon Sep 17 00:00:00 2001 From: Benjamin Barenblat Date: Fri, 28 Sep 2018 17:20:36 -0400 Subject: Stop using newtypes for labeled arguments MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit It’s getting messy, so switch to a parameters datatype pattern. --- btls.cabal | 1 + src/BTLS/Show.hs | 22 +++++++ src/BTLS/Types.hs | 35 ----------- src/Codec/Crypto/HKDF.hs | 89 ++++++++++++-------------- src/Data/Digest.hs | 14 ++++- src/Data/HMAC.hs | 19 +++--- tests/Codec/Crypto/HKDFTests.hs | 113 +++++++++++++++++---------------- tests/Data/HMACTests.hs | 135 +++++++++++++++++++++++++++++----------- 8 files changed, 246 insertions(+), 182 deletions(-) create mode 100644 src/BTLS/Show.hs diff --git a/btls.cabal b/btls.cabal index 0722a9c..ab14011 100644 --- a/btls.cabal +++ b/btls.cabal @@ -83,6 +83,7 @@ library , BTLS.Buffer , BTLS.CreateWithFinalizer , BTLS.Result + , BTLS.Show , BTLS.Types c-sources: cbits/btls.c -- Use special names for the BoringSSL libraries to avoid accidentally pulling diff --git a/src/BTLS/Show.hs b/src/BTLS/Show.hs new file mode 100644 index 0000000..8a6f883 --- /dev/null +++ b/src/BTLS/Show.hs @@ -0,0 +1,22 @@ +-- Copyright 2018 Google LLC +-- +-- Licensed under the Apache License, Version 2.0 (the "License"); you may not +-- use this file except in compliance with the License. You may obtain a copy of +-- the License at +-- +-- https://www.apache.org/licenses/LICENSE-2.0 +-- +-- Unless required by applicable law or agreed to in writing, software +-- distributed under the License is distributed on an "AS IS" BASIS, WITHOUT +-- WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. See the +-- License for the specific language governing permissions and limitations under +-- the License. + +module BTLS.Show where + +import Data.ByteString (ByteString) +import qualified Data.ByteString.Base16 as ByteString.Base16 +import qualified Data.ByteString.Char8 as ByteString.Char8 + +showHex :: ByteString -> String +showHex = ByteString.Char8.unpack . ByteString.Base16.encode diff --git a/src/BTLS/Types.hs b/src/BTLS/Types.hs index 6abd632..7a821f8 100644 --- a/src/BTLS/Types.hs +++ b/src/BTLS/Types.hs @@ -14,10 +14,6 @@ module BTLS.Types where -import Data.ByteString (ByteString) -import qualified Data.ByteString as ByteString -import qualified Data.ByteString.Base16 as ByteString.Base16 -import qualified Data.ByteString.Char8 as ByteString.Char8 import Foreign (Ptr, nullPtr) import Foreign.C (peekCString) import Foreign.Marshal.Unsafe (unsafeLocalState) @@ -36,34 +32,3 @@ instance Show Algorithm where show (Algorithm md) = let sn = objNID2SN (evpMDType md) in if sn == nullPtr then "" else unsafeLocalState (peekCString sn) - --- | Context or application-specific information. Equality comparisons on this --- type are variable-time. -newtype AssociatedData = AssociatedData ByteString - deriving (Eq, Ord, Show) - --- | The result of a hash operation. Equality comparisons on this type are --- variable-time. --- --- The 'Show' instance for this type displays the digest as a hexadecimal string. -newtype Digest = Digest ByteString - deriving (Eq, Ord) - -instance Show Digest where - show (Digest d) = showHex d - --- | A salt. Equality comparisons on this type are variable-time. -newtype Salt = Salt ByteString - deriving (Eq, Ord, Show) - --- | A special value used to request that no salt be used. -noSalt :: Salt -noSalt = Salt ByteString.empty - --- | A secret key used as input to a cipher or HMAC. Equality comparisons on --- this type are variable-time. -newtype SecretKey = SecretKey ByteString - deriving (Eq, Ord, Show) - -showHex :: ByteString -> String -showHex = ByteString.Char8.unpack . ByteString.Base16.encode \ No newline at end of file diff --git a/src/Codec/Crypto/HKDF.hs b/src/Codec/Crypto/HKDF.hs index 31d0be3..772fcf5 100644 --- a/src/Codec/Crypto/HKDF.hs +++ b/src/Codec/Crypto/HKDF.hs @@ -23,10 +23,9 @@ -} module Codec.Crypto.HKDF ( -- * Computing keys - SecretKey(SecretKey) - , hkdf - , extract - , expand + hkdf, HKDFParams(..) + , extract, ExtractParams(..) + , expand, ExpandParams(..) -- * Cryptographic hash algorithms , Algorithm @@ -37,17 +36,6 @@ module Codec.Crypto.HKDF -- [FIPS 180-4](https://csrc.nist.gov/publications/detail/fips/180/4/final). , sha224, sha256, sha384, sha512 - -- * Salt - - -- | You may salt the hash used to generate the key. If you do not wish to - -- do so, specify 'noSalt' as the salt. - , Salt(Salt), noSalt - - -- * Associated data - -- | You may mix in arbitrary data when generating a key. If you do not wish - -- to do so, specify the empty string as the associated data. - , AssociatedData(AssociatedData) - -- * Error handling , Error @@ -58,6 +46,7 @@ module Codec.Crypto.HKDF import Control.Monad ((>=>)) import Control.Monad.Trans.Class (lift) import Control.Monad.Trans.Except (runExceptT) +import Data.ByteString (ByteString) import Foreign (allocaArray) import Foreign.Marshal.Unsafe (unsafeLocalState) @@ -65,44 +54,44 @@ import BTLS.BoringSSL.Digest (evpMaxMDSize) import BTLS.BoringSSL.HKDF import BTLS.Buffer (onBufferOfMaxSize', packCUStringLen) import BTLS.Result (Error, check) -import BTLS.Types - ( Algorithm(Algorithm), AssociatedData(AssociatedData), Salt(Salt) - , SecretKey(SecretKey), noSalt - ) +import BTLS.Types (Algorithm(Algorithm)) import Data.Digest (md5, sha1, sha224, sha256, sha384, sha512) --- | Computes an HKDF. It is defined by --- --- prop> hkdf md salt info len = extract md salt >=> expand md info len --- --- but may be faster than calling the two functions individually. -hkdf :: - Algorithm - -> Salt - -> AssociatedData - -> Int -- ^ The length of the derived key, in bytes. - -> SecretKey - -> Either [Error] SecretKey -hkdf md salt info outLen = extract md salt >=> expand md info outLen +-- | Computes an HKDF. It is defined as the composition of 'extract' and +-- 'expand' but may be faster than calling the two functions individually. +hkdf :: HKDFParams -> ByteString -> Either [Error] ByteString +hkdf (HKDFParams md salt info outLen) = + extract (ExtractParams md salt) >=> expand (ExpandParams md info outLen) + +data HKDFParams = HKDFParams + { algorithm :: Algorithm + , salt :: ByteString + , associatedData :: ByteString + , secretLen :: Int + } deriving (Eq, Show) -- | Computes an HKDF pseudorandom key (PRK). -extract :: Algorithm -> Salt -> SecretKey -> Either [Error] SecretKey -extract (Algorithm md) (Salt salt) (SecretKey secret) = - fmap SecretKey $ - unsafeLocalState $ - onBufferOfMaxSize' evpMaxMDSize $ \pOutKey pOutLen -> - check $ hkdfExtract pOutKey pOutLen md secret salt +extract :: ExtractParams -> ByteString -> Either [Error] ByteString +extract (ExtractParams (Algorithm md) salt) secret = + unsafeLocalState $ + onBufferOfMaxSize' evpMaxMDSize $ \pOutKey pOutLen -> + check $ hkdfExtract pOutKey pOutLen md secret salt + +data ExtractParams = ExtractParams + { extractAlgorithm :: Algorithm + , extractSalt :: ByteString + } deriving (Eq, Show) -- | Computes HKDF output key material (OKM). -expand :: - Algorithm - -> AssociatedData - -> Int -- ^ The length of the OKM, in bytes. - -> SecretKey - -> Either [Error] SecretKey -expand (Algorithm md) (AssociatedData info) outLen (SecretKey secret) = - fmap SecretKey $ - unsafeLocalState $ - allocaArray outLen $ \pOutKey -> runExceptT $ do - check $ hkdfExpand pOutKey outLen md secret info - lift $ packCUStringLen (pOutKey, outLen) +expand :: ExpandParams -> ByteString -> Either [Error] ByteString +expand (ExpandParams (Algorithm md) info outLen) secret = + unsafeLocalState $ + allocaArray outLen $ \pOutKey -> runExceptT $ do + check $ hkdfExpand pOutKey outLen md secret info + lift $ packCUStringLen (pOutKey, outLen) + +data ExpandParams = ExpandParams + { expandAlgorithm :: Algorithm + , expandAssociatedData :: ByteString + , expandSecretLen :: Int + } deriving (Eq, Show) diff --git a/src/Data/Digest.hs b/src/Data/Digest.hs index 3bc53b7..bc2f944 100644 --- a/src/Data/Digest.hs +++ b/src/Data/Digest.hs @@ -38,6 +38,7 @@ module Data.Digest , sha1 ) where +import Data.ByteString (ByteString) import qualified Data.ByteString.Lazy as Lazy (ByteString) import qualified Data.ByteString.Lazy as ByteString.Lazy import Foreign.Marshal.Unsafe (unsafeLocalState) @@ -45,7 +46,18 @@ import Foreign.Marshal.Unsafe (unsafeLocalState) import BTLS.BoringSSL.Base import BTLS.BoringSSL.Digest import BTLS.Buffer (onBufferOfMaxSize) -import BTLS.Types (Algorithm(Algorithm), Digest(Digest)) +import BTLS.Show (showHex) +import BTLS.Types (Algorithm(Algorithm)) + +-- | The result of a hash operation. Equality comparisons on this type are +-- variable-time. +-- +-- The 'Show' instance for this type displays the digest as a hexadecimal string. +newtype Digest = Digest ByteString + deriving (Eq, Ord) + +instance Show Digest where + show (Digest d) = showHex d -- | Message Digest 5, a 128-bit digest defined in -- [RFC 1321](https://tools.ietf.org/html/rfc1321). This algorithm is diff --git a/src/Data/HMAC.hs b/src/Data/HMAC.hs index 0e5a67f..d27ce7e 100644 --- a/src/Data/HMAC.hs +++ b/src/Data/HMAC.hs @@ -24,7 +24,7 @@ module Data.HMAC ( -- * Computing HMACs HMAC(HMAC) - , hmac + , hmac, HMACParams(..) -- * Cryptographic hash algorithms , Algorithm @@ -35,9 +35,6 @@ module Data.HMAC -- [FIPS 180-4](https://csrc.nist.gov/publications/detail/fips/180/4/final). , sha224, sha256, sha384, sha512 - -- * Keys - , SecretKey(SecretKey) - -- * Error handling , Error @@ -59,7 +56,8 @@ import BTLS.BoringSSL.HMAC import BTLS.BoringSSL.Mem (cryptoMemcmp) import BTLS.Buffer (onBufferOfMaxSize) import BTLS.Result (Error, check) -import BTLS.Types (Algorithm(Algorithm), SecretKey(SecretKey), showHex) +import BTLS.Show (showHex) +import BTLS.Types (Algorithm(Algorithm)) import Data.Digest (md5, sha1, sha224, sha256, sha384, sha512) -- | A hash-based message authentication code. Equality comparisons on this type @@ -76,11 +74,16 @@ instance Eq HMAC where instance Show HMAC where show (HMAC m) = showHex m --- | Creates an HMAC according to the given 'Algorithm'. -hmac :: Algorithm -> SecretKey -> Lazy.ByteString -> Either [Error] HMAC -hmac (Algorithm md) (SecretKey key) bytes = +-- | Creates an HMAC. +hmac :: HMACParams -> Lazy.ByteString -> Either [Error] HMAC +hmac (HMACParams (Algorithm md) key) bytes = unsafeLocalState $ runExceptT $ do ctx <- lift mallocHMACCtx check $ hmacInitEx ctx key md noEngine lift $ mapM_ (hmacUpdate ctx) (ByteString.Lazy.toChunks bytes) lift $ HMAC <$> onBufferOfMaxSize evpMaxMDSize (hmacFinal ctx) + +data HMACParams = HMACParams + { algorithm :: Algorithm + , secretKey :: ByteString + } deriving (Eq, Show) diff --git a/tests/Codec/Crypto/HKDFTests.hs b/tests/Codec/Crypto/HKDFTests.hs index b1825a2..f098640 100644 --- a/tests/Codec/Crypto/HKDFTests.hs +++ b/tests/Codec/Crypto/HKDFTests.hs @@ -13,10 +13,10 @@ -- the License. {-# LANGUAGE OverloadedStrings #-} +{-# OPTIONS_GHC -Wno-missing-fields #-} module Codec.Crypto.HKDFTests (tests) where -import Data.ByteString (ByteString) import qualified Data.ByteString as ByteString import Test.Tasty (TestTree, testGroup) import Test.Tasty.HUnit (testCase) @@ -24,70 +24,77 @@ import Test.Tasty.HUnit (testCase) import BTLS.Assertions (isRightAndHolds) import BTLS.TestUtilities (hex) import Codec.Crypto.HKDF - (AssociatedData(AssociatedData), Salt(Salt), SecretKey(SecretKey), noSalt) -import qualified Codec.Crypto.HKDF as HKDF + (ExpandParams(..), ExtractParams(..), HKDFParams(..), expand, extract, hkdf) import Data.Digest (sha1, sha256) tests :: TestTree tests = testGroup "Codec.Crypto.HKDF" [testRFC5869] -hkdfTestCase name hash ikm salt info prk okm@(SecretKey k) = testGroup name $ - let len = ByteString.length k in - [ testCase "hkdf" $ HKDF.hkdf hash salt info len ikm `isRightAndHolds` okm - , testCase "extract" $ HKDF.extract hash salt ikm `isRightAndHolds` prk - , testCase "expand" $ HKDF.expand hash info len prk `isRightAndHolds` okm ] +hkdfTestCase name + params@(HKDFParams {algorithm = hash, salt = salt, associatedData = info}) + ikm + prk + okm = + testGroup name $ + let secretLen = ByteString.length okm + params' = params { secretLen = secretLen } + extractParams = ExtractParams { extractAlgorithm = hash + , extractSalt = salt } + expandParams = ExpandParams { expandAlgorithm = hash + , expandAssociatedData = info + , expandSecretLen = secretLen } in + [ testCase "hkdf" $ hkdf params' ikm `isRightAndHolds` okm + , testCase "extract" $ extract extractParams ikm `isRightAndHolds` prk + , testCase "expand" $ expand expandParams prk `isRightAndHolds` okm ] -- | Tests from RFC 5869. testRFC5869 = testGroup "RFC 5869 examples" [ hkdfTestCase "test case 1" - sha256 - (SecretKey $ ByteString.replicate 22 0x0b) - (Salt $ ByteString.pack [0x00 .. 0x0c]) - (AssociatedData $ ByteString.pack [0xf0 .. 0xf9]) - (hexKey "077709362c2e32df0ddc3f0dc47bba6390b6c73bb50f9c3122ec844ad7c2b3e5") - (hexKey "3cb25f25faacd57a90434f64d0362f2a2d2d0a90cf1a5a4c5db02d56ecc4c5bf34007208d5b887185865") + HKDFParams { algorithm = sha256 + , salt = ByteString.pack [0x00 .. 0x0c] + , associatedData = ByteString.pack [0xf0 .. 0xf9] } + (ByteString.replicate 22 0x0b) + (hex "077709362c2e32df0ddc3f0dc47bba6390b6c73bb50f9c3122ec844ad7c2b3e5") + (hex "3cb25f25faacd57a90434f64d0362f2a2d2d0a90cf1a5a4c5db02d56ecc4c5bf34007208d5b887185865") , hkdfTestCase "test case 2" - sha256 - (SecretKey $ ByteString.pack [0x00 .. 0x4f]) - (Salt $ ByteString.pack [0x60 .. 0xaf]) - (AssociatedData $ ByteString.pack [0xb0 .. 0xff]) - (hexKey "06a6b88c5853361a06104c9ceb35b45cef760014904671014a193f40c15fc244") - (hexKey "b11e398dc80327a1c8e7f78c596a49344f012eda2d4efad8a050cc4c19afa97c59045a99cac7827271cb41c65e590e09da3275600c2f09b8367793a9aca3db71cc30c58179ec3e87c14c01d5c1f3434f1d87") + HKDFParams { algorithm = sha256 + , salt = ByteString.pack [0x60 .. 0xaf] + , associatedData = ByteString.pack [0xb0 .. 0xff] } + (ByteString.pack [0x00 .. 0x4f]) + (hex "06a6b88c5853361a06104c9ceb35b45cef760014904671014a193f40c15fc244") + (hex "b11e398dc80327a1c8e7f78c596a49344f012eda2d4efad8a050cc4c19afa97c59045a99cac7827271cb41c65e590e09da3275600c2f09b8367793a9aca3db71cc30c58179ec3e87c14c01d5c1f3434f1d87") , hkdfTestCase "test case 3" - sha256 - (SecretKey $ ByteString.replicate 22 0x0b) - (Salt "") - (AssociatedData "") - (hexKey "19ef24a32c717b167f33a91d6f648bdf96596776afdb6377ac434c1c293ccb04") - (hexKey "8da4e775a563c18f715f802a063c5a31b8a11f5c5ee1879ec3454e5f3c738d2d9d201395faa4b61a96c8") + HKDFParams { algorithm = sha256 + , salt = "" + , associatedData = "" } + (ByteString.replicate 22 0x0b) + (hex "19ef24a32c717b167f33a91d6f648bdf96596776afdb6377ac434c1c293ccb04") + (hex "8da4e775a563c18f715f802a063c5a31b8a11f5c5ee1879ec3454e5f3c738d2d9d201395faa4b61a96c8") , hkdfTestCase "test case 4" - sha1 - (SecretKey $ ByteString.replicate 11 0x0b) - (Salt $ ByteString.pack [0x00 .. 0x0c]) - (AssociatedData $ ByteString.pack [0xf0 .. 0xf9]) - (hexKey "9b6c18c432a7bf8f0e71c8eb88f4b30baa2ba243") - (hexKey "085a01ea1b10f36933068b56efa5ad81a4f14b822f5b091568a9cdd4f155fda2c22e422478d305f3f896") + HKDFParams { algorithm = sha1 + , salt = ByteString.pack [0x00 .. 0x0c] + , associatedData = ByteString.pack [0xf0 .. 0xf9] } + (ByteString.replicate 11 0x0b) + (hex "9b6c18c432a7bf8f0e71c8eb88f4b30baa2ba243") + (hex "085a01ea1b10f36933068b56efa5ad81a4f14b822f5b091568a9cdd4f155fda2c22e422478d305f3f896") , hkdfTestCase "test case 5" - sha1 - (SecretKey $ ByteString.pack [0x00 .. 0x4f]) - (Salt $ ByteString.pack [0x60 .. 0xaf]) - (AssociatedData $ ByteString.pack [0xb0 .. 0xff]) - (hexKey "8adae09a2a307059478d309b26c4115a224cfaf6") - (hexKey "0bd770a74d1160f7c9f12cd5912a06ebff6adcae899d92191fe4305673ba2ffe8fa3f1a4e5ad79f3f334b3b202b2173c486ea37ce3d397ed034c7f9dfeb15c5e927336d0441f4c4300e2cff0d0900b52d3b4") + HKDFParams { algorithm = sha1 + , salt = ByteString.pack [0x60 .. 0xaf] + , associatedData = ByteString.pack [0xb0 .. 0xff] } + (ByteString.pack [0x00 .. 0x4f]) + (hex "8adae09a2a307059478d309b26c4115a224cfaf6") + (hex "0bd770a74d1160f7c9f12cd5912a06ebff6adcae899d92191fe4305673ba2ffe8fa3f1a4e5ad79f3f334b3b202b2173c486ea37ce3d397ed034c7f9dfeb15c5e927336d0441f4c4300e2cff0d0900b52d3b4") , hkdfTestCase "test case 6" - sha1 - (SecretKey $ ByteString.replicate 22 0x0b) - (Salt "") - (AssociatedData "") - (hexKey "da8c8a73c7fa77288ec6f5e7c297786aa0d32d01") - (hexKey "0ac1af7002b3d761d1e55298da9d0506b9ae52057220a306e07b6b87e8df21d0ea00033de03984d34918") + HKDFParams { algorithm = sha1 + , salt = "" + , associatedData = "" } + (ByteString.replicate 22 0x0b) + (hex "da8c8a73c7fa77288ec6f5e7c297786aa0d32d01") + (hex "0ac1af7002b3d761d1e55298da9d0506b9ae52057220a306e07b6b87e8df21d0ea00033de03984d34918") , hkdfTestCase "test case 7" - sha1 - (SecretKey $ ByteString.replicate 22 0x0c) - noSalt - (AssociatedData "") - (hexKey "2adccada18779e7c2077ad2eb19d3f3e731385dd") - (hexKey "2c91117204d745f3500d636a62f64f0ab3bae548aa53d423b0d1f27ebba6f5e5673a081d70cce7acfc48") ] - -hexKey :: ByteString -> SecretKey -hexKey = SecretKey . hex + HKDFParams { algorithm = sha1 + , salt = "" + , associatedData = "" } + (ByteString.replicate 22 0x0c) + (hex "2adccada18779e7c2077ad2eb19d3f3e731385dd") + (hex "2c91117204d745f3500d636a62f64f0ab3bae548aa53d423b0d1f27ebba6f5e5673a081d70cce7acfc48") ] diff --git a/tests/Data/HMACTests.hs b/tests/Data/HMACTests.hs index 10856f5..162fcea 100644 --- a/tests/Data/HMACTests.hs +++ b/tests/Data/HMACTests.hs @@ -25,8 +25,8 @@ import Test.Tasty.HUnit (testCase) import BTLS.Assertions (isRightAndHolds) import BTLS.TestUtilities (abbreviate, hex) -import Data.Digest (Algorithm, md5, sha1, sha224, sha256, sha384, sha512) -import Data.HMAC (HMAC(HMAC), SecretKey(SecretKey), hmac) +import Data.Digest (md5, sha1, sha224, sha256, sha384, sha512) +import Data.HMAC (HMAC(HMAC), HMACParams(..), hmac) tests :: TestTree tests = testGroup "Data.HMAC" @@ -34,56 +34,120 @@ tests = testGroup "Data.HMAC" , testFIPS198 , testRFC4231 ] -hmacTestCase :: Algorithm -> ByteString -> Lazy.ByteString -> ByteString -> TestTree -hmacTestCase algo key input output = hmacTestCase' (abbreviate input) algo key input output +hmacTestCase :: HMACParams -> Lazy.ByteString -> ByteString -> TestTree +hmacTestCase params input output = hmacTestCase' (abbreviate input) params input output -hmacTestCase' :: String -> Algorithm -> ByteString -> Lazy.ByteString -> ByteString -> TestTree -hmacTestCase' description algo key input output = - testCase description $ hmac algo (SecretKey key) input `isRightAndHolds` hexHMAC output - -md5TestCase, sha1TestCase :: ByteString -> Lazy.ByteString -> ByteString -> TestTree -md5TestCase = hmacTestCase md5 -sha1TestCase = hmacTestCase sha1 +hmacTestCase' :: String -> HMACParams -> Lazy.ByteString -> ByteString -> TestTree +hmacTestCase' description params input output = + testCase description $ hmac params input `isRightAndHolds` hexHMAC output -- | Tests from RFC 2202. testRFC2202 = testGroup "RFC 2202" [testMD5, testSHA1] where testMD5 = testGroup "MD5" - [ md5TestCase (ByteString.replicate 16 0x0b) "Hi There" "9294727a3638bb1c13f48ef8158bfc9d" - , md5TestCase "Jefe" "what do ya want for nothing?" "750c783e6ab0b503eaa86e310a5db738" - , md5TestCase (ByteString.replicate 16 0xaa) (ByteString.Lazy.replicate 50 0xdd) "56be34521d144c88dbb8c733f0e8b3f6" - , md5TestCase (ByteString.pack [0x01 .. 0x19]) (ByteString.Lazy.replicate 50 0xcd) "697eaf0aca3a3aea3a75164746ffaa79" - , md5TestCase (ByteString.replicate 16 0x0c) ("Test With Truncation") "56461ef2342edc00f9bab995690efd4c" - , md5TestCase (ByteString.replicate 80 0xaa) ("Test Using Larger Than Block-Size Key - Hash Key First") "6b1ab7fe4bd7bf8f0b62e6ce61b9d0cd" - , md5TestCase (ByteString.replicate 80 0xaa) ("Test Using Larger Than Block-Size Key and Larger Than One Block-Size Data") "6f630fad67cda0ee1fb1f562db3aa53e" ] + [ hmacTestCase + HMACParams { algorithm = md5 + , secretKey = ByteString.replicate 16 0x0b } + "Hi There" + "9294727a3638bb1c13f48ef8158bfc9d" + , hmacTestCase + HMACParams { algorithm = md5 + , secretKey = "Jefe" } + "what do ya want for nothing?" + "750c783e6ab0b503eaa86e310a5db738" + , hmacTestCase + HMACParams { algorithm = md5 + , secretKey = ByteString.replicate 16 0xaa } + (ByteString.Lazy.replicate 50 0xdd) + "56be34521d144c88dbb8c733f0e8b3f6" + , hmacTestCase + HMACParams { algorithm = md5 + , secretKey = ByteString.pack [0x01 .. 0x19] } + (ByteString.Lazy.replicate 50 0xcd) + "697eaf0aca3a3aea3a75164746ffaa79" + , hmacTestCase + HMACParams { algorithm = md5 + , secretKey = ByteString.replicate 16 0x0c } + "Test With Truncation" + "56461ef2342edc00f9bab995690efd4c" + , hmacTestCase + HMACParams { algorithm = md5 + , secretKey = ByteString.replicate 80 0xaa } + "Test Using Larger Than Block-Size Key - Hash Key First" + "6b1ab7fe4bd7bf8f0b62e6ce61b9d0cd" + , hmacTestCase + HMACParams { algorithm = md5 + , secretKey = ByteString.replicate 80 0xaa } + "Test Using Larger Than Block-Size Key and Larger Than One Block-Size Data" + "6f630fad67cda0ee1fb1f562db3aa53e" ] testSHA1 = testGroup "SHA-1" - [ sha1TestCase (ByteString.replicate 20 0x0b) ("Hi There") "b617318655057264e28bc0b6fb378c8ef146be00" - , sha1TestCase "Jefe" "what do ya want for nothing?" "effcdf6ae5eb2fa2d27416d5f184df9c259a7c79" - , sha1TestCase (ByteString.replicate 20 0xaa) (ByteString.Lazy.replicate 50 0xdd) "125d7342b9ac11cd91a39af48aa17b4f63f175d3" - , sha1TestCase (ByteString.pack [0x01 .. 0x19]) (ByteString.Lazy.replicate 50 0xcd) "4c9007f4026250c6bc8414f9bf50c86c2d7235da" - , sha1TestCase (ByteString.replicate 20 0x0c) ("Test With Truncation") "4c1a03424b55e07fe7f27be1d58bb9324a9a5a04" - , sha1TestCase (ByteString.replicate 80 0xaa) ("Test Using Larger Than Block-Size Key - Hash Key First") "aa4ae5e15272d00e95705637ce8a3b55ed402112" - , sha1TestCase (ByteString.replicate 80 0xaa) ("Test Using Larger Than Block-Size Key and Larger Than One Block-Size Data") "e8e99d0f45237d786d6bbaa7965c7808bbff1a91" ] + [ hmacTestCase + HMACParams { algorithm = sha1 + , secretKey = ByteString.replicate 20 0x0b } + "Hi There" + "b617318655057264e28bc0b6fb378c8ef146be00" + , hmacTestCase + HMACParams { algorithm = sha1 + , secretKey = "Jefe" } + "what do ya want for nothing?" + "effcdf6ae5eb2fa2d27416d5f184df9c259a7c79" + , hmacTestCase + HMACParams { algorithm = sha1 + , secretKey = ByteString.replicate 20 0xaa } + (ByteString.Lazy.replicate 50 0xdd) + "125d7342b9ac11cd91a39af48aa17b4f63f175d3" + , hmacTestCase + HMACParams { algorithm = sha1 + , secretKey = ByteString.pack [0x01 .. 0x19] } + (ByteString.Lazy.replicate 50 0xcd) + "4c9007f4026250c6bc8414f9bf50c86c2d7235da" + , hmacTestCase + HMACParams { algorithm = sha1 + , secretKey = ByteString.replicate 20 0x0c } + "Test With Truncation" + "4c1a03424b55e07fe7f27be1d58bb9324a9a5a04" + , hmacTestCase + HMACParams { algorithm = sha1 + , secretKey = ByteString.replicate 80 0xaa } + "Test Using Larger Than Block-Size Key - Hash Key First" + "aa4ae5e15272d00e95705637ce8a3b55ed402112" + , hmacTestCase + HMACParams { algorithm = sha1 + , secretKey = ByteString.replicate 80 0xaa } + "Test Using Larger Than Block-Size Key and Larger Than One Block-Size Data" + "e8e99d0f45237d786d6bbaa7965c7808bbff1a91" ] -- | Tests from FIPS 198. testFIPS198 = testGroup "FIPS 198 (SHA-1)" $ - [ sha1TestCase (ByteString.pack [0 .. 0x3f]) "Sample #1" "4f4ca3d5d68ba7cc0a1208c9c61e9c5da0403c0a" - , sha1TestCase (ByteString.pack [0x30 .. 0x43]) "Sample #2" "0922d3405faa3d194f82a45830737d5cc6c75d24" - , sha1TestCase (ByteString.pack [0x50 .. 0xb3]) "Sample #3" "bcf41eab8bb2d802f3d05caf7cb092ecf8d1a3aa" + [ hmacTestCase + HMACParams { algorithm = sha1 + , secretKey = ByteString.pack [0 .. 0x3f] } + "Sample #1" + "4f4ca3d5d68ba7cc0a1208c9c61e9c5da0403c0a" + , hmacTestCase + HMACParams { algorithm = sha1 + , secretKey = ByteString.pack [0x30 .. 0x43] } + "Sample #2" + "0922d3405faa3d194f82a45830737d5cc6c75d24" + , hmacTestCase + HMACParams { algorithm = sha1 + , secretKey = ByteString.pack [0x50 .. 0xb3] } + "Sample #3" + "bcf41eab8bb2d802f3d05caf7cb092ecf8d1a3aa" ] ++ [truncatedFIPS198Test] where truncatedFIPS198Test = let input = "Sample #4" in testCase (abbreviate input) $ - (truncateHMAC 24 <$> hmac sha1 (SecretKey $ ByteString.pack [0x70 .. 0xa0]) input) + (truncateHMAC 24 <$> hmac HMACParams { algorithm = sha1, secretKey = ByteString.pack [0x70 .. 0xa0] } input) `isRightAndHolds` hexHMAC "9ea886efe268dbecce420c75" -- | Tests from RFC 4231. testRFC4231 = testGroup "RFC 4231" $ let rfc4231TestCase key input sha224Output sha256Output sha384Output sha512Output = testGroup (abbreviate input) - [ hmacTestCase' "SHA-224" sha224 key input sha224Output - , hmacTestCase' "SHA-256" sha256 key input sha256Output - , hmacTestCase' "SHA-384" sha384 key input sha384Output - , hmacTestCase' "SHA-512" sha512 key input sha512Output ] in + [ hmacTestCase' "SHA-224" HMACParams { algorithm = sha224, secretKey = key } input sha224Output + , hmacTestCase' "SHA-256" HMACParams { algorithm = sha256, secretKey = key } input sha256Output + , hmacTestCase' "SHA-384" HMACParams { algorithm = sha384, secretKey = key } input sha384Output + , hmacTestCase' "SHA-512" HMACParams { algorithm = sha512, secretKey = key } input sha512Output ] in [ rfc4231TestCase (ByteString.replicate 20 0x0b) "Hi There" "896fb1128abbdf196832107cd49df33f47b4b1169912ba4f53684b22" "b0344c61d8db38535ca8afceaf0bf12b881dc200c9833da726e9376c2e32cff7" @@ -116,11 +180,12 @@ testRFC4231 = testGroup "RFC 4231" $ "e37b6a775dc87dbaa4dfa9f96e5e3ffddebd71f8867289865df5a32d20cdc944b6022cac3c4982b10d5eeb55c3e4de15134676fb6de0446065c97440fa8c6a58" ] ++ [truncatedRFC4231Test] where truncatedRFC4231Test = - let key = SecretKey $ ByteString.replicate 20 0x0c + let key = ByteString.replicate 20 0x0c input = "Test With Truncation" truncatedTestCase description algo output = testCase description $ - (truncateHMAC 32 <$> hmac algo key input) `isRightAndHolds` hexHMAC output in + (truncateHMAC 32 <$> hmac HMACParams { algorithm = algo, secretKey = key } input) + `isRightAndHolds` hexHMAC output in testGroup (abbreviate input) [ truncatedTestCase "SHA-224" sha224 "0e2aea68a90c8d37c988bcdb9fca6fa8" , truncatedTestCase "SHA-256" sha256 "a3b6167473100ee06e0c796c2955552b" -- cgit v1.2.3