PBKDF.hs (3714B)
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 Data.Bits ((.>>.), (.&.)) 25 import qualified Data.Bits as B 26 import qualified Data.ByteString as BS 27 import qualified Data.ByteString.Builder as BSB 28 import qualified Data.ByteString.Builder.Extra as BE 29 import Data.Word (Word32, Word64) 30 31 -- NB following synonym really only exists to make haddocks more 32 -- readable 33 34 -- | A HMAC function, taking a key as the first argument and the input 35 -- value as the second, producing a MAC digest. 36 -- 37 -- (RFC2898 specifically requires a "pseudorandom function" of two 38 -- arguments, but in practice this will usually be a HMAC function.) 39 -- 40 -- >>> import qualified Crypto.Hash.SHA256 as SHA256 41 -- >>> :t SHA256.hmac 42 -- SHA256.hmac :: BS.ByteString -> BS.ByteString -> BS.ByteString 43 -- >>> SHA256.hmac "my HMAC key" "my HMAC input" 44 -- <256-bit MAC> 45 type HMAC = BS.ByteString -> BS.ByteString -> BS.ByteString 46 47 fi :: (Integral a, Num b) => a -> b 48 fi = fromIntegral 49 {-# INLINE fi #-} 50 51 -- serialize a 32-bit word, MSB first 52 ser32 :: Word32 -> BS.ByteString 53 ser32 w = 54 let !mask = 0b00000000_00000000_00000000_11111111 55 !w0 = fi (w .>>. 24) .&. mask 56 !w1 = fi (w .>>. 16) .&. mask 57 !w2 = fi (w .>>. 08) .&. mask 58 !w3 = fi w .&. mask 59 in BS.cons w0 (BS.cons w1 (BS.cons w2 (BS.singleton w3))) 60 {-# INLINE ser32 #-} 61 62 -- bytewise xor on bytestrings 63 xor :: BS.ByteString -> BS.ByteString -> BS.ByteString 64 xor = BS.packZipWith B.xor 65 {-# INLINE xor #-} 66 67 -- | Derive a key from a secret via the PBKDF2 key derivation function. 68 -- 69 -- >>> :set -XOverloadedStrings 70 -- >>> import qualified Crypto.Hash.SHA256 as SHA256 71 -- >>> import qualified Data.ByteString as BS 72 -- >>> import qualified Data.ByteString.Base16 as B16 73 -- >>> BS.take 16 (B16.encode (derive SHA256.hmac "passwd" "salt" 1 64)) 74 -- "55ac046e56e3089f" 75 derive 76 :: HMAC -- ^ pseudo-random function (HMAC) 77 -> BS.ByteString -- ^ password 78 -> BS.ByteString -- ^ salt 79 -> Word64 -- ^ iteration count 80 -> Word32 -- ^ bytelength of derived key (max 0xffff_ffff * hlen) 81 -> BS.ByteString -- ^ derived key 82 derive prf p s c dklen 83 | dklen > 0xffff_ffff * fi hlen = -- 2 ^ 32 - 1 84 error "ppad-pbkdf (derive): derived key too long" 85 | otherwise = 86 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