phkdf 0.0.0.0 → 0.1.0.0

raw patch · 16 files changed

+1533/−610 lines, 16 filesdep +quickcheck-instancesdep +sha256dep +tasty-quickcheckdep −cryptohash-sha256dep ~base16dep ~bytestringdep ~tuplehash-utilsPVP ok

version bump matches the API change (PVP)

Dependencies added: quickcheck-instances, sha256, tasty-quickcheck

Dependencies removed: cryptohash-sha256

Dependency ranges changed: base16, bytestring, tuplehash-utils

API changes (from Hackage documentation)

Files

• ChangeLog.md +15/−0
• lib/Crypto/Encoding/PHKDF.hs +141/−61
• lib/Crypto/Encoding/PHKDF/V1.hs +112/−0
• lib/Crypto/PHKDF.hs +528/−336
• lib/Crypto/PHKDF/Assert.hs +36/−0
• lib/Crypto/PHKDF/HMAC.hs +6/−58
• lib/Crypto/PHKDF/HMAC/Subtle.hs +3/−39
• lib/Crypto/PHKDF/Primitives.hs +175/−84
• lib/Crypto/PHKDF/Primitives/Assert.hs +7/−0
• lib/Crypto/PHKDF/Primitives/Subtle.hs +19/−16
• lib/Crypto/PHKDF/Subtle.hs +55/−0
• lib/Crypto/PHKDF/V1/Cookbook.hs +395/−0
• phkdf.cabal +17/−6
• test/HMAC.hs +0/−2
• test/Main.hs +16/−3
• test/PHKDF.hs +8/−5

@@ -1,5 +1,20 @@ # Revision history for phkdf +## Version 0.1.0.0 (2025-01-20)++*  This includes the Version 2 of PHKDF, which is mostly compatible with+   Version 1 except that the slow extract function has been removed and the+   end-of-message padding has been tweaked to save a byte when the domain tag+   is 20 bytes or longer. A simpler slow-extract function much closer to PBKDF2+   will eventually be factored out of g3p-hash version 2.++*  Saving this byte requires bitstring SHA256 inputs, thus the binding has been+   moved from cryptohash-sha256 to the new sha256 package. This is a new FFI+   binding around the core cryptohash implementation that better and more+   robustly supports the needs of this library.++*  The old code in Crypto.PHKDF has been moved to Crypto.PHKDF.V1.Cookbook+ ## Version 0.0.0.0 (2024-03-21)  *  The definition of Crypto.PHKDF.Primitives is quite stable.

@@ -1,60 +1,98 @@ {-# LANGUAGE OverloadedStrings, ViewPatterns #-} +-------------------------------------------------------------------------------+-- |+-- Module:      Crypto.Encoding.PHKDF+-- Copyright:   (c) 2024 Auth Global+-- License:     Apache2+--+-------------------------------------------------------------------------------+ module Crypto.Encoding.PHKDF where -import Data.Monoid((<>))-import Data.Bits(Bits, (.&.))+import Data.Bits(Bits, (.&.), shift) import Data.ByteString(ByteString)-import Data.Foldable(Foldable)+import Data.Int(Int64)+import Data.List(scanl') import qualified Data.ByteString as B-import Crypto.Encoding.SHA3.TupleHash  import Debug.Trace --- FIXME: several functions in here have opportunites for optimization--cycleByteStringToList :: ByteString -> Int -> [ByteString]-cycleByteStringToList str outBytes =-    if outBytes <= 0-    then []-    else if n == 0-         then [ B.replicate outBytes 0 ]-         else replicate q str ++ [B.take r str]-  where-    n = B.length str-    (q,r) = outBytes `quotRem` n--cycleByteStringWithNullToList :: ByteString -> Int -> [ByteString]-cycleByteStringWithNullToList str outBytes = out-  where-    out = cycleByteStringToList (str <> "\x00") outBytes--cycleByteString :: ByteString -> Int -> ByteString-cycleByteString str outBytes = B.concat (cycleByteStringToList str outBytes)--cycleByteStringWithNull :: ByteString -> Int -> ByteString-cycleByteStringWithNull str outBytes =-    B.concat (cycleByteStringWithNullToList str outBytes)- extendTagToList :: ByteString -> [ByteString] extendTagToList tag = if n <= 19 then [tag] else tag'   where     n = B.length tag-    x = (18 - n) `mod` 64-    tag' = cycleByteStringWithNullToList tag (n+x)-         ++ [B.singleton (fromIntegral x)]+    x = (19 - n) `mod` 64+    tag' = takeBs (fromIntegral (n+x)) (cycle [tag, "\x00"])+         ++ [B.singleton (fromIntegral x `shift` 2)] +-- | Extends a PHKDF end-of-message tag in order to ensure the last SHA-256+--   block contains something interesting.+--+--   Tags less than 160 bits (20 bytes) long are appended directly, without+--   extension, as the final portion of the message. Thus this function+--   is the identity on short inputs.+--+--   After extension, tags that are at least 20 bytes long should be thought+--   of as a bitstring with a single null bit appended at the end to make it+--   a full bytestring.+--+--   Tags 160 bits or longer are first extended, iff necessary, to a full+--   bytestring by adding a single "1" bit followed by zero to six "0" bits.+--+--   The bytestring is then extended by 0-63 bytes as needed to make the+--   overall length equivalent to 19 (mod 64). The first byte of the extension+--   is a null byte, then followed by the bytestring, then starting again+--   at the null byte as needed.+--+--   The length of this extension takes up the first 6 bits of the last byte,+--   followed by a "0" bit denoting the tag is a bytestring, or a "1" denoting+--   that the tag is a proper bitstring whose length is not an exact multiple+--   of 8.+--+--   The final bit is reserved for SHA-256's end-of-message padding, which+--   will set it to 1.+ extendTag :: ByteString -> ByteString extendTag = B.concat <$> extendTagToList -trimExtTag :: ByteString -> Maybe ByteString-trimExtTag extTag+-- | This function robustly undoes 'extendTag', thus "proving" that all+--   collisions on PHKDF's tag are cryptographically non-trivial, even after+--   extension.+--+--   This is a "proof" in the sense that if+--   @trimExtendedTag (extendTag x) == Just x@ is true for all bytestrings+--   @x@, then all collisions are non-trivial, but we haven't presented a+--   full deductive proof of this property.  It is part of the test suite,+--   tested by quickcheck fuzzing.+--+--   The rest of PHKDF and the G3P's syntax follows this as an iron rule+--   of syntax design. I've not literally written a program to parse out+--   the original arguments, but I've ensured that it is straightforward+--   to do so in principle.+--+--   In the case of variable-length PHKDF, starting from some known buffer+--   position (usually either 0 or 32), first there are zero or more+--   bitstring arguments encoded via TupleHash syntax. Since TupleHash's+--   length encoding cannot start with a null byte, a single null byte+--   is used to signal the end of these input arguments. Then 0-63 end+--   padding bytes are generated in order to bring the buffer position+--   equivalent to 32 (mod 64), then 4 bytes of counter, then the extended+--   version of PHKDF's end-of-message tag, then finally SHA256's end padding.+--+--   This is easy to robustly undo, as I've started to demonstrate in this+--   subroutine. This leads to a simple categorical/combinatorial style proof+--   that all collisions over PHKDF's input arguments and domain tag are+--   cryptographically non-trivial.++trimExtendedTag :: ByteString -> Maybe ByteString+trimExtendedTag extTag   | n <= 19 = Just extTag   | extTag /= extendTag tag = Nothing   | otherwise = Just tag   where     n = B.length extTag-    x = B.last extTag+    x = B.last extTag `shift` (-2)     tag = B.take (n - fromIntegral x - 1) extTag  {--@@ -77,39 +115,81 @@    | b >= c = b    | otherwise = c + ((b - c) .&. 63) +-- | Equivalent to 'add64WhileLt', except with trace debugging.  This should+--   never be used in production.+ add64WhileLt' :: (Ord a, Num a, Bits a, Show a) => a -> a -> a add64WhileLt' b c    | b >= c = b-   | otherwise = let d = c + ((b - c) .&. 63)-                  in trace (show b ++ " -> " ++ show d) d+   | otherwise = trace msg d+     where+       d = c + ((b - c) .&. 63)+       msg = show b ++ " + " ++ show ((d - b) `shift` (-6)) ++ " * 64 == "+          ++ show d ++ " == " ++ show c ++ " + " ++ show (d - c) -usernamePadding :: Foldable f => f ByteString -> ByteString -> ByteString -> ByteString-usernamePadding headerExtract fillerTag domainTag-  =  cycleByteStringWithNull fillerTag (a-32)-  <> cycleByteStringWithNull domainTag    32+dropBs :: Int64 -> [ ByteString ] -> [ ByteString ]+dropBs = go   where-    al = encodedVectorByteLength headerExtract-    a  = add64WhileLt (157 - al) 32+    len = fromIntegral . B.length+    go _ [] = []+    go 0 bs = bs+    go n (b:bs)+      | n >= len b = go (n - len b) bs+      | otherwise = B.drop (fromIntegral n) b : bs -passwordPaddingBytes :: Foldable f => Int -> f ByteString -> f ByteString -> ByteString -> ByteString -> ByteString -> ByteString-passwordPaddingBytes bytes headerUsername headerLongTag fillerTag domainTag password-  =  cycleByteStringWithNull fillerTag (c-32)-  <> cycleByteStringWithNull domainTag    32+takeBs :: Int64 -> [ ByteString ] -> [ ByteString ]+takeBs = go   where-    al = encodedVectorByteLength headerLongTag-    a  = add64WhileLt (bytes - al) 3240-    bl = encodedVectorByteLength headerUsername-    b  = add64WhileLt (a - bl) 136-    cl = encodedByteLength password-    c  = add64WhileLt (b - cl) 32+    len = fromIntegral . B.length+    go _ [] = []+    go n (b:bs)+      | n <= 0 = []+      | len b < n = b : go (n - len b) bs+      | otherwise = [B.take (fromIntegral n) b] -passwordPadding :: Foldable f => f ByteString -> f ByteString -> ByteString -> ByteString -> ByteString -> ByteString-passwordPadding = passwordPaddingBytes 8413+takeBs' :: Int64 -> [ ByteString ] -> [ ByteString ]+takeBs' n bs = if haveEnough then takeBs n bs else []+  where+    len = fromIntegral . B.length+    haveEnough = any (>= n) (scanl' (+) 0 (map len bs)) -credentialsPadding :: Foldable f => f ByteString -> ByteString -> ByteString -> ByteString-credentialsPadding credentials fillerTag domainTag-  =  cycleByteStringWithNull fillerTag (a-29)-  <> cycleByteStringWithNull domainTag    29+takeB' :: Int64 -> ByteString -> Maybe ByteString+takeB' n bs =+  -- this fromIntegral is inherently safe+  if fromIntegral (B.length bs) < n+  then Nothing+  -- this fromIntegral is safe because of the check above+  else Just (B.take (fromIntegral n) bs)++assertTakeB' :: Int64 -> ByteString -> ByteString+assertTakeB' = (maybe (error "not enough bytes") id <$>) . takeB'++nullBuffer :: ByteString+nullBuffer = B.replicate 64 0++-- | Partition a bytestring into chunks of up to a given size++chunkify :: Int -> ByteString -> [ ByteString ]+chunkify n = go   where-    al = encodedVectorByteLength credentials-    a  = add64WhileLt (122 - al) 32+    go bs+      | B.null bs = []+      | otherwise = bs0 : go bs1+        where (bs0, bs1) = B.splitAt n bs++-- | Partition a cyclically extended bytestring into chunks of+--   a given size, starting at a given offset.+--+--   Note that repetitions of the original string get a single+--   null byte placed between them.++chunkifyCycle+  :: Int64 -- ^ Desired chunk size+  -> ByteString -- ^ String to be cyclically extended.+  -> Int64 -- ^ Starting offset+  -> [ ByteString ] -- ^ Infinite stream of chunks+chunkifyCycle len bs = go+  where+    modN pos = pos `mod` (fromIntegral (B.length bs) + 1)+    ext = B.concat (bs:takeBs len (cycle ["\x00", bs]))+    go (modN -> pos) = assertTakeB' len (B.drop (fromIntegral pos) ext) : go (pos + len)

@@ -0,0 +1,112 @@+{-# LANGUAGE OverloadedStrings, ViewPatterns #-}++-------------------------------------------------------------------------------+-- |+-- Module:      Crypto.Encoding.PHKDF.V1+-- Copyright:   (c) 2024 Auth Global+-- License:     Apache2+--+-------------------------------------------------------------------------------++module Crypto.Encoding.PHKDF.V1 where++import Data.Monoid((<>))+import Data.ByteString(ByteString)+import Data.Foldable(Foldable)+import qualified Data.ByteString as B++import Crypto.Encoding.PHKDF(add64WhileLt)+import Crypto.Encoding.SHA3.TupleHash++-- FIXME: most of the older parts of this module should be deleted, but+--        need to move to something better first.++cycleByteStringToList :: ByteString -> Int -> [ByteString]+cycleByteStringToList str outBytes =+    if outBytes <= 0+    then []+    else if n == 0+         then [ B.replicate outBytes 0 ]+         else replicate q str ++ [B.take r str]+  where+    n = B.length str+    (q,r) = outBytes `quotRem` n++cycleByteStringWithNullToList :: ByteString -> Int -> [ByteString]+cycleByteStringWithNullToList str outBytes = out+  where+    out = cycleByteStringToList (str <> "\x00") outBytes++cycleByteString :: ByteString -> Int -> ByteString+cycleByteString str outBytes = B.concat (cycleByteStringToList str outBytes)++cycleByteStringWithNull :: ByteString -> Int -> ByteString+cycleByteStringWithNull str outBytes =+    B.concat (cycleByteStringWithNullToList str outBytes)++extendTagToList :: ByteString -> [ByteString]+extendTagToList tag = if n <= 19 then [tag] else tag'+  where+    n = B.length tag+    x = (18 - n) `mod` 64+    tag' = cycleByteStringWithNullToList tag (n+x)+         ++ [B.singleton (fromIntegral x)]++extendTag :: ByteString -> ByteString+extendTag = B.concat <$> extendTagToList++trimExtTag :: ByteString -> Maybe ByteString+trimExtTag extTag+  | n <= 19 = Just extTag+  | extTag /= extendTag tag = Nothing+  | otherwise = Just tag+  where+    n = B.length extTag+    x = B.last extTag+    tag = B.take (n - fromIntegral x - 1) extTag++{--++FIXME: as written, this only works on signed arithmetic, unless the modulus @a@+is a power of 2, such as 64++-- | @addWhileLt a b c@ is equivalent to  @while (b < c) { b += a }; return b@+addWhileLt :: Integral a => a -> a -> a -> a+addWhileLt a b c+   | b >= c = b+   | otherwise = c + ((b - c) `mod` a)++--}++-- | @add64WhileLt b c@ is equivalent to  @while (b < c) { b += 64 }; return b@++usernamePadding :: Foldable f => f ByteString -> ByteString -> ByteString -> ByteString+usernamePadding headerExtract fillerTag domainTag+  =  cycleByteStringWithNull fillerTag (a-32)+  <> cycleByteStringWithNull domainTag    32+  where+    al = encodedVectorByteLength headerExtract+    a  = add64WhileLt (157 - al) 32++passwordPaddingBytes :: Foldable f => Int -> f ByteString -> f ByteString -> ByteString -> ByteString -> ByteString -> ByteString+passwordPaddingBytes bytes headerUsername headerLongTag fillerTag domainTag password+  =  cycleByteStringWithNull fillerTag (c-32)+  <> cycleByteStringWithNull domainTag    32+  where+    al = encodedVectorByteLength headerLongTag+    a  = add64WhileLt (bytes - al) 3240+    bl = encodedVectorByteLength headerUsername+    b  = add64WhileLt (a - bl) 136+    cl = encodedByteLength password+    c  = add64WhileLt (b - cl) 32++passwordPadding :: Foldable f => f ByteString -> f ByteString -> ByteString -> ByteString -> ByteString -> ByteString+passwordPadding = passwordPaddingBytes 8413++credentialsPadding :: Foldable f => f ByteString -> ByteString -> ByteString -> ByteString+credentialsPadding credentials fillerTag domainTag+  =  cycleByteStringWithNull fillerTag (a-29)+  <> cycleByteStringWithNull domainTag    29+  where+    al = encodedVectorByteLength credentials+    a  = add64WhileLt (122 - al) 32

@@ -1,384 +1,576 @@-{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE OverloadedStrings, BangPatterns, ScopedTypeVariables #-} --- | The Password Hash Key Derivation Function (PHKDF) is a unification,---   synthesis, and distillation of PBKDF2, HKDF, and TupleHash. It was---   designed as a building block for implementing a variety of---   self-documenting cryptographic constructions.------   This module is intended more as a demonstration of and cookbook for---   what can be done with the PHKDF primitives.  For actual deployments,---   consider if the Global Password Prehash Protocol (G3P) is more---   appropriate for your needs.  The G3P is a variant of 'phkdfPass' that---   additionally integrates bcrypt as the primary key-stretching component.------   These examples also serve as design studies that help informally justify---   the G3P. Within my design framework, I've tried to maximize the benefits---   while managing implementation costs.------   1. Every bit of every parameter matters. Every boundary between---      parameters matter. There aren't supposed to be any trivial collisions,---      the only exception being null-extension collisions on the seguid.------   2. Except for the tweaks, any change to any parameter requires restarting---      the PHKDF key-stretching computation from somewhere in the very first---      call to HMAC.------   3. All input arguments are hardened against length-related timing side---      channels in various different ways.------      At one extreme, the username, password, and long tag have the most---      aggressive length hardening in the conventional sense, exhibiting no---      timing side channels except on multi-kilobyte inputs, after which---      the timing impacts are minimzed.------      At another extreme, the domain tag exhibits severe yet predictable---      timing side channels transitioning from 19 to 20 bytes and every 64---      bytes thereafter.  However, the domain tag is otherwise free of---      timing-based side channels, so it too is hardened in its own way.+-------------------------------------------------------------------------------+-- |+-- Module:      Crypto.PHKDF+-- Copyright:   (c) 2024 Auth Global+-- License:     Apache2 -----   The design I converged upon employs fairly complicated data encoding---   procedures. Unfortunately, this provides a fair bit of surface area---   for subtly wrong implementations that work most of the time, but will---   return garbage on certain lengths of inputs. I hope that this will---   eventually be remediated with a more comprehensive suite of test vectors.+------------------------------------------------------------------------------- -module Crypto.PHKDF where+{- | +This module provides an interface to Version 2 of PHKDF, especially the+following function:++@+phkdfStream :: BitString -> [BitString] -> Word32 -> BitString -> Stream ByteString+phkdfStream key args counter tag = [output0, output1 ..]+  where+    output0 = hmac key (encode args ++ encode  counter      ++ tag)+    output1 = hmac key (output0     ++ encode (counter + 1) ++ tag)+    output2 = hmac key (output1     ++ encode (counter + 2) ++ tag)+    ...+@++This hash function exhibits a misleading resemblance to HKDF, with the @key@+corresponding to HKDF's @salt@, the @msgs@ parameter corresponding to HKDF's+@ikm@ (initial keying material), and the @counter@ and @tag@ parameters+corresponding to HKDF's info parameter.++@+hkdf :: BitString -> BitString -> ByteString -> [ByteString]+hkdf salt ikm info = [output1, output2 .. output255]+  where+    key = hmac salt ikm+    output1 = hmac key            (info ++ encodeWord8 1)+    output2 = hmac key (output1 ++ info ++ encodeWord8 2)+    output3 = hmac key (output2 ++ info ++ encodeWord8 3)+    ...+@++However this is a false cognate. The first thing to notice about @phkdfStream@+is that it doesn't matter how secure the @args@ parameter is, if you use a+publicly known key, counter, and tag, then revealing a full output block reveals+the remainder of the output stream.++This is in contrast to @hkdf@, which allows secret initial keying material and+publicly-known salt and info parameters to be expanded into a large number of+output blocks. These blocks can be divvied up into non-overlapping pieces that+may be revealed independently of each other.++Thus @phkdfStream@ is actually a much lower-level hash function than @hkdf@. As+such has it's own /modes of operation/, which provide various different answers+for this issue of output stream predictability. Building a proper replacement+for @hkdf@ requires combining two or more calls to @phkdfStream@ in different+modes of operation.++The first and simplest mode of operation for @phkdfStream@ is to simply discard+all but the first output block. In this case, @phkdfStream@ simplifies to a call+to HMAC with the addition of TupleHash style encoding, and custom end-of-message+padding determined by the counter and tag. Thus we can use this mode to+implement the key extraction portion of an HKDF-like hash function.++In this mode of operation, we can safely use @phkdfStream@ with secret initial+keying materials and optionally non-secret salt, counter, and tag, and possibly+even reveal the output.  After all it doesn't matter if anybody can predict the+remainder of the stream if it's never been granted any meaning.++The second mode of operation is to use @phkdfStream@ with a secret key,+non-secret arguments, and optionally secret counter and tag.  In this mode, we+can reveal arbitrary non-overlapping portions of the output stream to third+parties, without worry that one portion can be derived from another.++Thus we can implement a variant of the HKDF construction using these two modes+of operation in conjunction with each other:++@+hkdfSimple :: BitString -> [BitString] -> BitString -> Stream ByteString+hkdfSimple salt ikms tag = out+  where+    key = head $ phkdfStream salt ikms inCtr tag+    out = phkdfStream key echoArgs outCtr tag++    echoArgs = ["hkdf-simple"]+    inCtr    = word32 "IN\x00\x00"+    outCtr   = word32 "OUT\x00"+@++If the recommendations of NIST SP 800-108 are to be followed strictly, one+shouldn't examine more than 2^32 output blocks which is about 137.4 GB of+output from @hkdfSimple@. I don't think this will be a problem in practice,+as this particular CSPRNG is not overly well suited to generating large amounts+of pseudorandom data.++However, we must be aware of the /echo args gotcha/: for reasons intimately+related to the predictability of @phkdfStream@ with a non-secret key, counter,+and tag, the @echoArgs@ parameter must not include any important new secrets.++This time we are deriving a secret key using initial keying material. However,+if that material is potentially guessable, then introducing a high-entropy+secret in the @echoArgs@ parameter will secure the first output block, but+revealing two output blocks would re-reveal the ability to guess the original+keying material.++Thus all secrets should be included in the derivation of the key, or possibly+included in the tag parameter. A secret counter can also help, but cannot+provide a sufficient level of entropy tmo secure the output all by itself.++One of HKDF's design principles was to obtain a clean seperation between the+extraction and expansion phases.  This seperation allows HKDF's design to avoid+the /echo args gotcha/ by specifying that the echo args is the empty string.++In a literal, low-level sense, @phkdfStream@ intentionally violates this+seperation. In a metaphorical, higher-level sense, @phkdf@ affirms this design+principle, rather @phkdf@'s' goal is to allow a single primitive to serve both+roles. This unification makes it easy to create cryptographic hash protocols+where every call to HMAC is covered by a directly self-documenting plaintext tag.++Moreover, the alternative to PBKDF2 is phkdf's slow extraction function, which+makes crucial use of the /echo args gotcha/.  This brings us to the third mode+of operation, which keeps the output stream secret, except possibly for the very+last output block examined.++Each mode of operation provides an answer to the predictability of @phkdfStream@.+Our first answer is to make it irrelevant that the output stream is predictable.+Our second answer achieves unpredictability by using a key, counter, and/or tag+that is secret. The third answer achieves unpredictability by keeping the output+stream secret, allowing a publicly-known key, counter, and tag to be used as+self-documenting domain seperation constants.++Thus phkdf's slow extraction function calls @phkdfStream@ to generate a stream+that is allowed to be predictable, but at an unpredictable starting point. This+predictable stream remains secret, and is immediately consumed by a second call+to @phkdfStream@. After @rounds + 1@ blocks have been produced and consumed, the+second call to @phkdfStream@ has an opportunity to add some additional+post-key-stretching tweaks before the output stream is finalized.++Conceptually, the slow extraction function looks like this:++@+phkdfSlowExtract ::+    BitString -> [BitString] -> Word32 -> BitString ->+    ByteString -> Word32 -> [BitString] -> Stream ByteString+phkdfSlowExtract key args counter tag fnName rounds tweaks = out+  where+    blocks = take (rounds + 1) $ phkdfStream key args counter tag+    header = [makePadding fnName rounds, makeLongString tag blocks]+    out = phkdfStream key (header ++ tweaks) (counter + rounds + 1) tag+@++Compared to PBKDF2, @phkdfSlowExtract@ uses essentially the same stream+generator, but enhanced with counters and contextual parameters.  PBKDF2 proper+then condenses that stream by xor-ing all the output blocks together.+@phkdfSlowExtract@ condenses it's internal stream by feeding it to another call+to HMAC. So @phkdfSlowExtract@ is very likely at least as strong as PBKDF2.++Again, assuming key, counter, rounds, and tag are all publicly known, which is+the primary intended use case of this function, then the output stream is+predictable. Thus the output of @phkdfSlowExtract@ must itself be subjected to+the first or third mode of operation.++If more than 32 bytes ever need to be revealed, then another call to+@phkdfStream@ with a secret key in the second mode of operation is required+for final output expansion. We do just this in our next example.++@phkdfVerySimple@ uses our flavor of not-quite-PBKDF2 to produce a pseudorandom+key to use with our flavor of not-quite-HKDF for final output expansion. Thus+the algorithm behind this construction is a portmanteau of the algorithms behind+PBKDF2 and HKDF. Thus the name.++@+phkdfVerySimple ::+    BitString -> BitString -> BitString -> BitString ->+    Word32 -> Stream ByteString+phkdfVerySimple seguid tag username password rounds = out+  where+    inArgs = [myLabel, username, password, encode rounds]++    key = head $ phkdfSlowExtract seguid inArgs inCtr tag myLabel rounds []++    out = phkdfStream key [myLabel] outCtr tag++    myLabel = "phkdf-very-simple"+    inCtr   = word32 "IN\x00\x00"+    outCtr  = word32 "OUT\x00"+@++@phkdfVerySimple@ is a distillation of the core features of the @phkdfSimple@+function exported from the @Crypto.PHKDF@ module, containing the most salient+features of that more fully worked construction.++Not only does @phkdfVerySimple@ provide key stretching very similar in flavor+to PBKDF2, but it also infuses the entire key-stretching process with+cryptoacoustic repetitions of the plaintext of the tag. This amplifies the+minimum obfuscation overhead associated with any tag obscuration attack that is+truly secure against the best reverse engineers. This in turns reduces the+minimum obfuscation overhead associated with a single application of SHA256+in order for the overall construction to be cryptoacoustically viable.++@phkdfVerySimple@ encodes the number of rounds to be performed in the+key-stretching phase in order to ensure that changing the number of rounds+requires a full key-stretching recomputation. This is necessary because it is+possible to share portions of @phkdfSlowExtract@'s key-stretching computation+when the @rounds@ parameter is varied while holding the input arguments+constant. Including an encoding of the @rounds@ parameter in the input arguments+forces both to be varied, thus forcing a full recomputation.+-}++module Crypto.PHKDF+  ( HmacKey()+  , hmacKey+  , PhkdfCtx()+  , phkdfCtx+  , phkdfCtx_init+  , phkdfCtx_initHashed+  , phkdfCtx_initPrefixed+  , phkdfCtx_initLike+  , phkdfCtx_hmacKeyPlain+  , phkdfCtx_hmacKeyHashed+  , phkdfCtx_hmacKeyPrefixed+  , phkdfCtx_hmacKey+  , phkdfCtx_hmacKeyLike+  , phkdfCtx_toResetHmacCtx+  , phkdfCtx_reset+  , phkdfCtx_feedArg+  , phkdfCtx_feedArgs+  , phkdfCtx_feedArgsBy+  , phkdfCtx_feedArgConcat+  , phkdfCtx_finalize+  , phkdfCtx_finalizeHmac+  , phkdfCtx_toHmacCtx+  , phkdfCtx_toHmacKeyPrefixed+  , phkdfCtx_toStream+  , phkdfCtx_toGen+  , phkdfCtx_byteCount+  , phkdfCtx_endPaddingLength+  , phkdfCtx_blockPaddingLength+{--+--- FIXME: add an updated xor-based SlowCtx, closer to PBKDF2+  , PhkdfSlowCtx()+  , phkdfSlowCtx_extract+  , phkdfSlowCtx_feedArg+  , phkdfSlowCtx_feedArgs+  , phkdfSlowCtx_finalize+  , phkdfSlowCtx_toStream+--}+  , PhkdfGen()+  , phkdfGen+  , phkdfGen_init+  , phkdfGen_initHashed+  , phkdfGen_initPrefixed+  , phkdfGen_initLike+  , phkdfGen_hmacKeyPlain+  , phkdfGen_hmacKeyHashed+  , phkdfGen_hmacKeyPrefixed+  , phkdfGen_hmacKey+  , phkdfGen_hmacKeyLike+  , phkdfGen_head+  , phkdfGen_read+  , phkdfGen_peek+  , phkdfGen_toStream+  ) where++import           Control.Arrow((>>>))+import           Data.Bits((.&.), complement) import           Data.ByteString (ByteString) import qualified Data.ByteString as B import           Data.Function((&))+import           Data.Foldable(Foldable, foldl') import           Data.Word-import           Data.Stream (Stream)-import           Data.Vector (Vector)-import qualified Data.Vector as V-import           Network.ByteOrder (word32)+import           Data.Stream (Stream(..))+import qualified Data.Stream as Stream+import           Network.ByteOrder (bytestring32) +import           Crypto.Sha256 as Sha256+import           Crypto.PHKDF.HMAC+import           Crypto.PHKDF.HMAC.Subtle+import           Crypto.PHKDF.Subtle import           Crypto.Encoding.PHKDF import           Crypto.Encoding.SHA3.TupleHash-import           Crypto.PHKDF.Primitives-import           Crypto.PHKDF.Primitives.Assert --- | These input parameters are grouped together because the envisioned use---   for them is that they are constants (or near-constants) specified by---   a deployment. User-supplied inputs would typically not go here.------   The seguid parameter acts as a deployment-wide salt. Cryptographically---   speaking, the most important thing a deployment can do is specify a---   constant seguid.  It is highly recommended that the seguid input be a---   genuine Self-Documenting Globally Unique Identifier attesting to the---   parameters, purposes, and public playbook of the protocol for y'all---   to follow.------   In more concrete cryptographic terms, the seguid parameter is the constant---   HMAC key used by the protocol right up until the final output exansion.---   This design is closely modelled on the HKDF construction. As such, adding---   null bytes onto the ends of seguids that are less than 64 bytes long---   should be the only source of trivial collisions in the entire protocol.------   The remaining parameter strings are all directly-documenting plaintext---   tags. A deployment can use these tags to encode a message into the password---   hash function so that it must be known to whomever is hashing a password---   of their choice.------   Finally, the rounds parameter determines the latency of the function.---   At least 250,000 rounds are recommended if PHKDF is used as the sole key---   stretching component of a password hash database.------   Unfortunately PHKDF is inexpensively parallelized, so large investments---   here aren't a good expenditure of a user's latency budget. This is why---   the G3P integrates bcrypt, and cuts the suggested rounds down to 20,000------   For comparison, @n@ rounds of PHKDF is approximately equivalent to---   @(1.5 + dtl)*n + c@ rounds  of PBKDF2, where @dtl@ is related to the domain---   tag length, and c is a bit larger than 130 or so.------   Here, @dtl@ is 0 when the domain tag is between 0 and 19 bytes long, 0.5---   when the domain tag is between 20 and 83 bytes long, and an additional 0.5---   for every 64 bytes thereafter.  Thus these functions exhibit extreme---   timing side channels on the length of the domain tag.------   By contrast, the long tag is hardened against timing side channels up to---   a bit less than 5 kilobytes in length.  However, an extremely long tag---   does reduce the headroom provided to masking the length of the username---   and password fields,  however the minimum headroom allocated to the---   username and password fields is a bit less than 3 kilobytes.------   As an alternate tagging location, consider the 'phkdfInputArgs_credentials'---   vector, which can be used as an inexpensive, pay-as-you-go plaintext---   tagging location.------   If the total encoded byte length of 'phkdfInputBlock_tags' is between 0-63---   bytes, then these hash protocols operate in a constant number of SHA256---   blocks.  Every additional 64 bytes incurs the computation of two or three---   additional SHA256 blocks, because these tags are hashed into the result---   two times in the case of 'phkdfPass', and three times in the case of---   'phkdfSimple' (and @g3pHash@).+import           Control.Exception(assert) -data PhkdfInputBlock = PhkdfInputBlock-  { phkdfInputBlock_seguid     :: !ByteString-    -- ^ HMAC-SHA256 key, usable as a high-repetition indirect tag via-    --   self-documenting globally unique identifiers (seguids).-  , phkdfInputBlock_domainTag  :: !ByteString-    -- ^ plaintext tag with one repetition per round.  0-19 bytes are free,-    --   20-83 bytes cost a additional sha256 block per round, with every-    --   64 bytes thereafter incurring a similar cost.-  , phkdfInputBlock_longTag    :: !ByteString-    -- ^ plaintext tag with 1x repetition, then cycled for roughly-    --   8 kilobytes.  Constant time on inputs up to nearly 5 kilobytes.-  , phkdfInputBlock_tags       :: !(Vector ByteString)-    -- ^ plaintext tag with 2x repetition ('phkdfPass') or 3x repetition-    --   ('phkdfSimple'). Constant-time on 0-63 encoded bytes, which includes-    --   the length encoding of each string. Thus 60 of those bytes are usable-    --   if the tags vector is a single string, or less if it contains two or-    --   more strings.-  , phkdfInputBlock_rounds     :: !Word32-    -- ^ how expensive will this hash function be? An optimal implementation-    --   computes exactly three SHA256 blocks per round if the domain tag is-    --   19 bytes or less.  It is not recommended that phkdf be used as the-    --   primary key-stretching component of a deployment, but if it is used-    --   this way, we recommend at least 250,000 rounds.  This can be adjusted-    --   downward in the case of domain tags longer than 19 bytes.-  } deriving (Eq, Ord, Show)+-- | initialize an empty @phkdfStream@ context from a plaintext HMAC key. --- | The username and password are grouped together because they are normally---   expected to be supplied by users or other observers of a deployment.------   Furthermore, the credentials vector is here because it is an ideal---   location to include other user input. For example, one could implement---   a Two-Secret Key Derivation (2SKD) scheme analogous to 1Password's.------   A deployment can also specify additional constant tags as part of the---   credentials vector.  As the plaintext of these tags is only ever hashed---   into the output a single time, this is the least expensive---   pay-as-you-go option for plaintext tagging.------   The credentials vector is constant time on 0-63 encoded bytes, incurring---   one additional SHA256 block every 64 bytes thereafter. This includes---   a variable-length field that encodes the bit length of each string; this---   field itself requires 2 or more bytes.------   The username and password are constant time as long as their encoded---   lengths add up to less than roughly 3 kilobytes, or the username,---   password, and domain tag add up to less than roughly 8 kilobytes.---   The actual numbers are somewhat less in both cases, but this is a---   good approximation.+phkdfCtx :: ByteString -> PhkdfCtx+phkdfCtx = phkdfCtx_init . hmacKey -data PhkdfInputArgs = PhkdfInputArgs-  { phkdfInputArgs_username    :: !ByteString-  -- ^ The name of this parameter is suggestive, but this parameter is-  --   functionally identical to a second password. The only difference-  --   is the fact that a password can be cracked without knowledge of the-  --   plaintext username. By contrast, the password acts as a plaintext tag-  --   if one provides the username: guessing the username implies plaintext-  --   knowledge of the password.-  , phkdfInputArgs_password    :: !ByteString-  , phkdfInputArgs_credentials :: !(Vector ByteString)-  } deriving (Eq, Ord, Show)+-- | initialize an empty @phkdfStream@ context from a plaintext or precomputed HMAC key. --- | These parameters are used to tweak the final output, without redoing any---   expensive key stretching.  A possible use case is including a high entropy---   secret in the role itself that isn't available until after a successful---   stage of authentication.------   Since these parameters are processed in a context that could conceivably be---   performance sensitive, we don't apply any length padding or side-channel---   hardening.  Instead we opt for maximizing free tagging space.  Thus we---   want to avoid incurring additional SHA256 block computations, one of the---   favorite techniques employed by the key-stretching phase of 'phkdfPass'---   to harden against timing side-channels.------   A deployment could conceivably harden this expansion phase against timing---   side channels themselves, if the were sufficiently inclined. There are---   several techniques. For starters, a deployment could specify an additional---   variable-length string in the role vector, used to control its relative---   ending position inside the SHA256 buffer.+phkdfCtx_init :: HmacKey -> PhkdfCtx+phkdfCtx_init = phkdfCtx_initLike . hmacKeyLike_init -data PhkdfInputTweak = PhkdfInputTweak-  { phkdfInputTweak_role :: !(Vector ByteString)-  , phkdfInputTweak_echoTag  :: !ByteString-  } deriving (Eq, Ord, Show)+-- | initialize an empty @phkdfStream@ context from a plaintext, precomputed, or buffer-prefixed HMAC key. --- | A plain-old-data explicit representation of the intermediate 'phkdfPass'---   computation after the 'PhkdfInputBlock' and 'PhkdfInputArgs' have been---   processed and key stretching has been completed, but before the tweaks---   have been applied and the final output generated.------   If you ever need to serialize or persist a seed, you probably want this.------   Intended to be generated by 'phkdfPass_seedInit' and then consumed---   without modification by 'phkdfPass_seedFinalize'.+phkdfCtx_initLike :: HmacKeyLike -> PhkdfCtx+phkdfCtx_initLike key =+  PhkdfCtx {+    phkdfCtx_byteCount = hmacKeyLike_byteCount key,+    phkdfCtx_state = hmacKeyLike_ipadCtx key,+    phkdfCtx_hmacKeyLike = key+  } -data PhkdfSeed = PhkdfSeed-  { phkdfSeed_seguid :: !ByteString-  , phkdfSeed_seguidKey :: !HmacKey-  , phkdfSeed_domainTag :: !ByteString-  , phkdfSeed_secret :: !ByteString-  } deriving (Eq)+-- | initialize an empty @phkdfStream@ context from a precomputed HMAC key. --- | A non-tweakable, complete password prehash protocol+phkdfCtx_initHashed :: HmacKeyHashed -> PhkdfCtx+phkdfCtx_initHashed = phkdfCtx_init . hmacKeyHashed_toKey -phkdfSimple :: PhkdfInputBlock -> PhkdfInputArgs -> Stream ByteString-phkdfSimple block args = echo+-- | initialize an empty @phkdfStream@ context from a buffer-prefixed HMAC key.++phkdfCtx_initPrefixed :: ByteString -> HmacKeyPrefixed -> PhkdfCtx+phkdfCtx_initPrefixed str key = PhkdfCtx+    { phkdfCtx_byteCount = hmacKeyPrefixed_byteCount key+                         + fromIntegral (B.length str)+    , phkdfCtx_state = sha256_update (hmacKeyPrefixed_ipadCtx key) str+    , phkdfCtx_hmacKeyLike = hmacKeyLike_initPrefixed key+    }++-- | Retrieve the HmacKeyPlain that the phkdfCtx was originally+--   initialized with, if possible++phkdfCtx_hmacKeyPlain :: PhkdfCtx -> Maybe HmacKeyPlain+phkdfCtx_hmacKeyPlain = hmacKeyLike_toPlain . phkdfCtx_hmacKeyLike++-- | Retrieve the HmacKeyHashed that the phkdfCtx was originally+--   initialized with, if possible++phkdfCtx_hmacKeyHashed :: PhkdfCtx -> Maybe HmacKeyHashed+phkdfCtx_hmacKeyHashed = hmacKeyLike_toHashed . phkdfCtx_hmacKeyLike++-- | Retrieve the HmacKeyPrefixed that the phkdfCtx was originally+--   initialized with.++phkdfCtx_hmacKeyPrefixed  :: PhkdfCtx -> HmacKeyPrefixed+phkdfCtx_hmacKeyPrefixed = hmacKeyLike_toPrefixed . phkdfCtx_hmacKeyLike++-- | Retrieve the HmacKey that the phkdfCtx was originally+--   initialized with, if possible.++phkdfCtx_hmacKey :: PhkdfCtx -> Maybe HmacKey+phkdfCtx_hmacKey = hmacKeyLike_toKey . phkdfCtx_hmacKeyLike++-- | initialize a new empty @phkdfStream@ context from the HMAC key+--   originally supplied to the context, discarding all arguments already added.++phkdfCtx_reset :: PhkdfCtx -> PhkdfCtx+phkdfCtx_reset = phkdfCtx_initLike . phkdfCtx_hmacKeyLike++-- | initialize a new empty HMAC context from the key originally supplied to+--   the PHKDF context, discarding all arguments already added.++phkdfCtx_toResetHmacCtx :: PhkdfCtx -> HmacCtx+phkdfCtx_toResetHmacCtx = hmacKeyLike_run . phkdfCtx_hmacKeyLike++-- FIXME? what should happen when the SHA256 counters overflow?+--        (As SHA-256 can handle 2.3e6 TB, this isn't a pressing issue.)++-- | append a single string onto the end of @phkdfStream@'s list of+--   arguments.++phkdfCtx_feedArg :: ByteString -> PhkdfCtx -> PhkdfCtx+phkdfCtx_feedArg str = phkdfCtx_unsafeFeed [len, str]   where-    -- Explicitly unpack everything for the unused variable warnings.-    -- i.e. It's relatively easy to check that we've unpacked every-    -- field, then we can rely on unused variable warnings to ensure-    -- we have in fact made use of everything.-    domainTag = phkdfInputBlock_domainTag block-    seguid = phkdfInputBlock_seguid block-    longTag = phkdfInputBlock_longTag block-    tags = phkdfInputBlock_tags block-    rounds = phkdfInputBlock_rounds block+    len = leftEncodeFromBytes (B.length str)+-- | append zero or more strings onto the end of @phkdfStream@'s list of+--   arguments. -    username = phkdfInputArgs_username args-    password = phkdfInputArgs_password args-    credentials = phkdfInputArgs_credentials args+phkdfCtx_feedArgs :: Foldable f => f ByteString -> PhkdfCtx -> PhkdfCtx+phkdfCtx_feedArgs params ctx = foldl' (flip phkdfCtx_feedArg) ctx params -    headerExtract = [ "phkdf-simple0 username", username ]+phkdfCtx_feedArgsBy :: Foldable f => (a -> ByteString) -> f a -> PhkdfCtx -> PhkdfCtx+phkdfCtx_feedArgsBy f params ctx0 = foldl' delta ctx0 params+  where delta ctx a = phkdfCtx_feedArg (f a) ctx -    headerUsername = headerExtract ++ [ usernamePadding headerExtract domainTag domainTag ]-    -- password field goes here+phkdfCtx_feedArgConcat :: Foldable f => f ByteString -> PhkdfCtx -> PhkdfCtx+phkdfCtx_feedArgConcat strs =+    phkdfCtx_unsafeFeed [len] >>>+    phkdfCtx_unsafeFeed strs+  where+    len = leftEncodeFromBytes (foldl' delta 0 strs)+    delta tot str = tot + B.length str -    headerLongTag =-      [ longTag-      , B.concat-        [ "password-hash-key-derivation-function phkdf-simple0\x00"-        , leftEncodeFromBytes (B.length domainTag)-        , bareEncode rounds-        ]-      ]+-- | close out a @phkdfStream@ context using the first mode of operation,+--   examining only the first output block and discarding the rest of the+--   stream. -    secretKey =-        phkdfCtx_init seguid &-        phkdfCtx_addArgs headerUsername &-        phkdfCtx_assertBufferPosition 32 &-        phkdfCtx_addArg  password &-        phkdfCtx_addArgs headerLongTag &-        -- FIXME: fusing addArg and passwordPadding can save ~ 8 KiB RAM-        phkdfCtx_addArg (passwordPadding headerUsername headerLongTag longTag domainTag password) &-        phkdfCtx_assertBufferPosition 32 &-        phkdfCtx_addArgs credentials &-        phkdfCtx_addArg (credentialsPadding credentials longTag domainTag) &-        phkdfCtx_assertBufferPosition 29 &-        phkdfCtx_addArgs tags &-        phkdfCtx_addArg (bareEncode (V.length tags)) &-        phkdfSlowCtx_extract-            (cycleByteStringWithNull domainTag)-            (word32 "go\x00\x00" + 2023) domainTag-            "phkdf-simple0 compact" rounds &-        phkdfSlowCtx_assertBufferPosition 32 &-        phkdfSlowCtx_addArgs tags &-        phkdfSlowCtx_finalize (cycleByteStringWithNull domainTag)+phkdfCtx_finalize+  :: (Int -> ByteString) -- ^ end-of-message padding, output length must be equal to the number provided+  -> Word32 -- ^ counter+  -> ByteString -- ^ tag+  -> PhkdfCtx+  -> ByteString+phkdfCtx_finalize genFillerPad counter tag ctx =+    phkdfCtx_toGen genFillerPad counter tag ctx &+    phkdfGen_head -    -- Harden the tags vector against length-based timing side-channels-    echoHeader = cycleByteStringWithNull "phkdf-simple0 expand echo" 30+-- | Turn a 'PhkdfCtx' into a incomplete call to @hmac@, with the option of+--   adding additional data to the end of the message that need not be+--   TupleHash encoded. -    echo = phkdfCtx_init secretKey &-           phkdfCtx_addArg echoHeader &-           phkdfCtx_assertBufferPosition 32 &-           phkdfCtx_addArgs tags &-           phkdfCtx_finalizeStream (cycleByteStringWithNull domainTag) (word32 "OUT\x00") domainTag+phkdfCtx_toHmacCtx :: PhkdfCtx -> HmacCtx+phkdfCtx_toHmacCtx ctx =+  (phkdfCtx_toResetHmacCtx ctx) {+    hmacCtx_ipadCtx = phkdfCtx_state ctx+  } --- | A tweakable, complete prehash protocol.   Note that this function is very---   intentionally implemented in such a way that the following idiom is---   efficient, and only performs the expensive key stretching phase once:------ @---  let mySeed = phkdfPass block args---   in [ mySeed tweak1, mySeed tweak2, mySeed tweak3 ]--- @------   However in the case that you want or need to persist or serialize the---   intermediate seed, then the plain-old-datatype 'PhkdfSeed' and its---   companion functions 'phkdfPass_seedInit' and 'phkdfPass_seedFinalize'---   are likely to be more appropriate.+-- | Turn a 'PhkdfCtx' into a 'HmacKeyPrefixed' by adding a null byte followed+--   by 0-63 bytes as needed to get to a SHA256 block boundary -phkdfPass :: PhkdfInputBlock -> PhkdfInputArgs -> PhkdfInputTweak -> Stream ByteString-phkdfPass block args = phkdfPass_seedInit block args & phkdfPass_seedFinalize+phkdfCtx_toHmacKeyPrefixed+  :: (Int -> ByteString) -- ^ block synchronization padding, ouput length must be equal to the number provided+  -> PhkdfCtx+  -> HmacKeyPrefixed+phkdfCtx_toHmacKeyPrefixed genFillerPad ctx =+  HmacKeyPrefixed+  { hmacKeyPrefixed_ipadCtx = ipadCtx'+  , hmacKeyPrefixed_opad = hmacKeyLike_opad (phkdfCtx_hmacKeyLike ctx)+  }+  where+    blockPadLen = phkdfCtx_blockPaddingLength ctx --- | This generates a seed, which encapsulates the expensive key-stretching component of 'phkdfPass' into a reusable, tweakable cryptographic value.  This function is way slower than it's companion, 'phkdfPass_seedFinalize'.  Broadly comparable to HKDF-Extract, though with key stretching built-in.+    blockPadding = genFillerPad blockPadLen -phkdfPass_seedInit :: PhkdfInputBlock -> PhkdfInputArgs -> PhkdfSeed-phkdfPass_seedInit block args =-    PhkdfSeed {-      phkdfSeed_seguid = seguid,-      phkdfSeed_seguidKey = seguidKey,-      phkdfSeed_domainTag = domainTag,-      phkdfSeed_secret = secret-    }+    ctx' = phkdfCtx_unsafeFeed ["\x00",blockPadding] ctx++    paddingIsValid = phkdfCtx_byteCount ctx' `mod` 64 == 0+                  && B.length blockPadding == blockPadLen++    ipadCtx' = assert paddingIsValid $ phkdfCtx_state ctx'++-- | "improperly" close out a 'PhkdfCtx' as if it were a call to @hmac@ instead+--   of @phkdfStream@, though with a TupleHash message encoding.++phkdfCtx_finalizeHmac :: PhkdfCtx -> ByteString+phkdfCtx_finalizeHmac = hmacCtx_finalize_toByteString . phkdfCtx_toHmacCtx++-- | close out a @phkdfStream@ context with a given counter and tag++phkdfCtx_toStream :: (Int -> ByteString) -> Word32 -> ByteString -> PhkdfCtx -> Stream ByteString+phkdfCtx_toStream genFillerPad counter0 tag ctx =+  phkdfCtx_toGen genFillerPad counter0 tag ctx &+  phkdfGen_toStream++-- | How long would the end padding be if the PhkdfCtx was finalized?++phkdfCtx_endPaddingLength :: PhkdfCtx -> Int+phkdfCtx_endPaddingLength ctx =+  fromIntegral ((31 - phkdfCtx_byteCount ctx) .&. 63)++-- | How long would the block padding be if 'phkdfCtx_toHmacKeyPrefixed' is+--   called?++phkdfCtx_blockPaddingLength :: PhkdfCtx -> Int+phkdfCtx_blockPaddingLength ctx =+  fromIntegral ((63 - phkdfCtx_byteCount ctx) .&. 63)++-- actually I should probably offer a version of this function with permuted+-- arguments, as there is at least one potentially useful partial application+-- here, namely the block computations involved in processing the+-- end-of-message padding. This partial application requires that PhkdfCtx+-- and genFillerPad must come first.++phkdfCtx_toGen+  :: (Int -> ByteString) -- ^ end-of-message padding, output length must be equal to the number provided+  -> Word32  -- ^ counter+  -> ByteString -- ^ tag+  -> PhkdfCtx+  -> PhkdfGen+phkdfCtx_toGen genFillerPad counter0 tag ctx =+    PhkdfGen+      { phkdfGen_hmacKeyLike = phkdfCtx_hmacKeyLike ctx+      , phkdfGen_extTag = extendTag tag+      , phkdfGen_counter = counter0+      , phkdfGen_state = ""+      , phkdfGen_initCtx = Just context0+      }   where-    domainTag = phkdfInputBlock_domainTag block-    seguid = phkdfInputBlock_seguid block-    longTag = phkdfInputBlock_longTag block-    seedTags = phkdfInputBlock_tags block-    rounds = phkdfInputBlock_rounds block+    endPadLen = phkdfCtx_endPaddingLength ctx -    username = phkdfInputArgs_username args-    password = phkdfInputArgs_password args-    credentials = phkdfInputArgs_credentials args+    endPadding = genFillerPad endPadLen -    headerExtract = [ "phkdf-pass-v0 username", username ]+    ctx' = phkdfCtx_unsafeFeed ["\x00",endPadding] ctx -    headerUsername = headerExtract ++ [ usernamePadding headerExtract domainTag domainTag ]+    endPaddingIsValid = phkdfCtx_byteCount ctx' `mod` 64 == 32+                     && B.length endPadding == endPadLen -    -- password field goes here+    context0 = assert endPaddingIsValid $ phkdfCtx_state ctx' -    headerLongTag =-      [ longTag-      , B.concat-        [ "password hash & key derivation function: phkdf-pass-v0"-        , bareEncode rounds-        ]-      ]+phkdfGen :: ByteString -> ByteString -> Word32 -> ByteString -> PhkdfGen+phkdfGen = phkdfGen_init . hmacKey -    seguidKey = hmacKey_init seguid+phkdfGen_init :: HmacKey -> ByteString -> Word32 -> ByteString -> PhkdfGen+phkdfGen_init = phkdfGen_initLike . hmacKeyLike_init -    secret =-        phkdfCtx_initFromHmacKey seguidKey &-        phkdfCtx_addArgs headerUsername &-        phkdfCtx_assertBufferPosition 32 &-        phkdfCtx_addArg  password &-        -- FIXME: fusing addArg and longPadding can save ~ 8 KiB RAM-        phkdfCtx_addArgs headerLongTag &-        phkdfCtx_addArg  (passwordPadding headerUsername headerLongTag longTag domainTag password) &-        phkdfCtx_assertBufferPosition 32 &-        phkdfCtx_addArgs credentials &-        phkdfCtx_addArg (credentialsPadding credentials longTag domainTag) &-        phkdfCtx_assertBufferPosition 29 &-        phkdfCtx_addArgs seedTags &-        phkdfCtx_addArg (bareEncode (V.length seedTags)) &-        phkdfSlowCtx_extract-            (cycleByteStringWithNull domainTag)-            (word32 "go\x00\x00" + 2023) domainTag-            "phkdf-pass-v0 compact" rounds &-        phkdfSlowCtx_assertBufferPosition 32 &-        phkdfSlowCtx_addArgs seedTags &-        phkdfSlowCtx_finalize (cycleByteStringWithNull domainTag)+phkdfGen_initLike :: HmacKeyLike -> ByteString -> Word32 -> ByteString -> PhkdfGen+phkdfGen_initLike key initBytes = initGen+  where+    -- Round down to the previous buffer boundary+    n = B.length initBytes .&. complement 63+    (blocks, state0) = B.splitAt n initBytes+    ipad0 = sha256_update (hmacKeyLike_ipadCtx key) blocks --- | This consumes a seed and tweaks to produce the final output stream.--- This function is the output expansion phase of 'phkdfPass'.  This function--- is way faster than it's companion 'phkdfPass_seedInit'.  Broadly comparable to--- HKDF-Expand.+    initGen counter0 tag = PhkdfGen+      { phkdfGen_hmacKeyLike = key+      , phkdfGen_extTag = extendTag tag+      , phkdfGen_counter = counter0+      , phkdfGen_state = state0+      , phkdfGen_initCtx = Just ipad0+      } -phkdfPass_seedFinalize :: PhkdfSeed ->  PhkdfInputTweak -> Stream ByteString-phkdfPass_seedFinalize seed tweak = echo+phkdfGen_initHashed :: HmacKeyHashed -> ByteString -> Word32 -> ByteString -> PhkdfGen+phkdfGen_initHashed = phkdfGen_initLike . hmacKeyLike_initHashed++phkdfGen_initPrefixed :: HmacKeyPrefixed -> ByteString -> Word32 -> ByteString -> PhkdfGen+phkdfGen_initPrefixed = phkdfGen_initLike . hmacKeyLike_initPrefixed++phkdfGen_hmacKeyPlain :: PhkdfGen -> Maybe HmacKeyPlain+phkdfGen_hmacKeyPlain = hmacKeyLike_toPlain . phkdfGen_hmacKeyLike++phkdfGen_hmacKeyHashed :: PhkdfGen -> Maybe HmacKeyHashed+phkdfGen_hmacKeyHashed = hmacKeyLike_toHashed . phkdfGen_hmacKeyLike++phkdfGen_hmacKeyPrefixed :: PhkdfGen -> HmacKeyPrefixed+phkdfGen_hmacKeyPrefixed = hmacKeyLike_toPrefixed . phkdfGen_hmacKeyLike++phkdfGen_hmacKey :: PhkdfGen -> Maybe HmacKey+phkdfGen_hmacKey = hmacKeyLike_toKey . phkdfGen_hmacKeyLike++phkdfGen_peek :: PhkdfGen -> Maybe ByteString+phkdfGen_peek gen =+  case phkdfGen_initCtx gen of+    Nothing -> Just $ phkdfGen_state gen+    Just _  -> Nothing++phkdfGen_toHmacCtx :: PhkdfGen -> HmacCtx+phkdfGen_toHmacCtx gen =+  (hmacKeyLike_run (phkdfGen_hmacKeyLike gen)) {+     hmacCtx_ipadCtx = sha256_update ipad (phkdfGen_state gen)+    }   where-    seguidKey = phkdfSeed_seguidKey seed-    domainTag = phkdfSeed_domainTag seed-    secret = phkdfSeed_secret seed+    ipad =+      case phkdfGen_initCtx gen of+        Nothing -> hmacCtx_ipadCtx . hmacKeyLike_run $ phkdfGen_hmacKeyLike gen+        Just x -> x -    role = phkdfInputTweak_role tweak-    echoTag = phkdfInputTweak_echoTag tweak+phkdfGen_head :: PhkdfGen -> ByteString+phkdfGen_head gen =+  if B.length (phkdfGen_extTag gen) <= 19 then+    phkdfGen_toHmacCtx gen &+    hmacCtx_feeds [ bytestring32 (phkdfGen_counter gen)+                  , phkdfGen_extTag gen+                  ] &+    hmacCtx_finalize_toByteString+  else+    phkdfGen_toHmacCtx gen &+    hmacCtx_feeds [ bytestring32 (phkdfGen_counter gen)+                  , B.init (phkdfGen_extTag gen)+                  ] &+    hmacCtx_finalizeBits_toByteString (B.singleton (B.last (phkdfGen_extTag gen))) 7 -    headerCombine = B.concat ["phkdf-pass-v0 combine", secret]-    secretKey =-        phkdfCtx_initFromHmacKey seguidKey &-        phkdfCtx_addArg  headerCombine &-        phkdfCtx_addArgs role &-        phkdfCtx_finalize (cycleByteStringWithNull domainTag) (word32 "KEY\x00") domainTag -    headerEcho = cycleByteString (domainTag <> "\x00phkdf-pass-v0 echo\x00") 32+phkdfGen_read :: PhkdfGen -> (ByteString, PhkdfGen)+phkdfGen_read gen = (state', gen')+  where+    state' = phkdfGen_head gen -    echo = hmacKey_init secretKey &-           phkdfGen_initFromHmacKey headerEcho (word32 "OUT\x00") echoTag &-           phkdfGen_finalizeStream+    gen' = PhkdfGen+      { phkdfGen_hmacKeyLike = phkdfGen_hmacKeyLike gen+      , phkdfGen_initCtx = Nothing+      , phkdfGen_state = state'+      , phkdfGen_counter = phkdfGen_counter gen + 1+      , phkdfGen_extTag = phkdfGen_extTag gen+      }++phkdfGen_toStream :: PhkdfGen -> Stream ByteString+phkdfGen_toStream = Stream.unfold phkdfGen_read

@@ -0,0 +1,36 @@+-------------------------------------------------------------------------------+-- |+-- Module:      Crypto.PHKDF.Assert+-- Copyright:   (c) 2024 Auth Global+-- License:     Apache2+--+-------------------------------------------------------------------------------++module Crypto.PHKDF.Assert where++import Data.Bits+import Data.Word+import Crypto.PHKDF.Subtle++phkdfCtx_assertBufferPosition' :: Word64 -> PhkdfCtx -> PhkdfCtx+phkdfCtx_assertBufferPosition' n ctx+  | len .&. 63 /= n .&. 63+  = error ("phkdf buffer position mismatch: " ++ show len ++ " /= " ++ show n ++ " (mod 64)")+  | otherwise = ctx+  where len = phkdfCtx_byteCount ctx++-- TODO: set up a cabal flag and CPP to select between assertions enabled/not++{--}++phkdfCtx_assertBufferPosition :: Word64 -> PhkdfCtx -> PhkdfCtx+phkdfCtx_assertBufferPosition = phkdfCtx_assertBufferPosition'++--}++{--++phkdfCtx_assertBufferPosition :: Word64 -> PhkdfCtx -> PhkdfCtx+phkdfCtx_assertBufferPosition _ = id++--}

@@ -1,66 +1,14 @@+{-# LANGUAGE ViewPatterns, LambdaCase, BangPatterns #-}+ {- | -An alternate implementation of HMAC in terms of cryptohash-sha256, because-the HMAC implementation provided there doesn't support precomputed keys or-streaming inputs.  TODO: prepare a patch for cryptohash-sha256.+An implementation of HMAC-SHA256 that supports precomputed keys, streaming inputs,+backtracking, and bitstring message inputs.  -} - module Crypto.PHKDF.HMAC-  ( HmacCtx-  , HmacKey-  , hmacKey_init-  , hmacKey_run-  , hmacCtx_init-  , hmacCtx_initFromHmacKey-  , hmacCtx_update-  , hmacCtx_updates-  , hmacCtx_finalize+  ( module Crypto.Sha256.Hmac   ) where -import qualified Crypto.Hash.SHA256 as SHA256-import           Data.Bits(xor)-import           Data.ByteString (ByteString)-import qualified Data.ByteString as B--import           Crypto.PHKDF.HMAC.Subtle---- | Precompute an HMAC key for some literal HMAC key.--hmacKey_init :: ByteString -> HmacKey-hmacKey_init = HmacKey . hmacCtx_init---- | Initialize a new empty HMAC context from a literal HMAC key.--hmacCtx_init :: ByteString -> HmacCtx-hmacCtx_init key =-    HmacCtx { hmacCtx_ipad = tweak 0x36, hmacCtx_opad = tweak 0x5c }-  where-    tweak c = SHA256.update SHA256.init $ B.map (xor c) k2-    k1 = if B.length key > 64 then SHA256.hash key else key-    k2 = B.append k1 (B.replicate (64 - B.length k1) 0)---- | Initialize a new empty HMAC context from a precomputed HMAC key.--hmacCtx_initFromHmacKey :: HmacKey -> HmacCtx-hmacCtx_initFromHmacKey = hmacKey_run---- | Append a bytestring onto the end of the message argument to HMAC.--hmacCtx_update ::  ByteString -> HmacCtx -> HmacCtx-hmacCtx_update b (HmacCtx ic oc) = HmacCtx (SHA256.update ic b) oc---- | Append zero or more bytestrings onto the end of the message argument to---   HMAC.--hmacCtx_updates :: [ByteString] -> HmacCtx -> HmacCtx-hmacCtx_updates bs (HmacCtx ic oc) = HmacCtx (SHA256.updates ic bs) oc---- | Finish computing the final 32-byte hash for an HMAC context.--hmacCtx_finalize :: HmacCtx -> ByteString-hmacCtx_finalize (HmacCtx ic oc) = outer-  where-    inner = SHA256.finalize ic-    outer = SHA256.finalize (SHA256.update oc inner)+import Crypto.Sha256.Hmac            

@@ -1,3 +1,4 @@+{-# LANGUAGE ViewPatterns, LambdaCase #-} {- |  "Internal" data structures representing precomputed HMAC keys and partial HMAC@@ -6,44 +7,7 @@ -}  module Crypto.PHKDF.HMAC.Subtle-  ( HmacCtx(..)-  , HmacKey(..)-  , hmacKey_ipad-  , hmacKey_opad+  ( module Crypto.Sha256.Hmac.Subtle   ) where -import qualified Crypto.Hash.SHA256 as SHA256---- | Fixed-size context representing the state of a partial HMAC computation---   with a complete HMAC key and a partial message parameter.--data HmacCtx = HmacCtx-  { hmacCtx_ipad :: !SHA256.Ctx-  , hmacCtx_opad :: !SHA256.Ctx-  } deriving (Eq)---- | A precomputed HMAC key. Computing an HMAC key costs two SHA256 blocks.------ No additional blocks are incurred for keys that are 64 bytes or less in--- length.  Keys that are longer than 64 bytes long must be first hashed--- with SHA256 before the key can be derived, incurring extra blocks.------ It is not uncommon that implementations of PBKDF2, HKDF, etc unnecessarily--- redo this computation even though a single HMAC key is used repeatedly.------ TODO: FIXME: this data structure is way larger than it should be.  We can--- pack this into a single 64-byte bytestring, but right now it's 208 bytes--- of data plus extra overhead.------ On the other hand, this approach may actually be more efficient for the--- core PHKDF algorithm as currently implemented.  Reducing the size of this--- data structure while maintaining tight code involves some additional work--- on cryptohash-sha256--newtype HmacKey = HmacKey { hmacKey_run :: HmacCtx } deriving (Eq)--hmacKey_ipad :: HmacKey -> SHA256.Ctx-hmacKey_ipad (HmacKey ctx) = hmacCtx_ipad ctx--hmacKey_opad :: HmacKey -> SHA256.Ctx-hmacKey_opad (HmacKey ctx) = hmacCtx_opad ctx+import Crypto.Sha256.Hmac.Subtle

@@ -1,10 +1,16 @@ {-# LANGUAGE OverloadedStrings, BangPatterns, ScopedTypeVariables #-}+-------------------------------------------------------------------------------+-- |+-- Module:      Crypto.PHKDF.Primitives+-- Copyright:   (c) 2024 Auth Global+-- License:     Apache2+--+-------------------------------------------------------------------------------  {- | -This module provides an interface to the following function.  This simplified-presentation elides the fact that the variable-length padding between the-@args@ parameter and the initial counter depends on the tag itself.+This module provides an interface to Version 1 of PHKDF, especially the+following function:  @ phkdfStream :: BitString -> [BitString] -> Word32 -> BitString -> Stream ByteString@@ -201,35 +207,53 @@  module Crypto.PHKDF.Primitives   ( HmacKey()-  , hmacKey_init+  , hmacKey   , PhkdfCtx()+  , phkdfCtx   , phkdfCtx_init-  , phkdfCtx_initFromHmacKey+  , phkdfCtx_initHashed+  , phkdfCtx_initPrefixed+  , phkdfCtx_initLike+  , phkdfCtx_hmacKeyPlain+  , phkdfCtx_hmacKeyHashed+  , phkdfCtx_hmacKeyPrefixed   , phkdfCtx_hmacKey-  , phkdfCtx_resetCtx+  , phkdfCtx_hmacKeyLike+  , phkdfCtx_toResetHmacCtx   , phkdfCtx_reset-  , phkdfCtx_addArg-  , phkdfCtx_addArgs-  , phkdfCtx_addArgsBy+  , phkdfCtx_feedArg+  , phkdfCtx_feedArgs+  , phkdfCtx_feedArgsBy+  , phkdfCtx_feedArgConcat   , phkdfCtx_finalize   , phkdfCtx_finalizeHmac-  , phkdfCtx_finalizeHmacCtx-  , phkdfCtx_finalizeStream-  , phkdfCtx_finalizeGen+  , phkdfCtx_toHmacCtx+  , phkdfCtx_toStream+  , phkdfCtx_toGen   , PhkdfSlowCtx()   , phkdfSlowCtx_extract-  , phkdfSlowCtx_addArg-  , phkdfSlowCtx_addArgs+  , phkdfSlowCtx_feedArg+  , phkdfSlowCtx_feedArgs   , phkdfSlowCtx_finalize-  , phkdfSlowCtx_finalizeStream+  , phkdfSlowCtx_toStream   , PhkdfGen()-  , phkdfGen_initFromHmacKey+  , phkdfGen+  , phkdfGen_init+  , phkdfGen_initHashed+  , phkdfGen_initPrefixed+  , phkdfGen_initLike+  , phkdfGen_hmacKeyPlain+  , phkdfGen_hmacKeyHashed+  , phkdfGen_hmacKeyPrefixed+  , phkdfGen_hmacKey+  , phkdfGen_hmacKeyLike   , phkdfGen_read   , phkdfGen_peek-  , phkdfGen_finalizeStream+  , phkdfGen_toStream   ) where -import           Data.Bits((.&.))+import           Control.Arrow((>>>))+import           Data.Bits((.&.), complement) import           Data.ByteString (ByteString) import qualified Data.ByteString as B import           Data.Function((&))@@ -240,61 +264,97 @@ import qualified Data.Stream as Stream import           Network.ByteOrder (bytestring32) -import qualified Crypto.Hash.SHA256 as SHA256+import           Crypto.Sha256 as Sha256 import           Crypto.PHKDF.HMAC import           Crypto.PHKDF.HMAC.Subtle import           Crypto.PHKDF.Primitives.Subtle-import           Crypto.Encoding.PHKDF+import           Crypto.Encoding.PHKDF.V1 import           Crypto.Encoding.SHA3.TupleHash  import           Control.Exception(assert)  -- | initialize an empty @phkdfStream@ context from a plaintext HMAC key. -phkdfCtx_init :: ByteString -> PhkdfCtx-phkdfCtx_init = phkdfCtx_initFromHmacKey . hmacKey_init+phkdfCtx :: ByteString -> PhkdfCtx+phkdfCtx = phkdfCtx_init . hmacKey --- | initialize an empty @phkdfStream@ context from a precomputed HMAC key.+-- | initialize an empty @phkdfStream@ context from a plaintext or precomputed HMAC key. -phkdfCtx_initFromHmacKey :: HmacKey -> PhkdfCtx-phkdfCtx_initFromHmacKey key =+phkdfCtx_init :: HmacKey -> PhkdfCtx+phkdfCtx_init = phkdfCtx_initLike . hmacKeyLike_init++-- | initialize an empty @phkdfStream@ context from a plaintext, precomputed, or buffer-prefixed HMAC key.++phkdfCtx_initLike :: HmacKeyLike -> PhkdfCtx+phkdfCtx_initLike key =   PhkdfCtx {-    phkdfCtx_byteLen = 0,-    phkdfCtx_state   = hmacKey_ipad key,-    phkdfCtx_hmacKey = key+    phkdfCtx_state   = hmacKeyLike_ipadCtx key,+    phkdfCtx_hmacKeyLike = key   } +-- | initialize an empty @phkdfStream@ context from a precomputed HMAC key.++phkdfCtx_initHashed :: HmacKeyHashed -> PhkdfCtx+phkdfCtx_initHashed = phkdfCtx_init . hmacKeyHashed_toKey++-- | initialize an empty @phkdfStream@ context from a buffer-prefixed HMAC key.++phkdfCtx_initPrefixed :: ByteString -> HmacKeyPrefixed -> PhkdfCtx+phkdfCtx_initPrefixed str key = PhkdfCtx+    { phkdfCtx_state = sha256_update (hmacKeyPrefixed_ipadCtx key) str+    , phkdfCtx_hmacKeyLike = hmacKeyLike_initPrefixed key+    }++phkdfCtx_hmacKeyPlain :: PhkdfCtx -> Maybe HmacKeyPlain+phkdfCtx_hmacKeyPlain = hmacKeyLike_toPlain . phkdfCtx_hmacKeyLike++phkdfCtx_hmacKeyHashed :: PhkdfCtx -> Maybe HmacKeyHashed+phkdfCtx_hmacKeyHashed = hmacKeyLike_toHashed . phkdfCtx_hmacKeyLike++phkdfCtx_hmacKeyPrefixed  :: PhkdfCtx -> HmacKeyPrefixed+phkdfCtx_hmacKeyPrefixed = hmacKeyLike_toPrefixed . phkdfCtx_hmacKeyLike++phkdfCtx_hmacKey :: PhkdfCtx -> Maybe HmacKey+phkdfCtx_hmacKey = hmacKeyLike_toKey . phkdfCtx_hmacKeyLike+ -- | initialize a new empty @phkdfStream@ context from the HMAC key --   originally supplied to the context, discarding all arguments already added.  phkdfCtx_reset :: PhkdfCtx -> PhkdfCtx-phkdfCtx_reset = phkdfCtx_initFromHmacKey . phkdfCtx_hmacKey-+phkdfCtx_reset = phkdfCtx_initLike . phkdfCtx_hmacKeyLike  -- | initialize a new empty HMAC context from the key originally supplied to --   the PHKDF context, discarding all arguments already added. -phkdfCtx_resetCtx :: PhkdfCtx -> HmacCtx-phkdfCtx_resetCtx = hmacKey_run . phkdfCtx_hmacKey+phkdfCtx_toResetHmacCtx :: PhkdfCtx -> HmacCtx+phkdfCtx_toResetHmacCtx = hmacKeyLike_run . phkdfCtx_hmacKeyLike  -- FIXME? what should happen when the SHA256 counters overflow?  -- | append a single string onto the end of @phkdfStream@'s list of --   arguments. -phkdfCtx_addArg :: ByteString -> PhkdfCtx -> PhkdfCtx-phkdfCtx_addArg b ctx = phkdfCtx_unsafeFeed [ leftEncodeFromBytes (B.length b), b ] ctx-+phkdfCtx_feedArg :: ByteString -> PhkdfCtx -> PhkdfCtx+phkdfCtx_feedArg str = phkdfCtx_unsafeFeed [len, str]+  where+    len = leftEncodeFromBytes (B.length str) -- | append zero or more strings onto the end of @phkdfStream@'s list of --   arguments. -phkdfCtx_addArgs :: Foldable f => f ByteString -> PhkdfCtx -> PhkdfCtx-phkdfCtx_addArgs params ctx = foldl' (flip phkdfCtx_addArg) ctx params+phkdfCtx_feedArgs :: Foldable f => f ByteString -> PhkdfCtx -> PhkdfCtx+phkdfCtx_feedArgs params ctx = foldl' (flip phkdfCtx_feedArg) ctx params -phkdfCtx_addArgsBy :: Foldable f => (a -> ByteString) -> f a -> PhkdfCtx -> PhkdfCtx-phkdfCtx_addArgsBy f params ctx0 = foldl' delta ctx0 params-  where delta ctx a = phkdfCtx_addArg (f a) ctx+phkdfCtx_feedArgsBy :: Foldable f => (a -> ByteString) -> f a -> PhkdfCtx -> PhkdfCtx+phkdfCtx_feedArgsBy f params ctx0 = foldl' delta ctx0 params+  where delta ctx a = phkdfCtx_feedArg (f a) ctx +phkdfCtx_feedArgConcat :: Foldable f => f ByteString -> PhkdfCtx -> PhkdfCtx+phkdfCtx_feedArgConcat strs =+    phkdfCtx_unsafeFeed [len] >>>+    phkdfCtx_unsafeFeed strs+  where+    len = leftEncodeFromBytes (foldl' delta 0 strs)+    delta tot str = tot + B.length str  -- | close out a @phkdfStream@ context using the first mode of operation, --   examining only the first output block and discarding the rest of the@@ -302,7 +362,7 @@  phkdfCtx_finalize :: (Int -> ByteString) -> Word32 -> ByteString -> PhkdfCtx -> ByteString phkdfCtx_finalize genFillerPad counter tag ctx =-    phkdfCtx_finalizeGen genFillerPad counter tag ctx &+    phkdfCtx_toGen genFillerPad counter tag ctx &     phkdfGen_read &     fst @@ -310,29 +370,29 @@ --   adding additional data to the end of the message that need not be --   TupleHash encoded. -phkdfCtx_finalizeHmacCtx :: PhkdfCtx -> HmacCtx-phkdfCtx_finalizeHmacCtx ctx =-  (phkdfCtx_resetCtx ctx) {-    hmacCtx_ipad = phkdfCtx_state ctx+phkdfCtx_toHmacCtx :: PhkdfCtx -> HmacCtx+phkdfCtx_toHmacCtx ctx =+  (phkdfCtx_toResetHmacCtx ctx) {+    hmacCtx_ipadCtx = phkdfCtx_state ctx   }  -- | "improperly" close out a 'PhkdfCtx' as if it were a call to @hmac@ instead --   of @phkdfStream@, though with a TupleHash message encoding.  phkdfCtx_finalizeHmac :: PhkdfCtx -> ByteString-phkdfCtx_finalizeHmac = hmacCtx_finalize . phkdfCtx_finalizeHmacCtx+phkdfCtx_finalizeHmac = hmacCtx_finalize_toByteString . phkdfCtx_toHmacCtx  -- | close out a @phkdfStream@ context with a given counter and tag -phkdfCtx_finalizeStream :: (Int -> ByteString) -> Word32 -> ByteString -> PhkdfCtx -> Stream ByteString-phkdfCtx_finalizeStream genFillerPad counter0 tag ctx =-  phkdfCtx_finalizeGen genFillerPad counter0 tag ctx &-  phkdfGen_finalizeStream+phkdfCtx_toStream :: (Int -> ByteString) -> Word32 -> ByteString -> PhkdfCtx -> Stream ByteString+phkdfCtx_toStream genFillerPad counter0 tag ctx =+  phkdfCtx_toGen genFillerPad counter0 tag ctx &+  phkdfGen_toStream -phkdfCtx_finalizeGen :: (Int -> ByteString) -> Word32 -> ByteString -> PhkdfCtx -> PhkdfGen-phkdfCtx_finalizeGen genFillerPad counter0 tag ctx =+phkdfCtx_toGen :: (Int -> ByteString) -> Word32 -> ByteString -> PhkdfCtx -> PhkdfGen+phkdfCtx_toGen genFillerPad counter0 tag ctx =     PhkdfGen-      { phkdfGen_hmacKey = phkdfCtx_hmacKey ctx+      { phkdfGen_hmacKeyLike = phkdfCtx_hmacKeyLike ctx       , phkdfGen_extTag = extendTag tag       , phkdfGen_counter = counter0       , phkdfGen_state = ""@@ -351,54 +411,85 @@      context0 = assert endPaddingIsValid $ phkdfCtx_state ctx' -phkdfGen_initFromHmacKey :: ByteString -> Word32 -> ByteString -> HmacKey -> PhkdfGen-phkdfGen_initFromHmacKey state0 counter0 tag hmacKey = PhkdfGen-    { phkdfGen_hmacKey = hmacKey-    , phkdfGen_extTag = extendTag tag-    , phkdfGen_counter = counter0-    , phkdfGen_state = state0-    , phkdfGen_initCtx = Just $ hmacKey_ipad hmacKey-    }+phkdfGen :: ByteString -> ByteString -> Word32 -> ByteString -> PhkdfGen+phkdfGen = phkdfGen_init . hmacKey +phkdfGen_init :: HmacKey -> ByteString -> Word32 -> ByteString -> PhkdfGen+phkdfGen_init = phkdfGen_initLike . hmacKeyLike_init++phkdfGen_initLike :: HmacKeyLike -> ByteString -> Word32 -> ByteString -> PhkdfGen+phkdfGen_initLike key initBytes = initGen+  where+    -- Round down to the previous buffer boundary+    n = B.length initBytes .&. complement 63+    (blocks, state0) = B.splitAt n initBytes+    ipad0 = sha256_update (hmacKeyLike_ipadCtx key) blocks++    initGen counter0 tag = PhkdfGen+      { phkdfGen_hmacKeyLike = key+      , phkdfGen_extTag = extendTag tag+      , phkdfGen_counter = counter0+      , phkdfGen_state = state0+      , phkdfGen_initCtx = Just ipad0+      }++phkdfGen_initHashed :: HmacKeyHashed -> ByteString -> Word32 -> ByteString -> PhkdfGen+phkdfGen_initHashed = phkdfGen_initLike . hmacKeyLike_initHashed++phkdfGen_initPrefixed :: HmacKeyPrefixed -> ByteString -> Word32 -> ByteString -> PhkdfGen+phkdfGen_initPrefixed = phkdfGen_initLike . hmacKeyLike_initPrefixed++phkdfGen_hmacKeyPlain :: PhkdfGen -> Maybe HmacKeyPlain+phkdfGen_hmacKeyPlain = hmacKeyLike_toPlain . phkdfGen_hmacKeyLike++phkdfGen_hmacKeyHashed :: PhkdfGen -> Maybe HmacKeyHashed+phkdfGen_hmacKeyHashed = hmacKeyLike_toHashed . phkdfGen_hmacKeyLike++phkdfGen_hmacKeyPrefixed :: PhkdfGen -> HmacKeyPrefixed+phkdfGen_hmacKeyPrefixed = hmacKeyLike_toPrefixed . phkdfGen_hmacKeyLike++phkdfGen_hmacKey :: PhkdfGen -> Maybe HmacKey+phkdfGen_hmacKey = hmacKeyLike_toKey . phkdfGen_hmacKeyLike+ phkdfGen_peek :: PhkdfGen -> Maybe ByteString phkdfGen_peek gen =   case phkdfGen_initCtx gen of     Nothing -> Just $ phkdfGen_state gen     Just _  -> Nothing -phkdfGen_finalizeHmacCtx :: PhkdfGen -> HmacCtx-phkdfGen_finalizeHmacCtx gen =-  (hmacKey_run (phkdfGen_hmacKey gen)) {-     hmacCtx_ipad = SHA256.update ipad (phkdfGen_state gen)+phkdfGen_toHmacCtx :: PhkdfGen -> HmacCtx+phkdfGen_toHmacCtx gen =+  (hmacKeyLike_run (phkdfGen_hmacKeyLike gen)) {+     hmacCtx_ipadCtx = sha256_update ipad (phkdfGen_state gen)     }   where     ipad =       case phkdfGen_initCtx gen of-        Nothing -> hmacCtx_ipad . hmacKey_run $ phkdfGen_hmacKey gen+        Nothing -> hmacCtx_ipadCtx . hmacKeyLike_run $ phkdfGen_hmacKeyLike gen         Just x -> x  phkdfGen_read :: PhkdfGen -> (ByteString, PhkdfGen) phkdfGen_read gen = (state', gen')   where     state' =-      phkdfGen_finalizeHmacCtx gen &-      hmacCtx_updates [ bytestring32 (phkdfGen_counter gen)-                      , phkdfGen_extTag gen-                      ] &-      hmacCtx_finalize+      phkdfGen_toHmacCtx gen &+      hmacCtx_feeds [ bytestring32 (phkdfGen_counter gen)+                   , phkdfGen_extTag gen+                   ] &+      hmacCtx_finalize_toByteString -    hmacKey = phkdfGen_hmacKey gen+    key = phkdfGen_hmacKeyLike gen      gen' = PhkdfGen-      { phkdfGen_hmacKey = hmacKey+      { phkdfGen_hmacKeyLike = key       , phkdfGen_initCtx = Nothing       , phkdfGen_state = state'       , phkdfGen_counter = phkdfGen_counter gen + 1       , phkdfGen_extTag = phkdfGen_extTag gen       } -phkdfGen_finalizeStream :: PhkdfGen -> Stream ByteString-phkdfGen_finalizeStream = Stream.unfold phkdfGen_read+phkdfGen_toStream :: PhkdfGen -> Stream ByteString+phkdfGen_toStream = Stream.unfold phkdfGen_read  -- | close out a @phkdfStream@ context with a call to @phkdfSlowExtract@, --   providing the counter, tag, @fnName@, and number of rounds to compute.@@ -409,7 +500,7 @@ phkdfSlowCtx_extract :: (Int -> ByteString) -> Word32 -> ByteString -> ByteString -> Word32 -> PhkdfCtx -> PhkdfSlowCtx phkdfSlowCtx_extract genFillerPad counter tag fnName rounds ctx0 = out   where-    (Cons block0 innerStream) = phkdfCtx_finalizeStream genFillerPad counter tag ctx0+    (Cons block0 innerStream) = phkdfCtx_toStream genFillerPad counter tag ctx0      approxByteLen = ((fromIntegral rounds :: Int64) + 1) * 64 + 32     encodedLengthByteLen = lengthOfLeftEncodeFromBytes approxByteLen@@ -455,25 +546,25 @@  -- | Add a tweak to a call to @phkdfSlowExtract@. -phkdfSlowCtx_addArg :: ByteString -> PhkdfSlowCtx -> PhkdfSlowCtx-phkdfSlowCtx_addArg = phkdfSlowCtx_lift . phkdfCtx_addArg+phkdfSlowCtx_feedArg :: ByteString -> PhkdfSlowCtx -> PhkdfSlowCtx+phkdfSlowCtx_feedArg = phkdfSlowCtx_lift . phkdfCtx_feedArg  -- | Add zero or more tweaks to a call to @phkdfSlowExtract@. -phkdfSlowCtx_addArgs :: Foldable f => f ByteString -> PhkdfSlowCtx -> PhkdfSlowCtx-phkdfSlowCtx_addArgs = phkdfSlowCtx_lift . phkdfCtx_addArgs+phkdfSlowCtx_feedArgs :: Foldable f => f ByteString -> PhkdfSlowCtx -> PhkdfSlowCtx+phkdfSlowCtx_feedArgs = phkdfSlowCtx_lift . phkdfCtx_feedArgs  -- | finalize a call to @phkdfSlowExtract@, discarding all but the first block --   of the output stream  phkdfSlowCtx_finalize :: (Int -> ByteString) -> PhkdfSlowCtx -> ByteString-phkdfSlowCtx_finalize genFillerPad = Stream.head . phkdfSlowCtx_finalizeStream genFillerPad+phkdfSlowCtx_finalize genFillerPad = Stream.head . phkdfSlowCtx_toStream genFillerPad  -- | finalize a call to @phkdfSlowExtract@ -phkdfSlowCtx_finalizeStream :: (Int -> ByteString) -> PhkdfSlowCtx -> Stream ByteString-phkdfSlowCtx_finalizeStream genFillerPad ctx =-    phkdfCtx_finalizeStream genFillerPad+phkdfSlowCtx_toStream :: (Int -> ByteString) -> PhkdfSlowCtx -> Stream ByteString+phkdfSlowCtx_toStream genFillerPad ctx =+    phkdfCtx_toStream genFillerPad         (phkdfSlowCtx_counter ctx)         (phkdfSlowCtx_tag ctx)         (phkdfSlowCtx_phkdfCtx ctx)

@@ -1,3 +1,10 @@+-------------------------------------------------------------------------------+-- |+-- Module:      Crypto.PHKDF.Primitives.Assert+-- Copyright:   (c) 2024 Auth Global+-- License:     Apache2+--+------------------------------------------------------------------------------- module Crypto.PHKDF.Primitives.Assert where  import Data.Bits

@@ -1,5 +1,13 @@+-------------------------------------------------------------------------------+-- |+-- Module:      Crypto.PHKDF.Primitives.Subtle+-- Copyright:   (c) 2024 Auth Global+-- License:     Apache2+--+------------------------------------------------------------------------------- module Crypto.PHKDF.Primitives.Subtle   ( PhkdfCtx(..)+  , phkdfCtx_byteLen   , phkdfCtx_unsafeFeed   , PhkdfSlowCtx(..)   , phkdfSlowCtx_lift@@ -7,8 +15,8 @@   ) where  import           Prelude hiding (null)-import qualified Crypto.Hash.SHA256 as SHA256-import           Crypto.PHKDF.HMAC (HmacKey)+import           Crypto.Sha256 as Sha256+import           Crypto.PHKDF.HMAC (HmacKeyLike) import           Data.ByteString (ByteString) import qualified Data.ByteString as B import           Data.Foldable(foldl', null)@@ -28,27 +36,22 @@ -- modulo 64, this doesn't matter.  However we should probably export the SHA256 counter itself  data PhkdfCtx = PhkdfCtx-  { phkdfCtx_byteLen :: !Word64-  , phkdfCtx_state :: !SHA256.Ctx-  , phkdfCtx_hmacKey :: !HmacKey+  { phkdfCtx_state :: !Sha256Ctx+  , phkdfCtx_hmacKeyLike :: !HmacKeyLike   } -data P = P !Word64 !SHA256.Ctx+phkdfCtx_byteLen :: PhkdfCtx -> Word64+phkdfCtx_byteLen = sha256_byteCount . phkdfCtx_state +data P = P !Word64 !Sha256Ctx+ phkdfCtx_unsafeFeed :: Foldable f => f ByteString -> PhkdfCtx -> PhkdfCtx phkdfCtx_unsafeFeed strs ctx0 =   if null strs then ctx0   else ctx0 {-    phkdfCtx_byteLen = byteLen',-    phkdfCtx_state = state'+    phkdfCtx_state = sha256_feeds strs (phkdfCtx_state ctx0)   }-  where-    delta (P len ctx) str = P (len + (fromIntegral (B.length str))) (SHA256.update ctx str) -    p0 = P (phkdfCtx_byteLen ctx0) (phkdfCtx_state ctx0)--    P byteLen' state' = foldl' delta p0 strs- data PhkdfSlowCtx = PhkdfSlowCtx   { phkdfSlowCtx_phkdfCtx :: !PhkdfCtx   , phkdfSlowCtx_counter :: !Word32@@ -61,9 +64,9 @@   }  data PhkdfGen = PhkdfGen-  { phkdfGen_hmacKey :: !HmacKey+  { phkdfGen_hmacKeyLike :: !HmacKeyLike   , phkdfGen_extTag :: !ByteString   , phkdfGen_counter :: !Word32   , phkdfGen_state :: !ByteString-  , phkdfGen_initCtx :: !(Maybe SHA256.Ctx)+  , phkdfGen_initCtx :: !(Maybe Sha256Ctx)   }

@@ -0,0 +1,55 @@+-------------------------------------------------------------------------------+-- |+-- Module:      Crypto.PHKDF.Subtle+-- Copyright:   (c) 2024 Auth Global+-- License:     Apache2+--+-------------------------------------------------------------------------------++module Crypto.PHKDF.Subtle+  ( PhkdfCtx(..)+  , phkdfCtx_unsafeFeed+  , PhkdfGen(..)+  ) where++import           Prelude hiding (null)+import           Crypto.Sha256 as Sha256+import           Crypto.PHKDF.HMAC (HmacKeyLike)+import           Data.ByteString (ByteString)+import qualified Data.ByteString as B+import           Data.Foldable(foldl', null)+import           Data.Word++-- I should be using the counter inside the sha256 ctx.+-- While this project is rapidly approaching maturity, it's still somewhat+-- proof of concept.  See the new SHA256 bindings WIP.++data PhkdfCtx = PhkdfCtx+  { phkdfCtx_byteCount :: !Word64+  , phkdfCtx_state :: !Sha256Ctx+  , phkdfCtx_hmacKeyLike :: !HmacKeyLike+  }++data P = P !Word64 !Sha256Ctx++phkdfCtx_unsafeFeed :: Foldable f => f ByteString -> PhkdfCtx -> PhkdfCtx+phkdfCtx_unsafeFeed strs ctx0 =+  if null strs then ctx0+  else ctx0 {+    phkdfCtx_byteCount = byteCount',+    phkdfCtx_state = state'+  }+  where+    delta (P len ctx) str = P (len + (fromIntegral (B.length str))) (sha256_update ctx str)++    p0 = P (phkdfCtx_byteCount ctx0) (phkdfCtx_state ctx0)++    P byteCount' state' = foldl' delta p0 strs++data PhkdfGen = PhkdfGen+  { phkdfGen_hmacKeyLike :: !HmacKeyLike+  , phkdfGen_extTag :: !ByteString+  , phkdfGen_counter :: !Word32+  , phkdfGen_state :: !ByteString+  , phkdfGen_initCtx :: !(Maybe Sha256Ctx)+  }

@@ -0,0 +1,395 @@+{-# Language OverloadedStrings #-}+-------------------------------------------------------------------------------+-- |+-- Module:      Crypto.PHKDF.V1.Cookbook+-- Copyright:   (c) 2024 Auth Global+-- License:     Apache2+--+-------------------------------------------------------------------------------++-- | The following module is a worked example of how one might apply PHKDF.+--   It is somewhat out of date, but continues to be depended upon for+--   part of the test suite, at least for the time being.+-- +--   The Password Hash Key Derivation Function (PHKDF) is a unification,+--   synthesis, and distillation of PBKDF2, HKDF, and TupleHash. It was+--   designed as a building block for implementing a variety of+--   self-documenting cryptographic constructions.+--+--   This module is intended more as a demonstration of and cookbook for+--   what can be done with the PHKDF primitives.  For actual deployments,+--   consider if the Global Password Prehash Protocol (G3P) is more+--   appropriate for your needs.  The G3P is a variant of 'phkdfPass' that+--   additionally integrates bcrypt as the primary key-stretching component.+--+--   These examples also serve as design studies that help informally justify+--   the G3P. Within my design framework, I've tried to maximize the benefits+--   while managing implementation costs.+--+--   1. Every bit of every parameter matters. Every boundary between+--      parameters matter. There aren't supposed to be any trivial collisions,+--      the only exception being null-extension collisions on the seguid.+--+--   2. Except for the tweaks, any change to any parameter requires restarting+--      the PHKDF key-stretching computation from somewhere in the very first+--      call to HMAC.+--+--   3. All input arguments are hardened against length-related timing side+--      channels in various different ways.+--+--      At one extreme, the username, password, and long tag have the most+--      aggressive length hardening in the conventional sense, exhibiting no+--      timing side channels except on multi-kilobyte inputs, after which+--      the timing impacts are minimzed.+--+--      At another extreme, the domain tag exhibits severe yet predictable+--      timing side channels transitioning from 19 to 20 bytes and every 64+--      bytes thereafter.  However, the domain tag is otherwise free of+--      timing-based side channels, so it too is hardened in its own way.+--+--   The design I converged upon employs fairly complicated data encoding+--   procedures. Unfortunately, this provides a fair bit of surface area+--   for subtly wrong implementations that work most of the time, but will+--   return garbage on certain lengths of inputs. I hope that this will+--   eventually be remediated with a more comprehensive suite of test vectors.++module Crypto.PHKDF.V1.Cookbook where++import           Data.ByteString (ByteString)+import qualified Data.ByteString as B+import           Data.Function((&))+import           Data.Word+import           Data.Stream (Stream)+import           Data.Vector (Vector)+import qualified Data.Vector as V+import           Network.ByteOrder (word32)++--import           Crypto.Encoding.PHKDF+import           Crypto.Encoding.PHKDF.V1+import           Crypto.Encoding.SHA3.TupleHash+import           Crypto.PHKDF.Primitives+import           Crypto.PHKDF.Primitives.Assert++-- | These input parameters are grouped together because the envisioned use+--   for them is that they are constants (or near-constants) specified by+--   a deployment. User-supplied inputs would typically not go here.+--+--   The seguid parameter acts as a deployment-wide salt. Cryptographically+--   speaking, the most important thing a deployment can do is specify a+--   constant seguid.  It is highly recommended that the seguid input be a+--   genuine Self-Documenting Globally Unique Identifier attesting to the+--   parameters, purposes, and public playbook of the protocol for y'all+--   to follow.+--+--   In more concrete cryptographic terms, the seguid parameter is the constant+--   HMAC key used by the protocol right up until the final output exansion.+--   This design is closely modelled on the HKDF construction. As such, adding+--   null bytes onto the ends of seguids that are less than 64 bytes long+--   should be the only source of trivial collisions in the entire protocol.+--+--   The remaining parameter strings are all directly-documenting plaintext+--   tags. A deployment can use these tags to encode a message into the password+--   hash function so that it must be known to whomever is hashing a password+--   of their choice.+--+--   Finally, the rounds parameter determines the latency of the function.+--   At least 250,000 rounds are recommended if PHKDF is used as the sole key+--   stretching component of a password hash database.+--+--   Unfortunately PHKDF is inexpensively parallelized, so large investments+--   here aren't a good expenditure of a user's latency budget. This is why+--   the G3P integrates bcrypt, and cuts the suggested rounds down to 20,000+--+--   For comparison, @n@ rounds of PHKDF is approximately equivalent to+--   @(1.5 + dtl)*n + c@ rounds  of PBKDF2, where @dtl@ is related to the domain+--   tag length, and c is a bit larger than 130 or so.+--+--   Here, @dtl@ is 0 when the domain tag is between 0 and 19 bytes long, 0.5+--   when the domain tag is between 20 and 83 bytes long, and an additional 0.5+--   for every 64 bytes thereafter.  Thus these functions exhibit extreme+--   timing side channels on the length of the domain tag.+--+--   By contrast, the long tag is hardened against timing side channels up to+--   a bit less than 5 kilobytes in length.  However, an extremely long tag+--   does reduce the headroom provided to masking the length of the username+--   and password fields,  however the minimum headroom allocated to the+--   username and password fields is a bit less than 3 kilobytes.+--+--   As an alternate tagging location, consider the 'phkdfInputArgs_credentials'+--   vector, which can be used as an inexpensive, pay-as-you-go plaintext+--   tagging location.+--+--   If the total encoded byte length of 'phkdfInputBlock_tags' is between 0-63+--   bytes, then these hash protocols operate in a constant number of SHA256+--   blocks.  Every additional 64 bytes incurs the computation of two or three+--   additional SHA256 blocks, because these tags are hashed into the result+--   two times in the case of 'phkdfPass', and three times in the case of+--   'phkdfSimple' (and @g3pHash@).++data PhkdfInputBlock = PhkdfInputBlock+  { phkdfInputBlock_seguid     :: !ByteString+    -- ^ HMAC-SHA256 key, usable as a high-repetition indirect tag via+    --   self-documenting globally unique identifiers (seguids).+  , phkdfInputBlock_domainTag  :: !ByteString+    -- ^ plaintext tag with one repetition per round.  0-19 bytes are free,+    --   20-83 bytes cost a additional sha256 block per round, with every+    --   64 bytes thereafter incurring a similar cost.+  , phkdfInputBlock_longTag    :: !ByteString+    -- ^ plaintext tag with 1x repetition, then cycled for roughly+    --   8 kilobytes.  Constant time on inputs up to nearly 5 kilobytes.+  , phkdfInputBlock_tags       :: !(Vector ByteString)+    -- ^ plaintext tag with 2x repetition ('phkdfPass') or 3x repetition+    --   ('phkdfSimple'). Constant-time on 0-63 encoded bytes, which includes+    --   the length encoding of each string. Thus 60 of those bytes are usable+    --   if the tags vector is a single string, or less if it contains two or+    --   more strings.+  , phkdfInputBlock_rounds     :: !Word32+    -- ^ how expensive will this hash function be? An optimal implementation+    --   computes exactly three SHA256 blocks per round if the domain tag is+    --   19 bytes or less.  It is not recommended that phkdf be used as the+    --   primary key-stretching component of a deployment, but if it is used+    --   this way, we recommend at least 250,000 rounds.  This can be adjusted+    --   downward in the case of domain tags longer than 19 bytes.+  } -- deriving (Eq, Ord, Show)++-- | The username and password are grouped together because they are normally+--   expected to be supplied by users or other observers of a deployment.+--+--   Furthermore, the credentials vector is here because it is an ideal+--   location to include other user input. For example, one could implement+--   a Two-Secret Key Derivation (2SKD) scheme analogous to 1Password's.+--+--   A deployment can also specify additional constant tags as part of the+--   credentials vector.  As the plaintext of these tags is only ever hashed+--   into the output a single time, this is the least expensive+--   pay-as-you-go option for plaintext tagging.+--+--   The credentials vector is constant time on 0-63 encoded bytes, incurring+--   one additional SHA256 block every 64 bytes thereafter. This includes+--   a variable-length field that encodes the bit length of each string; this+--   field itself requires 2 or more bytes.+--+--   The username and password are constant time as long as their encoded+--   lengths add up to less than roughly 3 kilobytes, or the username,+--   password, and domain tag add up to less than roughly 8 kilobytes.+--   The actual numbers are somewhat less in both cases, but this is a+--   good approximation.++data PhkdfInputArgs = PhkdfInputArgs+  { phkdfInputArgs_username    :: !ByteString+  -- ^ The name of this parameter is suggestive, but this parameter is+  --   functionally identical to a second password. The only difference+  --   is the fact that a password can be cracked without knowledge of the+  --   plaintext username. By contrast, the password acts as a plaintext tag+  --   if one provides the username: guessing the username implies plaintext+  --   knowledge of the password.+  , phkdfInputArgs_password    :: !ByteString+  , phkdfInputArgs_credentials :: !(Vector ByteString)+  } -- deriving (Eq, Ord, Show)++-- | These parameters are used to tweak the final output, without redoing any+--   expensive key stretching.  A possible use case is including a high entropy+--   secret in the role itself that isn't available until after a successful+--   stage of authentication.+--+--   Since these parameters are processed in a context that could conceivably be+--   performance sensitive, we don't apply any length padding or side-channel+--   hardening.  Instead we opt for maximizing free tagging space.  Thus we+--   want to avoid incurring additional SHA256 block computations, one of the+--   favorite techniques employed by the key-stretching phase of 'phkdfPass'+--   to harden against timing side-channels.+--+--   A deployment could conceivably harden this expansion phase against timing+--   side channels themselves, if the were sufficiently inclined. There are+--   several techniques. For starters, a deployment could specify an additional+--   variable-length string in the role vector, used to control its relative+--   ending position inside the SHA256 buffer.++data PhkdfInputTweak = PhkdfInputTweak+  { phkdfInputTweak_role :: !(Vector ByteString)+  , phkdfInputTweak_echoTag  :: !ByteString+  } -- deriving (Eq, Ord, Show)++-- | A plain-old-data explicit representation of the intermediate 'phkdfPass'+--   computation after the 'PhkdfInputBlock' and 'PhkdfInputArgs' have been+--   processed and key stretching has been completed, but before the tweaks+--   have been applied and the final output generated.+--+--   If you ever need to serialize or persist a seed, you probably want this.+--+--   Intended to be generated by 'phkdfPass_seedInit' and then consumed+--   without modification by 'phkdfPass_seedFinalize'.++data PhkdfSeed = PhkdfSeed+  { phkdfSeed_seguid :: !ByteString+  , phkdfSeed_seguidKey :: !HmacKey+  , phkdfSeed_domainTag :: !ByteString+  , phkdfSeed_secret :: !ByteString+  } -- deriving (Eq)++-- | A non-tweakable, complete password prehash protocol++phkdfSimple :: PhkdfInputBlock -> PhkdfInputArgs -> Stream ByteString+phkdfSimple block args = echo+  where+    -- Explicitly unpack everything for the unused variable warnings.+    -- i.e. It's relatively easy to check that we've unpacked every+    -- field, then we can rely on unused variable warnings to ensure+    -- we have in fact made use of everything.+    domainTag = phkdfInputBlock_domainTag block+    seguid = phkdfInputBlock_seguid block+    longTag = phkdfInputBlock_longTag block+    tags = phkdfInputBlock_tags block+    rounds = phkdfInputBlock_rounds block++    username = phkdfInputArgs_username args+    password = phkdfInputArgs_password args+    credentials = phkdfInputArgs_credentials args++    headerExtract = [ "phkdf-simple0 username", username ]++    headerUsername = headerExtract ++ [ usernamePadding headerExtract domainTag domainTag ]+    -- password field goes here++    headerLongTag =+      [ longTag+      , B.concat+        [ "password-hash-key-derivation-function phkdf-simple0\x00"+        , leftEncodeFromBytes (B.length domainTag)+        , bareEncode rounds+        ]+      ]++    secretKey =+        phkdfCtx seguid &+        phkdfCtx_feedArgs headerUsername &+        phkdfCtx_assertBufferPosition 32 &+        phkdfCtx_feedArg  password &+        phkdfCtx_feedArgs headerLongTag &+        -- FIXME: fusing feedArg and passwordPadding can save ~ 8 KiB RAM+        phkdfCtx_feedArg (passwordPadding headerUsername headerLongTag longTag domainTag password) &+        phkdfCtx_assertBufferPosition 32 &+        phkdfCtx_feedArgs credentials &+        phkdfCtx_feedArg (credentialsPadding credentials longTag domainTag) &+        phkdfCtx_assertBufferPosition 29 &+        phkdfCtx_feedArgs tags &+        phkdfCtx_feedArg (bareEncode (V.length tags)) &+        phkdfSlowCtx_extract+            (cycleByteStringWithNull domainTag)+            (word32 "go\x00\x00" + 2023) domainTag+            "phkdf-simple0 compact" rounds &+        phkdfSlowCtx_assertBufferPosition 32 &+        phkdfSlowCtx_feedArgs tags &+        phkdfSlowCtx_finalize (cycleByteStringWithNull domainTag)++    -- Harden the tags vector against length-based timing side-channels+    echoHeader = cycleByteStringWithNull "phkdf-simple0 expand echo" 30++    echo = phkdfCtx secretKey &+           phkdfCtx_feedArg echoHeader &+           phkdfCtx_assertBufferPosition 32 &+           phkdfCtx_feedArgs tags &+           phkdfCtx_toStream (cycleByteStringWithNull domainTag) (word32 "OUT\x00") domainTag++-- | A tweakable, complete prehash protocol.   Note that this function is very+--   intentionally implemented in such a way that the following idiom is+--   efficient, and only performs the expensive key stretching phase once:+--+-- @+--  let mySeed = phkdfPass block args+--   in [ mySeed tweak1, mySeed tweak2, mySeed tweak3 ]+-- @+--+--   However in the case that you want or need to persist or serialize the+--   intermediate seed, then the plain-old-datatype 'PhkdfSeed' and its+--   companion functions 'phkdfPass_seedInit' and 'phkdfPass_seedFinalize'+--   are likely to be more appropriate.++phkdfPass :: PhkdfInputBlock -> PhkdfInputArgs -> PhkdfInputTweak -> Stream ByteString+phkdfPass block args = phkdfPass_seedInit block args & phkdfPass_seedFinalize++-- | This generates a seed, which encapsulates the expensive key-stretching component of 'phkdfPass' into a reusable, tweakable cryptographic value.  This function is way slower than it's companion, 'phkdfPass_seedFinalize'.  Broadly comparable to HKDF-Extract, though with key stretching built-in.++phkdfPass_seedInit :: PhkdfInputBlock -> PhkdfInputArgs -> PhkdfSeed+phkdfPass_seedInit block args =+    PhkdfSeed {+      phkdfSeed_seguid = seguid,+      phkdfSeed_seguidKey = seguidKey,+      phkdfSeed_domainTag = domainTag,+      phkdfSeed_secret = secret+    }+  where+    domainTag = phkdfInputBlock_domainTag block+    seguid = phkdfInputBlock_seguid block+    longTag = phkdfInputBlock_longTag block+    seedTags = phkdfInputBlock_tags block+    rounds = phkdfInputBlock_rounds block++    username = phkdfInputArgs_username args+    password = phkdfInputArgs_password args+    credentials = phkdfInputArgs_credentials args++    headerExtract = [ "phkdf-pass-v0 username", username ]++    headerUsername = headerExtract ++ [ usernamePadding headerExtract domainTag domainTag ]++    -- password field goes here++    headerLongTag =+      [ longTag+      , B.concat+        [ "password hash & key derivation function: phkdf-pass-v0"+        , bareEncode rounds+        ]+      ]++    seguidKey = hmacKey seguid++    secret =+        phkdfCtx_init seguidKey &+        phkdfCtx_feedArgs headerUsername &+        phkdfCtx_assertBufferPosition 32 &+        phkdfCtx_feedArg  password &+        -- FIXME: fusing feedArg and longPadding can save ~ 8 KiB RAM+        phkdfCtx_feedArgs headerLongTag &+        phkdfCtx_feedArg  (passwordPadding headerUsername headerLongTag longTag domainTag password) &+        phkdfCtx_assertBufferPosition 32 &+        phkdfCtx_feedArgs credentials &+        phkdfCtx_feedArg (credentialsPadding credentials longTag domainTag) &+        phkdfCtx_assertBufferPosition 29 &+        phkdfCtx_feedArgs seedTags &+        phkdfCtx_feedArg (bareEncode (V.length seedTags)) &+        phkdfSlowCtx_extract+            (cycleByteStringWithNull domainTag)+            (word32 "go\x00\x00" + 2023) domainTag+            "phkdf-pass-v0 compact" rounds &+        phkdfSlowCtx_assertBufferPosition 32 &+        phkdfSlowCtx_feedArgs seedTags &+        phkdfSlowCtx_finalize (cycleByteStringWithNull domainTag)++-- | This consumes a seed and tweaks to produce the final output stream.+-- This function is the output expansion phase of 'phkdfPass'.  This function+-- is way faster than it's companion 'phkdfPass_seedInit'.  Broadly comparable to+-- HKDF-Expand.++phkdfPass_seedFinalize :: PhkdfSeed ->  PhkdfInputTweak -> Stream ByteString+phkdfPass_seedFinalize seed tweak = echo+  where+    seguidKey = phkdfSeed_seguidKey seed+    domainTag = phkdfSeed_domainTag seed+    secret = phkdfSeed_secret seed++    role = phkdfInputTweak_role tweak+    echoTag = phkdfInputTweak_echoTag tweak++    headerCombine = B.concat ["phkdf-pass-v0 combine", secret]+    secretKey =+        phkdfCtx_init seguidKey &+        phkdfCtx_feedArg  headerCombine &+        phkdfCtx_feedArgs role &+        phkdfCtx_finalize (cycleByteStringWithNull domainTag) (word32 "KEY\x00") domainTag++    headerEcho = cycleByteString (domainTag <> "\x00phkdf-pass-v0 echo\x00") 32++    echo = phkdfGen secretKey headerEcho (word32 "OUT\x00") echoTag &+           phkdfGen_toStream

@@ -1,11 +1,11 @@ name:                phkdf-version:             0.0.0.0+version:             0.1.0.0 synopsis:     Toolkit for self-documenting password hash and key derivation functions.  description:     Inspired by PBKDF2, HKDF, and TupleHash. Uses HMAC-SHA256 as a primitive.-    +     This is primarily intended to be a highly reliable reference implementation     for the underlying PHKDF primitives. It also aspires to be production     ready-ish. The main limitation is that it implemented without mutation,@@ -26,19 +26,23 @@ library   exposed-modules:                      Crypto.PHKDF+                     Crypto.PHKDF.Assert+                     Crypto.PHKDF.Subtle                      Crypto.Encoding.PHKDF+                     Crypto.Encoding.PHKDF.V1                      Crypto.PHKDF.Primitives                      Crypto.PHKDF.Primitives.Assert                      Crypto.PHKDF.Primitives.Subtle+                     Crypto.PHKDF.V1.Cookbook                      Crypto.PHKDF.HMAC                      Crypto.PHKDF.HMAC.Subtle    build-depends:     base < 5-                   , bytestring-                   , cryptohash-sha256+                   , bytestring >= 0.11.1.0+                   , sha256                    , network-byte-order                    , Stream-                   , tuplehash-utils+                   , tuplehash-utils >= 0.1                    , vector    ghc-options:       -Wall@@ -46,6 +50,11 @@   hs-source-dirs:    lib   default-language:  Haskell2010 +source-repository head+  type:     git+  location: https://github.com/auth-global/self-documenting-cryptography+  subdir:   phkdf+ test-suite test   type:              exitcode-stdio-1.0   hs-source-dirs:    test@@ -56,13 +65,15 @@    build-depends:     base < 5                    , aeson >= 2-                   , base16+                   , base16 >= 1                    , bytestring                    , containers                    , phkdf+                   , quickcheck-instances                    , Stream                    , tasty                    , tasty-hunit+                   , tasty-quickcheck                    , text                    , vector 

@@ -24,8 +24,6 @@       ]   ]   where-    hmac :: ByteString -> ByteString -> ByteString-    hmac k m = hmacCtx_init k & hmacCtx_update m & hmacCtx_finalize     run x = B.encodeBase16 (hmac (key x) (msg x)) @?= B.encodeBase16 (out x)  testVectors :: [TestVector]

@@ -1,7 +1,13 @@-import Test.Tasty-import Data.Monoid+import           Data.ByteString(ByteString)+import qualified Data.ByteString as B+import           Data.Monoid+import           Test.Tasty+import           Test.Tasty.QuickCheck+import           Test.QuickCheck.Instances.ByteString()+ import qualified HMAC import qualified PHKDF+import           Crypto.Encoding.PHKDF  main = do   let fileName = PHKDF.testVectorDefaultFileName@@ -11,5 +17,12 @@ tests :: (String, Either String PHKDF.TestVectors) -> TestTree tests phkdfTvs = testGroup "Test" [     testGroup "hmac" HMAC.tests,-    testGroup "phkdf" [PHKDF.testFile phkdfTvs]+    testGroup "phkdf" [PHKDF.testFile phkdfTvs],+    testProperty "prop_extendTag" prop_extendTag   ]++prop_extendTag :: ByteString -> Bool+prop_extendTag x = trimExtendedTag x' == Just x && validLength+  where+    x' = extendTag x+    validLength = B.length x' <= 19 || B.length x' `mod` 64 == 20

@@ -11,6 +11,7 @@ import qualified Data.Aeson.Key as K import Data.Aeson.KeyMap(KeyMap) import qualified Data.Aeson.KeyMap as KM+import Data.Base16.Types import Data.ByteString(ByteString) import qualified Data.ByteString as B import qualified Data.ByteString.Base16 as B@@ -29,12 +30,14 @@  import Debug.Trace -import Crypto.PHKDF+import Crypto.PHKDF.V1.Cookbook import Test.Tasty import Test.Tasty.HUnit  type Args = KeyMap Val +encodeBase16 = extractBase16 . B.encodeBase16+ data Val    = Int !Int    | Str !ByteString@@ -193,7 +196,7 @@     String txt -> pure (T.encodeUtf8 txt)     Object obj | KM.size obj == 1 -> do         txt <- obj .: "hex"-        case B.decodeBase16 (T.encodeUtf8 txt) of+        case B.decodeBase16Untyped (T.encodeUtf8 txt) of           Left _ -> empty           Right x -> pure x     _ -> empty@@ -208,7 +211,7 @@ parseJSONHash :: Value -> Parser ByteString parseJSONHash = \case     String txt ->-        case B.decodeBase16 (T.encodeUtf8 txt) of+        case B.decodeBase16Untyped (T.encodeUtf8 txt) of             Left _ -> empty             Right x -> pure x     _ -> empty@@ -253,9 +256,9 @@ compareAu :: String -> ByteString -> Stream ByteString -> Assertion compareAu name bs outStream   | B.null bs = assertFailure ("\"" ++ name ++ "\":\"" ++ concatMap toHex (S.take 2 outStream) ++ "\"")-  | otherwise = B.encodeBase16 (takeBytes (B.length bs) outStream) @?= B.encodeBase16 bs+  | otherwise = encodeBase16 (takeBytes (B.length bs) outStream) @?= encodeBase16 bs   where-    toHex = T.unpack . B.encodeBase16+    toHex = T.unpack . encodeBase16  takeBytes :: Int -> Stream ByteString -> ByteString takeBytes n stream = B.concat (go n stream)