diff --git a/ChangeLog.md b/ChangeLog.md --- a/ChangeLog.md +++ b/ChangeLog.md @@ -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. diff --git a/lib/Crypto/Encoding/PHKDF.hs b/lib/Crypto/Encoding/PHKDF.hs --- a/lib/Crypto/Encoding/PHKDF.hs +++ b/lib/Crypto/Encoding/PHKDF.hs @@ -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) diff --git a/lib/Crypto/Encoding/PHKDF/V1.hs b/lib/Crypto/Encoding/PHKDF/V1.hs new file mode 100644 --- /dev/null +++ b/lib/Crypto/Encoding/PHKDF/V1.hs @@ -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 diff --git a/lib/Crypto/PHKDF.hs b/lib/Crypto/PHKDF.hs --- a/lib/Crypto/PHKDF.hs +++ b/lib/Crypto/PHKDF.hs @@ -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 diff --git a/lib/Crypto/PHKDF/Assert.hs b/lib/Crypto/PHKDF/Assert.hs new file mode 100644 --- /dev/null +++ b/lib/Crypto/PHKDF/Assert.hs @@ -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 + +--} diff --git a/lib/Crypto/PHKDF/HMAC.hs b/lib/Crypto/PHKDF/HMAC.hs --- a/lib/Crypto/PHKDF/HMAC.hs +++ b/lib/Crypto/PHKDF/HMAC.hs @@ -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 diff --git a/lib/Crypto/PHKDF/HMAC/Subtle.hs b/lib/Crypto/PHKDF/HMAC/Subtle.hs --- a/lib/Crypto/PHKDF/HMAC/Subtle.hs +++ b/lib/Crypto/PHKDF/HMAC/Subtle.hs @@ -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 diff --git a/lib/Crypto/PHKDF/Primitives.hs b/lib/Crypto/PHKDF/Primitives.hs --- a/lib/Crypto/PHKDF/Primitives.hs +++ b/lib/Crypto/PHKDF/Primitives.hs @@ -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) diff --git a/lib/Crypto/PHKDF/Primitives/Assert.hs b/lib/Crypto/PHKDF/Primitives/Assert.hs --- a/lib/Crypto/PHKDF/Primitives/Assert.hs +++ b/lib/Crypto/PHKDF/Primitives/Assert.hs @@ -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 diff --git a/lib/Crypto/PHKDF/Primitives/Subtle.hs b/lib/Crypto/PHKDF/Primitives/Subtle.hs --- a/lib/Crypto/PHKDF/Primitives/Subtle.hs +++ b/lib/Crypto/PHKDF/Primitives/Subtle.hs @@ -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) } diff --git a/lib/Crypto/PHKDF/Subtle.hs b/lib/Crypto/PHKDF/Subtle.hs new file mode 100644 --- /dev/null +++ b/lib/Crypto/PHKDF/Subtle.hs @@ -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) + } diff --git a/lib/Crypto/PHKDF/V1/Cookbook.hs b/lib/Crypto/PHKDF/V1/Cookbook.hs new file mode 100644 --- /dev/null +++ b/lib/Crypto/PHKDF/V1/Cookbook.hs @@ -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 diff --git a/phkdf.cabal b/phkdf.cabal --- a/phkdf.cabal +++ b/phkdf.cabal @@ -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 diff --git a/test/HMAC.hs b/test/HMAC.hs --- a/test/HMAC.hs +++ b/test/HMAC.hs @@ -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] diff --git a/test/Main.hs b/test/Main.hs --- a/test/Main.hs +++ b/test/Main.hs @@ -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 diff --git a/test/PHKDF.hs b/test/PHKDF.hs --- a/test/PHKDF.hs +++ b/test/PHKDF.hs @@ -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)