pbkdf

Pure Haskell password-based KDF (docs.ppad.tech/pbkdf).
git clone git://git.ppad.tech/pbkdf.git
Log | Files | Refs | README | LICENSE

PBKDF.hs (3693B)


      1 {-# OPTIONS_HADDOCK prune #-}
      2 {-# LANGUAGE BangPatterns #-}
      3 {-# LANGUAGE BinaryLiterals #-}
      4 {-# LANGUAGE NumericUnderscores #-}
      5 
      6 -- |
      7 -- Module: Crypto.KDF.PBKDF
      8 -- Copyright: (c) 2025 Jared Tobin
      9 -- License: MIT
     10 -- Maintainer: Jared Tobin <jared@ppad.tech>
     11 --
     12 -- A pure PBKDF2 (password-based key derivation
     13 -- function) implementation, as specified by
     14 -- [RFC2898](https://datatracker.ietf.org/doc/html/rfc2898).
     15 
     16 module Crypto.KDF.PBKDF (
     17     -- * HMAC synonym
     18     HMAC
     19 
     20     -- * PBKDF2
     21   , derive
     22   )where
     23 
     24 import Control.Monad (guard)
     25 import Data.Bits ((.>>.), (.&.))
     26 import qualified Data.Bits as B
     27 import qualified Data.ByteString as BS
     28 import qualified Data.ByteString.Builder as BSB
     29 import qualified Data.ByteString.Builder.Extra as BE
     30 import Data.Word (Word32, Word64)
     31 
     32 -- NB following synonym really only exists to make haddocks more
     33 --    readable
     34 
     35 -- | A HMAC function, taking a key as the first argument and the input
     36 --   value as the second, producing a MAC digest.
     37 --
     38 --   (RFC2898 specifically requires a "pseudorandom function" of two
     39 --   arguments, but in practice this will usually be a HMAC function.)
     40 --
     41 --   >>> import qualified Crypto.Hash.SHA256 as SHA256
     42 --   >>> :t SHA256.hmac
     43 --   SHA256.hmac :: BS.ByteString -> BS.ByteString -> BS.ByteString
     44 --   >>> SHA256.hmac "my HMAC key" "my HMAC input"
     45 --   <256-bit MAC>
     46 type HMAC = BS.ByteString -> BS.ByteString -> BS.ByteString
     47 
     48 fi :: (Integral a, Num b) => a -> b
     49 fi = fromIntegral
     50 {-# INLINE fi #-}
     51 
     52 -- serialize a 32-bit word, MSB first
     53 ser32 :: Word32 -> BS.ByteString
     54 ser32 w =
     55   let !mask = 0b00000000_00000000_00000000_11111111
     56       !w0 = fi (w .>>. 24) .&. mask
     57       !w1 = fi (w .>>. 16) .&. mask
     58       !w2 = fi (w .>>. 08) .&. mask
     59       !w3 = fi w .&. mask
     60   in  BS.cons w0 (BS.cons w1 (BS.cons w2 (BS.singleton w3)))
     61 {-# INLINE ser32 #-}
     62 
     63 -- bytewise xor on bytestrings
     64 xor :: BS.ByteString -> BS.ByteString -> BS.ByteString
     65 xor = BS.packZipWith B.xor
     66 {-# INLINE xor #-}
     67 
     68 -- | Derive a key from a secret via the PBKDF2 key derivation function.
     69 --
     70 --   >>> :set -XOverloadedStrings
     71 --   >>> import qualified Crypto.Hash.SHA256 as SHA256
     72 --   >>> import qualified Data.ByteString as BS
     73 --   >>> import qualified Data.ByteString.Base16 as B16
     74 --   >>> let Just key = derive SHA256.hmac "passwd" "salt" 1 64
     75 --   >>> BS.take 16 (B16.encode key)
     76 --   "55ac046e56e3089f"
     77 derive
     78   :: HMAC          -- ^ pseudo-random function (HMAC)
     79   -> BS.ByteString -- ^ password
     80   -> BS.ByteString -- ^ salt
     81   -> Word64        -- ^ iteration count
     82   -> Word32        -- ^ bytelength of derived key (max 0xffff_ffff * hlen)
     83   -> Maybe BS.ByteString -- ^ derived key
     84 derive prf p s c dklen = do
     85     guard (dklen <= 0xffff_ffff * fi hlen)
     86     pure (loop mempty 1)
     87   where
     88     !hlen = BS.length (prf mempty mempty)
     89     !l = ceiling (fi dklen / fi hlen :: Double) :: Word32
     90     !r = fi (dklen - (l - 1) * fi hlen)
     91 
     92     f !i =
     93       let go j !acc !las
     94             | j == c = acc
     95             | otherwise =
     96                 let u = prf p las
     97                     nacc = acc `xor` u
     98                 in  go (j + 1) nacc u
     99 
    100           org = prf p (s <> ser32 i)
    101 
    102       in  go 1 org org
    103     {-# INLINE f #-}
    104 
    105     loop !acc !i
    106       | i == l =
    107           let t = f i
    108               fin = BS.take r t
    109           in  BS.toStrict $
    110                 if   dklen <= 128
    111                 then BE.toLazyByteStringWith
    112                        (BE.safeStrategy 128 BE.smallChunkSize) mempty $
    113                        acc <> BSB.byteString fin
    114                 else BSB.toLazyByteString $
    115                        acc <> BSB.byteString fin
    116       | otherwise =
    117           let t = f i
    118               nacc = acc <> BSB.byteString t
    119           in  loop nacc (i + 1)
    120