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