diff --git a/CHANGELOG b/CHANGELOG new file mode 100644 --- /dev/null +++ b/CHANGELOG @@ -0,0 +1,6 @@ +# Changelog + +- 0.1.0 (2025-01-10) + * Initial release, supporting a generic RFC5869 HKDF function. + + diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,20 @@ +Copyright (c) 2024 Jared Tobin + +Permission is hereby granted, free of charge, to any person obtaining +a copy of this software and associated documentation files (the +"Software"), to deal in the Software without restriction, including +without limitation the rights to use, copy, modify, merge, publish, +distribute, sublicense, and/or sell copies of the Software, and to +permit persons to whom the Software is furnished to do so, subject to +the following conditions: + +The above copyright notice and this permission notice shall be included +in all copies or substantial portions of the Software. + +THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, +EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF +MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. +IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY +CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, +TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE +SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. diff --git a/bench/Main.hs b/bench/Main.hs new file mode 100644 --- /dev/null +++ b/bench/Main.hs @@ -0,0 +1,25 @@ +{-# LANGUAGE OverloadedStrings #-} + +module Main where + +import Criterion.Main +import qualified Crypto.KDF.HMAC as K +import qualified Crypto.Hash.SHA256 as SHA256 +import qualified Crypto.Hash.SHA512 as SHA512 + +main :: IO () +main = defaultMain [ + suite + ] + +suite :: Benchmark +suite = + bgroup "ppad-hkdf" [ + bgroup "HKDF-SHA256" [ + bench "32" $ nf (K.hkdf SHA256.hmac "muh salt" "muh info" 32) "muh secret" + ] + , bgroup "HKDF-SHA512" [ + bench "32" $ nf (K.hkdf SHA512.hmac "muh salt" "muh info" 32) "muh secret" + ] + ] + diff --git a/lib/Crypto/KDF/HMAC.hs b/lib/Crypto/KDF/HMAC.hs new file mode 100644 --- /dev/null +++ b/lib/Crypto/KDF/HMAC.hs @@ -0,0 +1,96 @@ +{-# OPTIONS_HADDOCK prune #-} +{-# LANGUAGE BangPatterns #-} +{-# LANGUAGE ViewPatterns #-} + +-- | +-- Module: Crypto.KDF.HMAC +-- Copyright: (c) 2024 Jared Tobin +-- License: MIT +-- Maintainer: Jared Tobin +-- +-- A pure HKDF implementation, as specified by +-- [RFC5869](https://datatracker.ietf.org/doc/html/rfc5869). + +module Crypto.KDF.HMAC ( + -- * HMAC-based KDF + hkdf + , HMAC + + -- internals + , extract + , expand + , HMACEnv + ) where + +import qualified Data.ByteString as BS +import qualified Data.ByteString.Builder as BSB +import qualified Data.ByteString.Internal as BI +import Data.Word (Word64) + +fi :: (Integral a, Num b) => a -> b +fi = fromIntegral +{-# INLINE fi #-} + +-- NB following synonym really only exists to make haddocks more +-- readable + +-- | A HMAC function, taking a key as the first argument and the input +-- value as the second, producing a MAC digest. +-- +-- >>> import qualified Crypto.Hash.SHA256 as SHA256 +-- >>> :t SHA256.hmac +-- SHA256.hmac :: BS.ByteString -> BS.ByteString -> BS.ByteString +type HMAC = BS.ByteString -> BS.ByteString -> BS.ByteString + +-- HMAC function and its associated outlength +data HMACEnv = HMACEnv + !HMAC + {-# UNPACK #-} !Int + +extract + :: HMACEnv + -> BS.ByteString -- ^ salt + -> BS.ByteString -- ^ input keying material + -> BS.ByteString -- ^ pseudorandom key +extract (HMACEnv hmac hashlen) salt@(BI.PS _ _ l) ikm + | l == 0 = hmac (BS.replicate hashlen 0x00) ikm + | otherwise = hmac salt ikm +{-# INLINE extract #-} + +expand + :: HMACEnv + -> BS.ByteString -- ^ optional context and application-specific info + -> Word64 -- ^ bytelength of output keying material + -> BS.ByteString -- ^ pseudorandom key + -> BS.ByteString -- ^ output keying material +expand (HMACEnv hmac hashlen) info (fi -> len) prk + | len > 255 * hashlen = error "ppad-hkdf (expand): invalid outlength" + | otherwise = BS.take len (go (1 :: Int) mempty mempty) + where + n = ceiling ((fi len :: Double) / (fi hashlen :: Double)) :: Int + go !j t !tl + | j > fi n = BS.toStrict (BSB.toLazyByteString t) + | otherwise = + let nt = hmac prk (tl <> info <> BS.singleton (fi j)) + in go (succ j) (t <> BSB.byteString nt) nt +{-# INLINE expand #-} + +-- | HMAC-based key derivation function. +-- +-- The /salt/ and /info/ arguments are optional to the KDF, and may +-- be simply passed as 'mempty'. An empty salt will be replaced by +-- /hashlen/ zero bytes. +-- +-- >>> import qualified Crypto.Hash.SHA256 as SHA256 +-- >>> hkdf SHA256.hmac "my public salt" mempty 64 "my secret input" +-- <64-byte output keying material> +hkdf + :: HMAC -- ^ HMAC function + -> BS.ByteString -- ^ salt + -> BS.ByteString -- ^ optional context and application-specific info + -> Word64 -- ^ bytelength of output keying material (<= 255 * hashlen) + -> BS.ByteString -- ^ input keying material + -> BS.ByteString -- ^ output keying material +hkdf hmac salt info len = expand env info len . extract env salt where + env = HMACEnv hmac (fi (BS.length (hmac mempty mempty))) + diff --git a/ppad-hkdf.cabal b/ppad-hkdf.cabal new file mode 100644 --- /dev/null +++ b/ppad-hkdf.cabal @@ -0,0 +1,71 @@ +cabal-version: 3.0 +name: ppad-hkdf +version: 0.1.0 +synopsis: A HMAC-based key derivation function +license: MIT +license-file: LICENSE +author: Jared Tobin +maintainer: jared@ppad.tech +category: Cryptography +build-type: Simple +tested-with: GHC == { 9.8.1 } +extra-doc-files: CHANGELOG +description: + A pure implementation of the HMAC-based extract-and-expand key derivation + function, per RFC5869. + +source-repository head + type: git + location: git.ppad.tech/hkdf.git + +library + default-language: Haskell2010 + hs-source-dirs: lib + ghc-options: + -Wall + exposed-modules: + Crypto.KDF.HMAC + build-depends: + base >= 4.9 && < 5 + , bytestring >= 0.9 && < 0.13 + +test-suite hkdf-tests + type: exitcode-stdio-1.0 + default-language: Haskell2010 + hs-source-dirs: test + main-is: Main.hs + other-modules: + Wycheproof + + ghc-options: + -rtsopts -Wall -O2 + + build-depends: + aeson + , base + , base16-bytestring + , bytestring + , ppad-hkdf + , ppad-sha256 + , ppad-sha512 + , tasty + , tasty-hunit + , text + +benchmark hkdf-bench + type: exitcode-stdio-1.0 + default-language: Haskell2010 + hs-source-dirs: bench + main-is: Main.hs + + ghc-options: + -rtsopts -O2 -Wall + + build-depends: + base + , bytestring + , criterion + , ppad-hkdf + , ppad-sha256 + , ppad-sha512 + diff --git a/test/Main.hs b/test/Main.hs new file mode 100644 --- /dev/null +++ b/test/Main.hs @@ -0,0 +1,68 @@ +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE RecordWildCards #-} + +module Main where + +import Control.Exception +import qualified Crypto.Hash.SHA256 as SHA256 +import qualified Crypto.Hash.SHA512 as SHA512 +import qualified Crypto.KDF.HMAC as H +import qualified Data.ByteString as BS +import qualified Data.Aeson as A +import qualified Data.Text.IO as TIO +import Test.Tasty +import Test.Tasty.HUnit +import qualified Wycheproof as W + +main :: IO () +main = do + wycheproof_sha256 <- TIO.readFile "etc/hkdf_sha256_test.json" + wycheproof_sha512 <- TIO.readFile "etc/hkdf_sha512_test.json" + let wycheproofs = do + a <- A.decodeStrictText wycheproof_sha256 :: Maybe W.Wycheproof + b <- A.decodeStrictText wycheproof_sha512 :: Maybe W.Wycheproof + pure (a, b) + case wycheproofs of + Nothing -> error "couldn't parse wycheproof vectors" + Just (w256, w512) -> defaultMain $ testGroup "ppad-hkdf" [ + wycheproof_tests SHA256 w256 + , wycheproof_tests SHA512 w512 + ] + +data Hash = SHA256 | SHA512 + deriving Show + +wycheproof_tests :: Hash -> W.Wycheproof -> TestTree +wycheproof_tests h W.Wycheproof {..} = + testGroup ("wycheproof vectors (hkdf, " <> show h <> ")") $ + fmap (execute_group h) wp_testGroups + +execute_group :: Hash -> W.HkdfTestGroup -> TestTree +execute_group h W.HkdfTestGroup {..} = + testGroup msg (fmap (execute h) htg_tests) + where + msg = "keysize " <> show htg_keySize + +execute :: Hash -> W.HkdfTest -> TestTree +execute h W.HkdfTest {..} = testCase t_msg $ do + let ikm = ht_ikm + sal = ht_salt + inf = ht_info + siz = ht_size + pec = ht_okm + if ht_result == "invalid" + then do + out <- try (pure $! H.hkdf hmac sal inf siz ikm) + :: IO (Either ErrorCall BS.ByteString) + case out of + Left _ -> assertBool "invalid" True + Right o -> assertBool "invalid" (pec /= o) + else do + let out = H.hkdf hmac sal inf siz ikm + assertEqual mempty pec out + where + hmac = case h of + SHA256 -> SHA256.hmac + SHA512 -> SHA512.hmac + t_msg = "test " <> show ht_tcId -- XX embellish + diff --git a/test/Wycheproof.hs b/test/Wycheproof.hs new file mode 100644 --- /dev/null +++ b/test/Wycheproof.hs @@ -0,0 +1,64 @@ +{-# LANGUAGE OverloadedStrings #-} + +module Wycheproof ( + Wycheproof(..) + , HkdfTestGroup(..) + , HkdfTest(..) + ) where + +import Data.Aeson ((.:)) +import qualified Data.Aeson as A +import qualified Data.ByteString as BS +import qualified Data.ByteString.Base16 as B16 +import qualified Data.Text as T +import qualified Data.Text.Encoding as TE +import Data.Word (Word64) + +data Wycheproof = Wycheproof { + wp_numberOfTests :: !Int + , wp_testGroups :: ![HkdfTestGroup] + } deriving Show + +instance A.FromJSON Wycheproof where + parseJSON = A.withObject "Wycheproof" $ \m -> Wycheproof + <$> m .: "numberOfTests" + <*> m .: "testGroups" + +data HkdfTestGroup = HkdfTestGroup { + htg_keySize :: !Int + , htg_type :: !T.Text + , htg_tests :: ![HkdfTest] + } deriving Show + +instance A.FromJSON HkdfTestGroup where + parseJSON = A.withObject "HkdfTestGroup" $ \m -> HkdfTestGroup + <$> m .: "keySize" + <*> m .: "type" + <*> m .: "tests" + +data HkdfTest = HkdfTest { + ht_tcId :: !Int + , ht_comment :: !T.Text + , ht_ikm :: !BS.ByteString + , ht_salt :: !BS.ByteString + , ht_info :: !BS.ByteString + , ht_size :: !Word64 + , ht_okm :: !BS.ByteString + , ht_result :: !T.Text + } deriving Show + +decodehex :: T.Text -> BS.ByteString +decodehex = B16.decodeLenient . TE.encodeUtf8 + +instance A.FromJSON HkdfTest where + parseJSON = A.withObject "HkdfTest" $ \m -> HkdfTest + <$> m .: "tcId" + <*> m .: "comment" + <*> fmap decodehex (m .: "ikm") + <*> fmap decodehex (m .: "salt") + <*> fmap decodehex (m .: "info") + <*> m .: "size" + <*> fmap decodehex (m .: "okm") + <*> m .: "result" + +