{-# LANGUAGE OverloadedStrings, ViewPatterns #-}

-------------------------------------------------------------------------------
-- |
-- Module:      Crypto.G3P.V2
-- Copyright:   (c) 2024 Auth Global
-- License:     Apache2
--
-------------------------------------------------------------------------------

{- |

The [Global Password Prehash Protocol (G3P)](https://github.com/auth-global/self-documenting-cryptography/)
is a slow, attribution-armored password hash and key derivation function. Its
intented purpose is to ensure the delivery of plaintext salts from deployed
authentication databases to password crackers in order to support
[self-documenting deployments](https://www.cut-the-knot.org/Curriculum/Algebra/SelfDescriptive.shtml)
whose password hashes are /traceable/ or /useless/ after they have been /stolen/.
This secondary security goal seeks to use /cryptoacoustics/
to provide [/embedded attributions/](https://joeyh.name/blog/entry/attribution_armored_code/)
that are as difficult as possible for an adversarial implementation to remove.

The G3P revisits the role of cryptographic salt, splitting the salt into the
cartesian product of the /seguid/, /username/, and /tag/ parameters. Any
parameter with "tag" as part of the name is an embedded attribution to anybody
providing the inputs to the /username/ or /password/ parameters. Tags are
themselves directly self-documenting embedded plaintext salts, in the sense
that one cannot easily or efficiently replace the tag with anything else
without losing the ability to compute the correct hash function.

There are several themes worked into this design:

1.  Always Be enCoding: one of the plaintext salts or another should be mixed
    into the final state as often and frequently as possible. If an attacker
    chooses to deploy fully homomorphic encryption in a password cracker,
    let there be no rest for the wicked. Key stretching and plaintext salting
    should be two sides of the same coin.

2.  Always Be Forgetting: it should be possible to transfer the key stretching
    process to another semi-trusted computing element without providing that
    element with a password cracking attack that is signficantly less expensive
    than the work done so far. These opportunities occur at every PHKDF round,
    and at every bcrypt superround. Furthermore, any device that completes the
    PHKDF key-stretching computation can outsource some or all of the bcrypt
    superrounds without losing control of the end result.

3.  Excessively Extended Salt: our philosophy of applying salt is that it's
    the first thing you do, it's the last thing you do, it's something you do
    at every opportunity, and sometimes we even create new opportunities to
    add more salt.

4.  Free Plaintext Salt by Countering Excess Freedom: the G3P starts from
    conventional keys as it's first and primary layer of security.  Excessively
    long keys are often considered cryptographically suspect, but very long
    keys that likely result in totally unique hash functions are also exactly
    what is needed in the information theoretic sense in order for there to
    plausibly be much if any cryptoacoustic advantage. Therefore, we use long
    plaintext salts with low entropy density throughout our hashing process,
    and use short, fixed-length, (ideally) entropy-dense HMAC keys as both the
    starting and ending point of our hashing process.

5.  These goals align extremely well, and often lead to similar outcomes as,
    the advice found in [RFC 5869: HMAC-based Extract-and-Expand Key Derivation Function (HKDF)](https://datatracker.ietf.org/doc/html/rfc5869)
    and [NIST SP 108r1 Recommendation for Key Derivation Using Pseudorandom Functions](https://csrc.nist.gov/pubs/sp/800/108/r1/upd1/final).
    Both of these documents have profoundly contributed to the design of the
    G3P. PHKDF can be thought of as backporting the advice of these newer
    documents to the older PBKDF2 design, as well as finding new applications
    and justifications for the use of contextual parameters in password hash
    functions and key derivation protocols.

6.  From the viewpoint of an implementer, standard PBKDF2, HKDF, and bcrypt
    interfaces cannot be used to implement this design. HMAC-SHA256 is the
    only standard library primitive this password hash function relies upon.
    However, most library implementations of HMAC-SHA256 won't do, as G3Pb2
    uses bitstring end-of-message padding. Moreover, any reasonably practical
    implementation of the G3P requires an HMAC implementation that supports
    precomputed HMAC keys (for PHKDF) as well as streaming with backtracking
    (for bcrypt).

    These latter features aren't strictly required to compute the correct
    result, meaning that the G3P respects the HMAC's abstract specification.
    However, precomputed keys, streaming, and backtracking are all strictly
    required in order to implement the G3P in the most secure way possible.

    A function that does not support precomputed HMAC keys will take twice
    as many SHA256 blocks to compute the PHKDF key-stretching phase, if the
    domain tag is 19 bytes or less. If the domain tag is 20-83 bytes long,
    it would take 1.66x as many blocks, asymptotically decaying very slowly
    to 1x every 64 bytes of domain tag thereafter.

    An implementation that does not support streaming and backtracking cannot
    possibly be /Always Forgetting/ during bcrypt key-stretching. The most
    straightforward such implementation, which is still much more complicated
    than a secure implementation that uses backtracking, would generate
    and store nearly 400 kilobytes of data, assuming the recommended 4000
    bcrypt rounds. About a third of that 400 KB would be strictly required.

    With streaming and backtracking, the entire bcrypt key-stretching
    computation can be carried out in just over 4 kilobytes of memory. Not to
    mention that if your implementation supports streaming and backtracking,
    you aren't that far away from also supporting precomputed HMAC keys.

7.  From the viewpoint of an academic cryptographer, morally speaking, this
    design is literally a PBKDF2, an HKDF, and a bcrypt all at the same time,
    via a carefully designed pun. Preserving useful opportunities for employing
    partial evaluation and continuations is a particularly notable design theme.
-}

module Crypto.G3P.V2
  ( g3pHash
  , g3pStream
  , G3PSalt(..)
  , G3PInputs(..)
  , G3PSeedInputs(..)
  , G3PSpark()
  , g3pSpark
  , g3pSpark_toSeed
  , g3pSpark_toSprout
  , g3pSpark_toTree
  , g3pSpark_toKey
  , g3pSpark_toSource
  , g3pSpark_toStream
  , G3PSeed()
  , g3pSeed
  , g3pSeed_fromSpark
  , g3pSeed_toSprout
  , g3pSeed_toTree
  , g3pSeed_toKey
  , g3pSeed_toSource
  , g3pSeed_toStream
  , G3PSprout()
  , g3pSprout
  , g3pSprout_feedArg
  , g3pSprout_feedArgs
  , g3pSprout_arg
  , g3pSprout_args
  , g3pSprout_fromSpark
  , g3pSprout_fromSeed
  , g3pSprout_toTree
  , g3pSprout_toKey
  , g3pSprout_toSource
  , g3pSprout_toStream
  , G3PTree()
  , g3pTree
  , g3pTree_fromSpark
  , g3pTree_fromSeed
  , g3pTree_fromSprout
  , g3pTree_toKey
  , g3pTree_toSource
  , g3pTree_toStream
  , G3PKey()
  , g3pKey
  , g3pKey_fromSpark
  , g3pKey_fromSeed
  , g3pKey_fromSprout
  , g3pKey_fromTree
  , g3pKey_toSource
  , g3pKey_toStream
  , G3PSource
  , g3pSource
  , g3pSource_peek
  , g3pSource_read
  , g3pSource_fromSpark
  , g3pSource_fromSeed
  , g3pSource_fromSprout
  , g3pSource_fromTree
  , g3pSource_fromKey
  , g3pSource_toStream
  , Stream(..)
  , g3pStream_fromSpark
  , g3pStream_fromSeed
  , g3pStream_fromSprout
  , g3pStream_fromTree
  , g3pStream_fromKey
  , g3pStream_fromSource
  , word32
  ) where

import           Data.Bits (xor)
import           Data.ByteString (ByteString)
import qualified Data.ByteString as B
import           Data.Function((&))
import           Data.Word
import           Data.Stream (Stream(..))
import qualified Data.Stream as Stream
import           Data.Vector (Vector)
import qualified Data.Vector as V
import           Network.ByteOrder (word32, bytestring64)

import           Crypto.Encoding.PHKDF
import           Crypto.Encoding.SHA3.TupleHash
import           Crypto.PHKDF.HMAC
import           Crypto.PHKDF
import           Crypto.PHKDF.Assert
import           Crypto.G3P.BCrypt (bcryptXsFree)
import           Crypto.G3P.V2.Subtle

-- | These input parameters are grouped together because they are the
--   parameters that will have to persist in memory for most or all of
--   the PHKDF-based key-stretching computation.
--
--   It is intended that deployments of an authentication database will
--   specify these as constants or near-constants. User-supplied inputs
--   would typically not go here. In this role, all these parameters
--   function as salt.
--
--   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 to use the deployment to spec.
--
--   The remaining string parameters are all directly-documenting, embedded
--   attributions. A deployment can use these tags to encode a message into the
--   password hash function so that it must be known to whomever can compute it.
--   There are a variety of different parameters because there are different
--   lengths of messages that can be expressed for free, and there are different
--   incremental costs for exceeding that limit.
--
--   It is particularly important to include some kind of actionable message
--   in the @domainTag@ and @longTag@ parameter. Specifying an empty string
--   in either of these parameters means that a significant quantity of
--   cryptoacoustic messaging space will be filled with silence.
--
--   Especially useful messages include URIs, legal names, and domain names.

data G3PSalt = G3PSalt
  { G3PSalt -> HmacKey
g3pSalt_seguid :: !HmacKey
    -- ^ usable as a high-repetition indirect tag via
    --   self-documenting globally unique identifiers (seguids)
  , G3PSalt -> ByteString
g3pSalt_longTag :: !ByteString
    -- ^ plaintext tag with 1x repetition, then cycled for roughly
    --   8 kilobytes which is used as filler padding after the password.
    --
    --   This is typically duplicated as the 'g3pSeedInputs_bcryptLongTag'
    --   parameter, which provides a very large number of cryptoacoustic
    --   repetitions. If this step is not taken, then this parameter
    --   can be discarded after the first call to HMAC is complete, making
    --   it essentially horn-loaded which would be a bit of an anomaly for
    --   this input block.
    --
    --   The first 0-63 bytes is also used as filler padding after the
    --   contextTags, possibly making part of this parameter not horn-loaded.
    --
    --   Constant time on inputs 0-4095 bytes.  Overages incur one sha256
    --   block per 64 bytes, rounded up.
  , G3PSalt -> Vector ByteString
g3pSalt_contextTags :: !(Vector ByteString)
    -- ^ plaintext tags with 4x repetition. Constant-time on 0-63 encoded bytes,
    --   which includes the length encoding of each string. Thus 60 of those
    --   free bytes are usable if the tags vector is a single string, or less if
    --   it contains two or more strings. The empty vector is a good default
    --   choice here.
    --
    --   Overages incur four sha256 blocks per 64 bytes.
    --
    --   This parameter is notable because it is the least expensive purely
    --   auxiliary input that is not horn-loaded. Thus if you want a very long
    --   salt input that provides a bit of extra collision resistance, this
    --   would be a logical candidate input location to consider.
    --
    --   If your deployment uses a random salt per account, this is an ideal
    --   location in which to place a copy of that salt. This is also a
    --   reasonable location for salts derived from hashed usernames.
    --
    --   If your deployment uses a plain login name as the username salt, by
    --   including it here your deployment would then require that anybody
    --   who can crack the password must know the login name.
    --
    --   This would be a highly atypical deployment design decision. In most
    --   contexts, it would seem to be better to omit plaintext login names
    --   from this parameter.
  , G3PSalt -> ByteString
g3pSalt_domainTag :: !ByteString
    -- ^ plaintext tag with one repetition per PHKDF round. 0-19 bytes are
    --   free, 20-83 bytes cost five additional sha256 blocks plus one block
    --   /per PHKDF round/, with every 64 bytes thereafter incurring a similar
    --   cost.
    --
    --   In the case of long domain tags, it is strategically advantageous
    --   to ensure that the first 32 bytes are highly actionable, as these
    --   bytes are commonly used as filler padding.
    --
    --   This parameter provides [domain separation](https://en.wikipedia.org/wiki/Domain_separation). (also see the [NIST glossary](https://csrc.nist.gov/glossary/term/domain_separation))
    --   A suggested value is a ICANN domain name controlled by the deployment.
    --
    --   The name is also a bit of an homage to the "realm" parameter of HTTP
    --   basic authentication, which in part inspired the domain tag by
    --   inspiring the question "What would the realm parameter do if it did
    --   something useful?"
  , G3PSalt -> Word32
g3pSalt_phkdfRounds :: !Word32
    -- ^ How expensive will the PHKDF component be? An optimal implementation
    --   computes exactly two SHA256 blocks per round if the domain tag is
    --   19 bytes or less, plus one block per round for every 64 characters
    --   over 19, rounded up.
    --
    --   I recommend 20,000 rounds or so. You might consider adjusting that
    --   recommendation downward in the case of domain tags that exceed 19
    --   bytes in length: 13,333 rounds of PHKDF with a domain tag that is
    --   83 bytes long will cost exactly one SHA256 block less than 20,000
    --   rounds of PHKDF with a domain tag that is 19 bytes long.
    --
    --   Note that this cost comparison is exact only when looking at only the
    --   PHKDF key stretching phase. The G3P also computes a reasonably large
    --   but constant number of additional SHA256 blocks as part of it's
    --   initial HMAC-Extract operation, /G3Pb2 alfa/.
    --
    --   Thus if you are tuning this parameter via empirical timing tests,
    --   the direct linear relationship between this parameter and time is
    --   approximate, not exact, due to a this reasonably large offset.
  } deriving (G3PSalt -> G3PSalt -> Bool
(G3PSalt -> G3PSalt -> Bool)
-> (G3PSalt -> G3PSalt -> Bool) -> Eq G3PSalt
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: G3PSalt -> G3PSalt -> Bool
== :: G3PSalt -> G3PSalt -> Bool
$c/= :: G3PSalt -> G3PSalt -> Bool
/= :: G3PSalt -> G3PSalt -> Bool
Eq)

-- | These parameters are grouped together because they are hashed once
--   near the beginning of the protocol and then are no longer needed, unless
--   a deployment specifies duplicating (part of) one of these parameters
--   into another.  Thus all of these parameters are horn-loaded.
--
--   The input string to the "username" parameter could be provided directly
--   by the user.  Alternatively, it could be a random salt retrieved from
--   a server or database, typically looked up via a plaintext username.
--   The password is normally expected to be supplied by the users of a
--   deployment.
--
--   Furthermore, the credentials vector is here because it is an ideal
--   location to include other 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 alongside the bcrypt tag and long tag
--   are incrementally the least expensive options for plaintext tagging.
--
--   Note that the username and password are subjected to additional length
--   hardening. The G3P operates in a constant number of SHA256 blocks so long
--   as the combined length of the username and password is less than about
--   4 KiB,  or the combined length of the username, password, and long tag is
--   less than about 8 KiB. The actual numbers are somewhat less in both cases,
--   but this is a reasonable approximation.
--
--   In the case of all of the inputs in this record, longer values incur one
--   SHA256 block per 64 bytes.

data G3PInputs = G3PInputs
  { G3PInputs -> ByteString
g3pInputs_username :: !ByteString
  -- ^ constant time on 0-293 bytes, or if the combined length of the
  --   username and password is less than about 4 kilobytes, or if the
  --   combined length of the username, password, and long tag is
  --   less than about 8 kilobytes.
  --
  --   Using deployment-identifying seguids and domain tags makes it
  --   perfectly safe to put normalized plaintext login names here, as then
  --   this salt would then only need to be unique within a deployment.
  --
  --   This approach comes with the cost that you will have to reliably
  --   perform username normalization everywhere this hash function is
  --   computed. Offering a server-side remote procedure call to perform
  --   this normalization is recommended.
  --
  --   The G3P is intentionally designed to allow the plaintext username
  --   to be hidden from a password cracker via partial evaluation, preventing
  --   the cracker from immediately logging in if successful. However, this
  --   partial application doesn't apply any key-stretching, meaning that
  --   guessable login names can be cracked relatively quickly.
  --
  --   Thus this approach is less of a defensive line and more of a "sand in
  --   the gears" tactic. It might also be useful as a legal damages
  --   enhancement strategy against unauthorized password crackers who
  --   fail to take this step to help protect users' privacy.
  --
  --   Even better, apply key-stretching to the plaintext login name, possibly
  --   via another call to the G3P, and duplicate that derived salt in the
  --   'g3pInputs_username' and 'g3pSalt_contextTags' parameters, and inside
  --   the role parameter of 'G3PSprout'.
  --
  --   This repetition of an account's salt ensures that any collision that
  --   happens between accounts must occur quite late.  Even if a
  --   cryptographically non-trivial collision happens before the
  --   repetition, the account's salt will push the output hashes apart
  --   once again.
  --
  --   Including the account's salt in either the echo key or echo tag
  --   parameters implies a cryptographically non-trivial collision must
  --   happen on the very last HMAC call that generates any output block,
  --   and that must happen on every output block.
  --
  --   Disconnecting login names from publicly-facing screen names can
  --   represent a significant upgrade of "sand in the gears" to something
  --   resembling a proper defensive line, though this disconnection can
  --   also benefit any approach.
  --
  --   For another upgrade, using a random salt per acccount has the potential
  --   to be a far more meaningful defensive line. This brings the advantage
  --   of completely disconnecting public salts from login names, except by
  --   talking to (or compromising) a salt server.
  --
  --   In a rare alignment of interests, this can serve both legitimate
  --   deployments and the password hash thieves that attack them. Some thieves
  --   will want to be able to outsource password cracking work without giving
  --   successful crackers an opportunity to log in, and this makes it easier
  --   for the thief to securely withhold the login name from the cracker.
  --
  --   The cost is that in typical client-side prehashing scenarios, a salt
  --   server will have to reveal the actual salt for arbitrary accounts
  --   to arbitrary members of the public. This has the potential to leak
  --   information about the (non-)existence of accounts and to leak
  --   information about recent account activity.
  --
  --   Of particular concern is providing reidentification hooks that
  --   enable deanonymization attacks. Though I don't exactly understand
  --   how a public-facing salt server could become such a hook, it's also
  --   something that seems possible.
  --
  --   This issue could be largely mitigated by ensuring your salt server is
  --   capable of handing out convincing nonsense that is consistent over time.
  --   The server does not even need to remember every fake salt you've ever
  --   handed out. For example, the server could generate a fake salt by
  --   hashing a normalized version of the nonexistent login name with a
  --   secret key.
  --
  --   If you are running a sufficiently sensitive identity service to
  --   justify the additional complexity and ongoing operational costs,
  --   running a salt server seems very much worthwhile.
  --
  --   One reason is that when a password hash is stolen, having a login
  --   name in its derivation can be a reidentification hook without even
  --   needing to talk to a server. On the other hand, salt derived from
  --   a login name seems far preferable to a poorly implemented salt server.
  --
  --   A poorly implemented server can become a toehold for attackers to
  --   get inside your infrastructure, and has the potential to leak
  --   whether or not an account exists, possibly even to the general public.
  --   Account existence can itself be an extremely juicy reidentification
  --   hook, and querying a public server doesn't require stealing password
  --   hashes first.
  --
  --   In a few specialized cases it might be possible to hide a random salt
  --   from members of the general public by requiring pre-authentication
  --   before the password can even be attempted. However, this cannot
  --   be a general-purpose solution, as passwords are one of the fundamental
  --   solutions to the problem of key management, and key management is
  --   the fundamental problem behind authentication.
  --
  --   One might also supplement or replace any salt applied here with an
  --   oblivious pseudorandom function (OPRF) in your authentication flow,
  --   especially if password-authenticated key agreement (PAKE) is used.
  --
  --   Through the magic of multiparty computation, it's possible to apply a
  --   salt that only the server knows to a password attempt that only the
  --   client knowns. However, OPRF cannot be directly integrated into the G3P,
  --   though the G3P should be an excellent choice for a key derivation
  --   function to prepare a password for OPRF.
  --
  --   I see this choice of plain usernames versus random salts or possibly
  --   even none at all as a fairly fundamental tradeoff in the design of G3P
  --   deployments. I took the time to ensure that all are possible.
  --
  --   In my estimation, of the approaches that I've started to sketch,
  --   deriving salts directly from plaintext login names in a public,
  --   non-secret way is the hardest to mess up badly.
  --
  --   Implementing a salt server potentially enables signficant security
  --   advantages, but also represents additional complexity, operational
  --   expense, and itself creates additional attack surfaces and security
  --   risks.
  --
  --   This decision has significant strategic consequences. I don't think
  --   there exists a one-size-fits-all solution, and there are quite a few
  --   ways to sensibly customize each approach. Any can be executed poorly,
  --   and any can be executed well. Pick your poison wisely.
  , G3PInputs -> ByteString
g3pInputs_password :: !ByteString
  -- ^ constant time on 0-293 bytes, or if any of the other conditions are met.
  , G3PInputs -> Vector ByteString
g3pInputs_credentials :: !(Vector ByteString)
  -- ^ constant time on 0-282 encoded bytes. This includes variable-length
  --   fields that encode the bit length of each string; these fields itself
  --   require two or more bytes per string.
  } deriving (G3PInputs -> G3PInputs -> Bool
(G3PInputs -> G3PInputs -> Bool)
-> (G3PInputs -> G3PInputs -> Bool) -> Eq G3PInputs
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: G3PInputs -> G3PInputs -> Bool
== :: G3PInputs -> G3PInputs -> Bool
$c/= :: G3PInputs -> G3PInputs -> Bool
/= :: G3PInputs -> G3PInputs -> Bool
Eq)

data G3PSeedInputs = G3PSeedInputs -- ^ bcrypt parameters
  { G3PSeedInputs -> HmacKey
g3pSeedInputs_bcryptSeguid :: !HmacKey
    -- ^ Key to used to generate keys for bcrypt superrounds and to soak up
    --   the entropy from bcrypt's state at the end of each superround.
    --   Duplicating the 'g3pSalt_seguid' is a good default choice.
  , G3PSeedInputs -> Vector ByteString
g3pSeedInputs_bcryptCredentials :: !(Vector ByteString)
    -- ^ Used directly once to derive @key0@ for the first bcrypt superround,
    --   and indirectly affects every cryptographic operation after that.
    --
    --   0-29 bytes are free. The length encoding for each bytestring needs
    --   to be included, thus 0-27 data bytes incur zero incremental cost if
    --   you encode everything in one string, or less if you use more than
    --   one string.
    --
    --   Overages cost one SHA256 block per 64 bytes, rounded up. Thus, this
    --   is a horn-loaded parameter introduced after the phkdf key-stretching
    --   phase is complete.
    --
    --   If some unusual deployment of the G3P accepts arbitrary external
    --   inputs into the @bcryptLongTag@, one possible way to handle this
    --   situation efficiently and safely would be to include the entire
    --   input in this parameter. This is not necessary if such a deployment
    --   duplicated the external input into both the 'g3pSalt_longTag' and
    --   'g3pSeedInputs_bcryptLongTag' parameters.
  , G3PSeedInputs -> ByteString
g3pSeedInputs_bcryptLongTag :: !ByteString
    -- ^ Be aware this is truncated to (rounds + 1) * 4136 bytes, but
    --   length still matters after that. The primary intended use is to
    --   duplicate 'g3pSalt_longTag' a very large number of times.
    --
    --   Also be aware that nobody should trust this parameter with arbitrary,
    --   potentially hostile input that is selected after all of the other
    --   inputs to the bcrypt computation are known. There are, however,
    --   a large number of ways to avoid any potential issue, including:
    --
    --   1.  Ensuring that this input is fully commited to before looking
    --       at all of the other input parameters /by convention/, which is
    --       true in the primary intended use case as an extended plaintext
    --       salt for password hashing.
    --
    --   2.  Ensure that this input has been committed to by including the
    --       entirety of its contents in the derivation of at least one other
    --       input parameter. Note that duplicating 'g3pSalt_longTag' is
    --       sufficient to meet this requirement.  Including it somewhere in
    --       a 'G3PSalt' parameter is highly recommended as it ensures that
    --       varying any part of this parameter is expensive as possible.
    --
    --   3.  Ensure that this input is 4287 bytes or less. Local HMAC
    --       computations ensure at least this many bytes are automatically
    --       committed to before the bcrypt key stretching is allowed to
    --       move forward.
    --
    --   4.  Ensure that this input has some kind, any kind, of recognizable
    --       pattern. If this input is a valid UTF8 encoding, it doesn't matter
    --       if the textual content is random gibberish. It's extremely
    --       doubtful that an attacker could achieve any particularly
    --       nefarious goal under this restriction.
    --
    --   Note that any single one of these conditions should be sufficient
    --   to avoid problems, and that the primary intended use case for this
    --   parameter meets all of them. After all, the entire point of this
    --   parameter is to ensure the delivery of plaintext salts from
    --   authentication database deployments to password crackers.
    --
    --   Failing all of that, there's still an attempt to make the G3P
    --   resistant to hostile inputs. Within each bcrypt round, the exact same
    --   longTag bytes are repeated four times in a combinatorial block design
    --   that ensures nonlinear effects.
    --
    --   I wouldn't want to rely on this design feature of last resort without
    --   careful study, which is likely to suggest further improvements.
    --   Yet this hedge doesn't cost anything with respect to the intended
    --   use case, and seems plausibly strong in situations that fall well
    --   outside any intended use case.
    --
    --   Regarding condition 2, any of the 'G3PInput' parameters would also
    --   qualify. However, it would be rather silly to repeat the user's
    --   password here, as that would prevent the bcrypt key stretching
    --   computation from being securely outsourced to a semi-trusted device.
    --
    --   Regarding condition 3, the actual size of a parameter that is fully
    --   committed to via baked-in hashing is likely more than 8192 bytes, but
    --   this would require further verification.
    --
    --   The shortest plausible attack string would seem to need to be as long
    --   as the truncation limit, which is north of 16 megabytes if you specify
    --   the suggested 4000 rounds.
    --
    --   Here, the attack model of concern is preventing any external input
    --   from affecting the final bcrypt state in any way that's better than
    --   a multiplicity of fair coin flips.
    --
    --   Failing to fully commit to the bcrypt long tag up-front potentially
    --   allows external input to tweak the final result without redoing
    --   the entirety of the key-stretching computation, even if the desired
    --   fairness property is ensured.
    --
    --   This final bcrypt state is then consumed as part of an HMAC message.
    --   This outer HMAC provides the next line of defense against this type of
    --   attack. This line of defense pretends this outer HMAC doesn't exist.
  , G3PSeedInputs -> Vector ByteString
g3pSeedInputs_bcryptContextTags :: !(Vector ByteString)
    -- ^ Also used to derive super round keys for bcrypt.  0-63 encoded
    --   bytes are free, meaning that 60 bytes impose zero incremental cost
    --   if you encode everything into one string, or somewhat less if you use
    --   more than one string.
    --
    --   Overages cost two SHA-256 blocks per 64 bytes per bcrypt superround.
    --
    --   Leaving this empty is a good default choice. In particular, one
    --   /should not/ default to duplicating anything between this parameter
    --   and the 'g3pSeed_contextTags' parameter.
    --
    --   For example, if your deployment uses a random account salt, or
    --   an account salt derived transparently from a login name, then it's
    --   a good idea to include that salt in the 'username' and 'contextTags'
    --   parameters, but exclude the plaintext of that salt from
    --   'bcryptContextTags'.
    --
    --   This use of an account salt implies that if some or all of the bcrypt
    --   computation is outsourced to another device, that device cannot
    --   break the password without knowing the salt, or successfully
    --   guessing both the salt and password at the same time.
    --
    --   Assuming simplest and most-intended outsourcing algorithm, directly
    --   including that account salt in the 'bcryptContextTags' vector would
    --   require that the plaintext of this salt be known to the device
    --   performing the key-stretching computation, thus automatically
    --   obviating this possible line of defense.
    --
    --   If one is absolutely set on including that random salt here, one
    --   could hash the salt first to derive a new salt that cannot itself
    --   be used to crack the password. What things are forgotten and when
    --   are important details in cryptographic processes, and these choices
    --   have strategic implications.
    --
    --   Alternatively, one could implement the G3P using a more sophisticated
    --   outsourcing algorithm. This would require interactive communication
    --   every transition between bcrypt superrounds. By contrast, the design
    --   intension is to be able to treat outsourcing bcrypt as (relatively)
    --   simple remote procedure call (RPC).
  , G3PSeedInputs -> ByteString
g3pSeedInputs_bcryptDomainTag :: !ByteString
    -- ^ Used to derive the keys for a super round in bcrypt-xs-ctr mode.
    --   Duplicating the 'g3pSalt_domainTag' is a good default choice.
    --
    --   0-19 bytes are free. 20-83 bytes and every 64 bytes thereafter
    --   impose a cost of two SHA-256 blocks per bcrypt superround.
  , G3PSeedInputs -> Word32
g3pSeedInputs_bcryptRounds :: !Word32
    -- ^ How expensive will the bcrypt component be? 4000 rounds recommended,
    --   give or take a factor of 2 or so. Each bcrypt round is approximately
    --   as time consuming as 60 PHKDF rounds. Using the recommended cost,
    --   parameters, the cost should be dominated by bcrypt.
    --
    --   The number of superrounds matters for some cost calculations. This is
    --   always @ceiling ((bcryptRounds + 1) / 128)@.
  }

-- | The Global Password Prehash Protocol (G3P). Note that this function is very
--   intentionally implemented in such a way that the following idiom is
--   efficient. It performs the expensive key stretching phase only once,
--   and results in 3 cryptographically independent output hashes, i.e.
--   statistically independent to any efficient attacker that does not have
--   access to the underlying password and other secrets.
--
-- @
--  let myDomain = "my.domain.example"
--      myLoginDomain = "login.my.domain.example"
--      myStorageDomain = "cloud.my.domain.example"
--      myLongTag = "My Corporation, Inc. https://my.domain.example/.well-known/security.txt"
--      mySeguid = hmacKey "9c08053b7e507a78b571b5b93e1326674540d7106da6408fcafeddcfcdf1ed76"
--      userRandomSalt = "60473b8010e16d46"
--      userSecondSecretHash = "0c06f683f093cb899b4a1e9836fc7281"
--      mySalt =
--        G3PSalt {
--          g3pSalt_seguid = mySeguid,
--          g3pSalt_longTag = myLongTag,
--          g3pSalt_contextTags = [userRandomSalt],
--          g3pSalt_domainTag = myDomain,
--          g3pSalt_phkdfRounds = 20240
--        }
--      myInputs =
--        G3PInputs {
--          g3pInputs_username = userRandomSalt,
--          g3pInputs_password = "correct horse battery staple",
--          g3pInputs_credentials = [userSecondSecretHash]
--        }
--      mySeedInputs =
--        G3PSeedInputs {
--          g3pSeedInputs_bcryptSeguid = mySeguid,
--          g3pSeedInputs_bcryptCredentials = [],
--          g3pSeedInputs_bcryptLongTag = myLongTag,
--          g3pSeedInputs_bcryptContextTags = [],
--          g3pSeedInputs_bcryptDomainTag = myDomain,
--          g3pSeedInputs_bcryptRounds = 4202
--        }
--      mySprout = g3pHash mySalt myInputs mySeedInputs mySeguid
--      myHeader = userRandomSalt <> myDomain
--      myAuthKey = mySprout ["auth",userRandomSalt]
--                      myLoginDomain myHeader myHeader (word32 "AUTH")
--      myDiskKey = mySprout
--                     ["disk", myStorageDomain, myLongTag,
--                      "key", "7014dad47f0e7f7157d99b39a06553ce"]
--                     myStorageDomain myHeader myHeader (word32 "DISK")
--   in [ myAuthKey myLongTag
--      , myDiskKey "filename0.txt"
--      , myDiskKey "quarterly-report.pdf"
--      ]
-- @
--
--   In addition to sharing the main key-stretching computation among
--   all three independent output hashes, @myDiskKey@ also shares the
--   'G3PSprout' to 'G3PKey' computation among two different calls.
--   Although this savings is relatively miniscule, it can also be
--   relevant in certain contexts.
--
--   Note that this example is intended to be an extremely accurate sketch
--   of what a good authentication deployment that uses random salts or hashed
--   usernames and not plaintext usernames would look like.
--
--   Other details are more to stimulate ideas about how one might use these
--   things: for example I'd highly recommend using 64-byte binary @mySeguid@,
--   a 16-byte binary @userRandomSalt@, and a 32-byte binary
--   @userSecondSecretHash@, and I'd probably not use @myDiskKey@ in exactly
--   that way.
--
--   This example emphasizes that the G3P is designed to preserve endless
--   possibilites for keying end-to-end encryption (E2EE) off of the user's
--   password, though deploying a the G3P as a client-side prehash function
--   is absolutely required to make use of that particular capability.
--
--   In the example above, the extended interface could be used to partially
--   evaluate the sprout on the storage domain, allowing the 'G3PSeed' to be
--   immediately forgotten. Later, the continuation of that partially evaluated
--   sprout can be finalized once the storage key is provided by the server
--   upon a successful authentication.
--
--   This approach has the minor complication of needing to ensure that
--   any important data has been fully committed to and isn't sitting around
--   inside the sprout's SHA256 context buffer. This can be done by including
--   at least 63 bytes of non-committing data anywhere you need a safe
--   partial evaluation point.
--
--   Thus the inclusion of @myLongTag@ in the storage role vector ensures that
--   the original seed, the @"disk"@, and the @"cloud.my.domain.example"@
--   strings can be fully committed to while waiting for the disk key.
--
--   Another possibility is to use filler padding to control the context
--   buffer position; I suggest using 32-95 or more bytes, as this ensures
--   the encoded length is 3 bytes long and thus ensures that your desired
--   buffer position can be reached from any starting point.
--
--   In the case that you want or need to persist or serialize the
--   intermediate structures, then the plain-old-datatypes 'G3PSpark',
--   'G3PSeed', 'G3PSprout', 'G3PTree','G3PKey', 'G3PSource', and their
--   associated functions are more relevant than implicit closures.
--
--   These data structures explicitly represent the result of a partial
--   evaluation, and provide a continuation onward to any one of innumerable
--   final results.

-- Oof, I didn't actually succeed in my claim about the g3pHash supporting
-- efficient partial application in the first release of G3Pb1.
--
-- I now have a deeper appreciation for point-less programming.

g3pHash
  :: Foldable f
  => G3PSalt -- ^ All the parameters needed throughout the entire key-stretching computation.
  -> G3PInputs -- ^ All the parameters that can be forgotten as soon as they are hashed once.
  -> G3PSeedInputs -- ^ All the parameters needed for bcrypt-based key stretching
  -> HmacKey -- ^ Sprout Seguid. A good default is to duplicate 'g3pSalt_seguid'.
  -> f ByteString -- ^ Sprout Role, an arbitrary number of bytestring parameters for late domain separation occuring after key-stretching is complete.  Meaning is deployment defined.
  -> ByteString -- ^ Sprout Tag. A good default is to duplicate 'g3pSalt_domainTag'.
  -> ByteString -- ^ This @echo key@ is the right half of the output key.  It is truncated to 32 bytes.
  -> ByteString
  -- ^ The @echo header@ is truncated to 32 bytes.
  --
  -- As the initial state of the output stream generator, if more than one
  -- block of the resulting output stream is ever examined, then this
  -- parameter must not include any new secrets. Otherwise the old secrets
  -- are potentially still crackable from the relationship between output
  -- stream blocks.
  --
  -- This problem can be avoided by ensuring at least one of these are true:
  --
  --     1.  Sticking to anodyne messages that aren't too specifically
  --         related to this password attempt, like a company name.
  --
  --     2.  including data that's already been included earlier in the
  --         derivation chain, i.e. deeper in the Merkle tree
  --
  --     3.  duplicating the content of this parameter in the @echo key@
  --         and/or @echo tag@ parameters.
  --
  --     4.  never examine more than one output block.
  --
  -- It is possible to use this parameter safely in ways that don't exactly
  -- meet any of the criteria above, but these criteria would seem to fairly
  -- comprehensively cover typical use cases. I'm not sure why a deployment
  -- designer might feel a need to go beyond these criteria.
  --
  -- Also note that if you feed an output block from _G3Pb2 echo_ back into
  -- this parameter, keep the keys and tag the same, and update the counter
  -- accordingly, then this will "collide" with the next output block of the
  -- original generator.  This issue can be avoided by a deployment, so it's
  --  better to not get too creative with this specific parameter.
  -> Word32 -- ^ echo counter
  -> ByteString -- ^ echo tag. A good default is to duplicate the sprout's tag.
  -> ByteString
  -- ^ a 32-byte output hash. You can use the stream variant if you want more
  --   blocks. This is the first output block of that stream.
g3pHash :: forall (f :: * -> *).
Foldable f =>
G3PSalt
-> G3PInputs
-> G3PSeedInputs
-> HmacKey
-> f ByteString
-> ByteString
-> ByteString
-> ByteString
-> Word32
-> ByteString
-> ByteString
g3pHash = ( ((G3PInputs
  -> G3PSeedInputs
  -> HmacKey
  -> f ByteString
  -> ByteString
  -> ByteString
  -> ByteString
  -> Word32
  -> ByteString
  -> G3PSource)
 -> G3PInputs
 -> G3PSeedInputs
 -> HmacKey
 -> f ByteString
 -> ByteString
 -> ByteString
 -> ByteString
 -> Word32
 -> ByteString
 -> ByteString)
-> (G3PSalt
    -> G3PInputs
    -> G3PSeedInputs
    -> HmacKey
    -> f ByteString
    -> ByteString
    -> ByteString
    -> ByteString
    -> Word32
    -> ByteString
    -> G3PSource)
-> G3PSalt
-> G3PInputs
-> G3PSeedInputs
-> HmacKey
-> f ByteString
-> ByteString
-> ByteString
-> ByteString
-> Word32
-> ByteString
-> ByteString
forall a b. (a -> b) -> (G3PSalt -> a) -> G3PSalt -> b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (((G3PInputs
   -> G3PSeedInputs
   -> HmacKey
   -> f ByteString
   -> ByteString
   -> ByteString
   -> ByteString
   -> Word32
   -> ByteString
   -> G3PSource)
  -> G3PInputs
  -> G3PSeedInputs
  -> HmacKey
  -> f ByteString
  -> ByteString
  -> ByteString
  -> ByteString
  -> Word32
  -> ByteString
  -> ByteString)
 -> (G3PSalt
     -> G3PInputs
     -> G3PSeedInputs
     -> HmacKey
     -> f ByteString
     -> ByteString
     -> ByteString
     -> ByteString
     -> Word32
     -> ByteString
     -> G3PSource)
 -> G3PSalt
 -> G3PInputs
 -> G3PSeedInputs
 -> HmacKey
 -> f ByteString
 -> ByteString
 -> ByteString
 -> ByteString
 -> Word32
 -> ByteString
 -> ByteString)
-> ((G3PSource -> ByteString)
    -> (G3PInputs
        -> G3PSeedInputs
        -> HmacKey
        -> f ByteString
        -> ByteString
        -> ByteString
        -> ByteString
        -> Word32
        -> ByteString
        -> G3PSource)
    -> G3PInputs
    -> G3PSeedInputs
    -> HmacKey
    -> f ByteString
    -> ByteString
    -> ByteString
    -> ByteString
    -> Word32
    -> ByteString
    -> ByteString)
-> (G3PSource -> ByteString)
-> (G3PSalt
    -> G3PInputs
    -> G3PSeedInputs
    -> HmacKey
    -> f ByteString
    -> ByteString
    -> ByteString
    -> ByteString
    -> Word32
    -> ByteString
    -> G3PSource)
-> G3PSalt
-> G3PInputs
-> G3PSeedInputs
-> HmacKey
-> f ByteString
-> ByteString
-> ByteString
-> ByteString
-> Word32
-> ByteString
-> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((G3PSeedInputs
  -> HmacKey
  -> f ByteString
  -> ByteString
  -> ByteString
  -> ByteString
  -> Word32
  -> ByteString
  -> G3PSource)
 -> G3PSeedInputs
 -> HmacKey
 -> f ByteString
 -> ByteString
 -> ByteString
 -> ByteString
 -> Word32
 -> ByteString
 -> ByteString)
-> (G3PInputs
    -> G3PSeedInputs
    -> HmacKey
    -> f ByteString
    -> ByteString
    -> ByteString
    -> ByteString
    -> Word32
    -> ByteString
    -> G3PSource)
-> G3PInputs
-> G3PSeedInputs
-> HmacKey
-> f ByteString
-> ByteString
-> ByteString
-> ByteString
-> Word32
-> ByteString
-> ByteString
forall a b. (a -> b) -> (G3PInputs -> a) -> G3PInputs -> b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (((G3PSeedInputs
   -> HmacKey
   -> f ByteString
   -> ByteString
   -> ByteString
   -> ByteString
   -> Word32
   -> ByteString
   -> G3PSource)
  -> G3PSeedInputs
  -> HmacKey
  -> f ByteString
  -> ByteString
  -> ByteString
  -> ByteString
  -> Word32
  -> ByteString
  -> ByteString)
 -> (G3PInputs
     -> G3PSeedInputs
     -> HmacKey
     -> f ByteString
     -> ByteString
     -> ByteString
     -> ByteString
     -> Word32
     -> ByteString
     -> G3PSource)
 -> G3PInputs
 -> G3PSeedInputs
 -> HmacKey
 -> f ByteString
 -> ByteString
 -> ByteString
 -> ByteString
 -> Word32
 -> ByteString
 -> ByteString)
-> ((G3PSource -> ByteString)
    -> (G3PSeedInputs
        -> HmacKey
        -> f ByteString
        -> ByteString
        -> ByteString
        -> ByteString
        -> Word32
        -> ByteString
        -> G3PSource)
    -> G3PSeedInputs
    -> HmacKey
    -> f ByteString
    -> ByteString
    -> ByteString
    -> ByteString
    -> Word32
    -> ByteString
    -> ByteString)
-> (G3PSource -> ByteString)
-> (G3PInputs
    -> G3PSeedInputs
    -> HmacKey
    -> f ByteString
    -> ByteString
    -> ByteString
    -> ByteString
    -> Word32
    -> ByteString
    -> G3PSource)
-> G3PInputs
-> G3PSeedInputs
-> HmacKey
-> f ByteString
-> ByteString
-> ByteString
-> ByteString
-> Word32
-> ByteString
-> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((HmacKey
  -> f ByteString
  -> ByteString
  -> ByteString
  -> ByteString
  -> Word32
  -> ByteString
  -> G3PSource)
 -> HmacKey
 -> f ByteString
 -> ByteString
 -> ByteString
 -> ByteString
 -> Word32
 -> ByteString
 -> ByteString)
-> (G3PSeedInputs
    -> HmacKey
    -> f ByteString
    -> ByteString
    -> ByteString
    -> ByteString
    -> Word32
    -> ByteString
    -> G3PSource)
-> G3PSeedInputs
-> HmacKey
-> f ByteString
-> ByteString
-> ByteString
-> ByteString
-> Word32
-> ByteString
-> ByteString
forall a b. (a -> b) -> (G3PSeedInputs -> a) -> G3PSeedInputs -> b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (((HmacKey
   -> f ByteString
   -> ByteString
   -> ByteString
   -> ByteString
   -> Word32
   -> ByteString
   -> G3PSource)
  -> HmacKey
  -> f ByteString
  -> ByteString
  -> ByteString
  -> ByteString
  -> Word32
  -> ByteString
  -> ByteString)
 -> (G3PSeedInputs
     -> HmacKey
     -> f ByteString
     -> ByteString
     -> ByteString
     -> ByteString
     -> Word32
     -> ByteString
     -> G3PSource)
 -> G3PSeedInputs
 -> HmacKey
 -> f ByteString
 -> ByteString
 -> ByteString
 -> ByteString
 -> Word32
 -> ByteString
 -> ByteString)
-> ((G3PSource -> ByteString)
    -> (HmacKey
        -> f ByteString
        -> ByteString
        -> ByteString
        -> ByteString
        -> Word32
        -> ByteString
        -> G3PSource)
    -> HmacKey
    -> f ByteString
    -> ByteString
    -> ByteString
    -> ByteString
    -> Word32
    -> ByteString
    -> ByteString)
-> (G3PSource -> ByteString)
-> (G3PSeedInputs
    -> HmacKey
    -> f ByteString
    -> ByteString
    -> ByteString
    -> ByteString
    -> Word32
    -> ByteString
    -> G3PSource)
-> G3PSeedInputs
-> HmacKey
-> f ByteString
-> ByteString
-> ByteString
-> ByteString
-> Word32
-> ByteString
-> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((f ByteString
  -> ByteString
  -> ByteString
  -> ByteString
  -> Word32
  -> ByteString
  -> G3PSource)
 -> f ByteString
 -> ByteString
 -> ByteString
 -> ByteString
 -> Word32
 -> ByteString
 -> ByteString)
-> (HmacKey
    -> f ByteString
    -> ByteString
    -> ByteString
    -> ByteString
    -> Word32
    -> ByteString
    -> G3PSource)
-> HmacKey
-> f ByteString
-> ByteString
-> ByteString
-> ByteString
-> Word32
-> ByteString
-> ByteString
forall a b. (a -> b) -> (HmacKey -> a) -> HmacKey -> b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (((f ByteString
   -> ByteString
   -> ByteString
   -> ByteString
   -> Word32
   -> ByteString
   -> G3PSource)
  -> f ByteString
  -> ByteString
  -> ByteString
  -> ByteString
  -> Word32
  -> ByteString
  -> ByteString)
 -> (HmacKey
     -> f ByteString
     -> ByteString
     -> ByteString
     -> ByteString
     -> Word32
     -> ByteString
     -> G3PSource)
 -> HmacKey
 -> f ByteString
 -> ByteString
 -> ByteString
 -> ByteString
 -> Word32
 -> ByteString
 -> ByteString)
-> ((G3PSource -> ByteString)
    -> (f ByteString
        -> ByteString
        -> ByteString
        -> ByteString
        -> Word32
        -> ByteString
        -> G3PSource)
    -> f ByteString
    -> ByteString
    -> ByteString
    -> ByteString
    -> Word32
    -> ByteString
    -> ByteString)
-> (G3PSource -> ByteString)
-> (HmacKey
    -> f ByteString
    -> ByteString
    -> ByteString
    -> ByteString
    -> Word32
    -> ByteString
    -> G3PSource)
-> HmacKey
-> f ByteString
-> ByteString
-> ByteString
-> ByteString
-> Word32
-> ByteString
-> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((ByteString
  -> ByteString -> ByteString -> Word32 -> ByteString -> G3PSource)
 -> ByteString
 -> ByteString
 -> ByteString
 -> Word32
 -> ByteString
 -> ByteString)
-> (f ByteString
    -> ByteString
    -> ByteString
    -> ByteString
    -> Word32
    -> ByteString
    -> G3PSource)
-> f ByteString
-> ByteString
-> ByteString
-> ByteString
-> Word32
-> ByteString
-> ByteString
forall a b. (a -> b) -> (f ByteString -> a) -> f ByteString -> b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap
          (((ByteString
   -> ByteString -> ByteString -> Word32 -> ByteString -> G3PSource)
  -> ByteString
  -> ByteString
  -> ByteString
  -> Word32
  -> ByteString
  -> ByteString)
 -> (f ByteString
     -> ByteString
     -> ByteString
     -> ByteString
     -> Word32
     -> ByteString
     -> G3PSource)
 -> f ByteString
 -> ByteString
 -> ByteString
 -> ByteString
 -> Word32
 -> ByteString
 -> ByteString)
-> ((G3PSource -> ByteString)
    -> (ByteString
        -> ByteString -> ByteString -> Word32 -> ByteString -> G3PSource)
    -> ByteString
    -> ByteString
    -> ByteString
    -> Word32
    -> ByteString
    -> ByteString)
-> (G3PSource -> ByteString)
-> (f ByteString
    -> ByteString
    -> ByteString
    -> ByteString
    -> Word32
    -> ByteString
    -> G3PSource)
-> f ByteString
-> ByteString
-> ByteString
-> ByteString
-> Word32
-> ByteString
-> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((ByteString -> ByteString -> Word32 -> ByteString -> G3PSource)
 -> ByteString -> ByteString -> Word32 -> ByteString -> ByteString)
-> (ByteString
    -> ByteString -> ByteString -> Word32 -> ByteString -> G3PSource)
-> ByteString
-> ByteString
-> ByteString
-> Word32
-> ByteString
-> ByteString
forall a b. (a -> b) -> (ByteString -> a) -> ByteString -> b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (((ByteString -> ByteString -> Word32 -> ByteString -> G3PSource)
  -> ByteString -> ByteString -> Word32 -> ByteString -> ByteString)
 -> (ByteString
     -> ByteString -> ByteString -> Word32 -> ByteString -> G3PSource)
 -> ByteString
 -> ByteString
 -> ByteString
 -> Word32
 -> ByteString
 -> ByteString)
-> ((G3PSource -> ByteString)
    -> (ByteString -> ByteString -> Word32 -> ByteString -> G3PSource)
    -> ByteString
    -> ByteString
    -> Word32
    -> ByteString
    -> ByteString)
-> (G3PSource -> ByteString)
-> (ByteString
    -> ByteString -> ByteString -> Word32 -> ByteString -> G3PSource)
-> ByteString
-> ByteString
-> ByteString
-> Word32
-> ByteString
-> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((ByteString -> Word32 -> ByteString -> G3PSource)
 -> ByteString -> Word32 -> ByteString -> ByteString)
-> (ByteString -> ByteString -> Word32 -> ByteString -> G3PSource)
-> ByteString
-> ByteString
-> Word32
-> ByteString
-> ByteString
forall a b. (a -> b) -> (ByteString -> a) -> ByteString -> b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (((ByteString -> Word32 -> ByteString -> G3PSource)
  -> ByteString -> Word32 -> ByteString -> ByteString)
 -> (ByteString -> ByteString -> Word32 -> ByteString -> G3PSource)
 -> ByteString
 -> ByteString
 -> Word32
 -> ByteString
 -> ByteString)
-> ((G3PSource -> ByteString)
    -> (ByteString -> Word32 -> ByteString -> G3PSource)
    -> ByteString
    -> Word32
    -> ByteString
    -> ByteString)
-> (G3PSource -> ByteString)
-> (ByteString -> ByteString -> Word32 -> ByteString -> G3PSource)
-> ByteString
-> ByteString
-> Word32
-> ByteString
-> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Word32 -> ByteString -> G3PSource)
 -> Word32 -> ByteString -> ByteString)
-> (ByteString -> Word32 -> ByteString -> G3PSource)
-> ByteString
-> Word32
-> ByteString
-> ByteString
forall a b. (a -> b) -> (ByteString -> a) -> ByteString -> b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (((Word32 -> ByteString -> G3PSource)
  -> Word32 -> ByteString -> ByteString)
 -> (ByteString -> Word32 -> ByteString -> G3PSource)
 -> ByteString
 -> Word32
 -> ByteString
 -> ByteString)
-> ((G3PSource -> ByteString)
    -> (Word32 -> ByteString -> G3PSource)
    -> Word32
    -> ByteString
    -> ByteString)
-> (G3PSource -> ByteString)
-> (ByteString -> Word32 -> ByteString -> G3PSource)
-> ByteString
-> Word32
-> ByteString
-> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((ByteString -> G3PSource) -> ByteString -> ByteString)
-> (Word32 -> ByteString -> G3PSource)
-> Word32
-> ByteString
-> ByteString
forall a b. (a -> b) -> (Word32 -> a) -> Word32 -> b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (((ByteString -> G3PSource) -> ByteString -> ByteString)
 -> (Word32 -> ByteString -> G3PSource)
 -> Word32
 -> ByteString
 -> ByteString)
-> ((G3PSource -> ByteString)
    -> (ByteString -> G3PSource) -> ByteString -> ByteString)
-> (G3PSource -> ByteString)
-> (Word32 -> ByteString -> G3PSource)
-> Word32
-> ByteString
-> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (G3PSource -> ByteString)
-> (ByteString -> G3PSource) -> ByteString -> ByteString
forall a b. (a -> b) -> (ByteString -> a) -> ByteString -> b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((G3PSource -> ByteString)
 -> (G3PSalt
     -> G3PInputs
     -> G3PSeedInputs
     -> HmacKey
     -> f ByteString
     -> ByteString
     -> ByteString
     -> ByteString
     -> Word32
     -> ByteString
     -> G3PSource)
 -> G3PSalt
 -> G3PInputs
 -> G3PSeedInputs
 -> HmacKey
 -> f ByteString
 -> ByteString
 -> ByteString
 -> ByteString
 -> Word32
 -> ByteString
 -> ByteString)
-> (G3PSource -> ByteString)
-> (G3PSalt
    -> G3PInputs
    -> G3PSeedInputs
    -> HmacKey
    -> f ByteString
    -> ByteString
    -> ByteString
    -> ByteString
    -> Word32
    -> ByteString
    -> G3PSource)
-> G3PSalt
-> G3PInputs
-> G3PSeedInputs
-> HmacKey
-> f ByteString
-> ByteString
-> ByteString
-> ByteString
-> Word32
-> ByteString
-> ByteString
forall a b. (a -> b) -> a -> b
$ G3PSource -> ByteString
g3pSource_head) G3PSalt
-> G3PInputs
-> G3PSeedInputs
-> HmacKey
-> f ByteString
-> ByteString
-> ByteString
-> ByteString
-> Word32
-> ByteString
-> G3PSource
forall (f :: * -> *).
Foldable f =>
G3PSalt
-> G3PInputs
-> G3PSeedInputs
-> HmacKey
-> f ByteString
-> ByteString
-> ByteString
-> ByteString
-> Word32
-> ByteString
-> G3PSource
g3pSource

-- | 'g3pSpark' encompasses calls to @G3Pb2 alfa@ and @G3Pb2 bravo@, which
--   provides the PHKDF-based key-stretching phase.
--
--   All 8 parameters get unambiguously encoded into @G3Pb2 alfa@, which is
--   the initial call to HMAC. 7 of them can be unambiguously parsed out of
--   the input message, thus proving that all collisions over them are
--   cryptographically non-trivial. The eighth is used as the HMAC key.
--
--   Moreover, the G3P's syntax generators never examine the content of any
--   input, only length. Thus by [parametricity](https://en.wikipedia.org/wiki/Parametricity),
--   any vaguely reasonable attempt to implement the G3P cannot be directly
--   responsible for introducing a data-dependent side channel.
--
--   The hash resulting from this initial HMAC-Extract, in addition to the
--   'G3PSalt' parameters, determine the exact size, shape, and content of the
--   Merkle tree that describes the resulting spark. At this point in time
--   every computation is fully determined all the way to the end of the
--   PHKDF key-stretching phase.  The next opportunity to make a choice is
--   the bcrypt key-stretching phase.
--
--   A spark consists of two cryptographically independent keys: keyB which
--   begins bcrypt, and keyC which is the continuation control key. The
--   continuation control key allows some or all of the bcrypt computation
--   to be outsourced to another semi-trusted device, without giving that
--   device the ability to compute the final seed.

g3pSpark
  :: G3PSalt -- ^ salt parameters, typically specified by deployment, typically needed throughout PHKDF key stretching
  -> G3PInputs -- ^ input parameters, often provided by the user, ready to be forgotten soon after the computation starts
  -> G3PSpark -- ^ the end of @G3Pb2 bravo@, the beginning of @G3P charlie@
g3pSpark :: G3PSalt -> G3PInputs -> G3PSpark
g3pSpark G3PSalt
salt G3PInputs
inputs = G3PSpark
spark
  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 :: ByteString
domainTag = G3PSalt -> ByteString
g3pSalt_domainTag G3PSalt
salt
    seguid :: HmacKey
seguid = G3PSalt -> HmacKey
g3pSalt_seguid G3PSalt
salt
    longTag :: ByteString
longTag = G3PSalt -> ByteString
g3pSalt_longTag G3PSalt
salt
    contextTags :: Vector ByteString
contextTags = G3PSalt -> Vector ByteString
g3pSalt_contextTags G3PSalt
salt
    phkdfRounds :: Word32
phkdfRounds = G3PSalt -> Word32
g3pSalt_phkdfRounds G3PSalt
salt

    username :: ByteString
username = G3PInputs -> ByteString
g3pInputs_username G3PInputs
inputs
    password :: ByteString
password = G3PInputs -> ByteString
g3pInputs_password G3PInputs
inputs
    credentials :: Vector ByteString
credentials = G3PInputs -> Vector ByteString
g3pInputs_credentials G3PInputs
inputs

    headerAlfa :: [ByteString]
headerAlfa = [ ByteString
"G3Pb2 alfa username", ByteString
username ]

    usernamePadLen :: Int
usernamePadLen = Int
a
      where
        al :: Int
al = [ByteString] -> Int
forall (f :: * -> *). Foldable f => f ByteString -> Int
encodedVectorByteLength [ByteString]
headerAlfa
        a :: Int
a  = Int -> Int -> Int
forall a. (Ord a, Num a, Bits a) => a -> a -> a
add64WhileLt (Int
349 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
al) Int
32

    usernamePadding :: ByteString
usernamePadding = [ByteString] -> ByteString
B.concat ([ByteString] -> ByteString) -> [ByteString] -> ByteString
forall a b. (a -> b) -> a -> b
$
      Int64 -> [ByteString] -> [ByteString]
takeBs (Int -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int
usernamePadLen Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
32)) ([ByteString] -> [ByteString]
forall a. HasCallStack => [a] -> [a]
cycle [ByteString
longTag, ByteString
"\x00"]) [ByteString] -> [ByteString] -> [ByteString]
forall a. [a] -> [a] -> [a]
++
      Int64 -> [ByteString] -> [ByteString]
takeBs Int64
32 [ByteString
domainTag, ByteString
"\x00", ByteString
"password G3Pb2", ByteString
nullBuffer]

    headerUsername :: [ByteString]
headerUsername = [ByteString]
headerAlfa [ByteString] -> [ByteString] -> [ByteString]
forall a. [a] -> [a] -> [a]
++ [ ByteString
usernamePadding ]

    -- password will go here

    headerLongTag :: [ByteString]
headerLongTag =
      [ ByteString
longTag
      , [ByteString] -> ByteString
B.concat
          [ Word32 -> ByteString
forall b. (Integral b, FiniteBits b) => b -> ByteString
bareEncode Word32
phkdfRounds
          , ByteString
"Global Password Prehash Protocol bcryptXsFree v2 G3Pb2"
          ]
      ]

    passwordPadLen :: Int
passwordPadLen = Int
c
      where
        al :: Int
al = [ByteString] -> Int
forall (f :: * -> *). Foldable f => f ByteString -> Int
encodedVectorByteLength [ByteString]
headerLongTag
        a :: Int
a  = Int -> Int -> Int
forall a. (Ord a, Num a, Bits a) => a -> a -> a
add64WhileLt (Int
8605 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
al) Int
4449
        bl :: Int
bl = [ByteString] -> Int
forall (f :: * -> *). Foldable f => f ByteString -> Int
encodedVectorByteLength [ByteString]
headerUsername
        b :: Int
b  = Int -> Int -> Int
forall a. (Ord a, Num a, Bits a) => a -> a -> a
add64WhileLt (Int
a Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
bl) Int
328
        cl :: Int
cl = ByteString -> Int
encodedByteLength ByteString
password
        c :: Int
c  = Int -> Int -> Int
forall a. (Ord a, Num a, Bits a) => a -> a -> a
add64WhileLt (Int
b Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
cl) Int
32

    longPadding :: [ByteString]
longPadding =
      Int64 -> [ByteString] -> [ByteString]
takeBs (Int -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int
passwordPadLen Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
32)) ([ByteString] -> [ByteString]
forall a. HasCallStack => [a] -> [a]
cycle [ByteString
longTag, ByteString
"\x00"]) [ByteString] -> [ByteString] -> [ByteString]
forall a. [a] -> [a] -> [a]
++
      Int64 -> [ByteString] -> [ByteString]
takeBs Int64
32 [ByteString
domainTag, ByteString
"\x00", ByteString
"creds G3Pb2", ByteString
nullBuffer]

    credsPadLen :: Int
credsPadLen = Int
a
      where
        al :: Int
al = Vector ByteString -> Int
forall (f :: * -> *). Foldable f => f ByteString -> Int
encodedVectorByteLength Vector ByteString
credentials
        a :: Int
a  = Int -> Int -> Int
forall a. (Ord a, Num a, Bits a) => a -> a -> a
add64WhileLt (Int
314 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
al) Int
32

    credsPadding :: [ByteString]
credsPadding =
      Int64 -> [ByteString] -> [ByteString]
takeBs (Int -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int
credsPadLen Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
29)) ([ByteString] -> [ByteString]
forall a. HasCallStack => [a] -> [a]
cycle [ByteString
longTag, ByteString
"\x00"]) [ByteString] -> [ByteString] -> [ByteString]
forall a. [a] -> [a] -> [a]
++
      Int64 -> [ByteString] -> [ByteString]
takeBs Int64
29 [ByteString
domainTag, ByteString
"\x00", ByteString
"tags G3Pb2", ByteString
nullBuffer]

    (PairBS ByteString
alfaSum ByteString
alfaExt) =
        HmacKey -> PhkdfCtx
phkdfCtx_init HmacKey
seguid PhkdfCtx -> (PhkdfCtx -> PhkdfCtx) -> PhkdfCtx
forall a b. a -> (a -> b) -> b
&
        [ByteString] -> PhkdfCtx -> PhkdfCtx
forall (f :: * -> *).
Foldable f =>
f ByteString -> PhkdfCtx -> PhkdfCtx
phkdfCtx_feedArgs [ByteString]
headerUsername PhkdfCtx -> (PhkdfCtx -> PhkdfCtx) -> PhkdfCtx
forall a b. a -> (a -> b) -> b
&
        Word64 -> PhkdfCtx -> PhkdfCtx
phkdfCtx_assertBufferPosition' Word64
32 PhkdfCtx -> (PhkdfCtx -> PhkdfCtx) -> PhkdfCtx
forall a b. a -> (a -> b) -> b
&
        ByteString -> PhkdfCtx -> PhkdfCtx
phkdfCtx_feedArg  ByteString
password PhkdfCtx -> (PhkdfCtx -> PhkdfCtx) -> PhkdfCtx
forall a b. a -> (a -> b) -> b
&
        [ByteString] -> PhkdfCtx -> PhkdfCtx
forall (f :: * -> *).
Foldable f =>
f ByteString -> PhkdfCtx -> PhkdfCtx
phkdfCtx_feedArgs [ByteString]
headerLongTag PhkdfCtx -> (PhkdfCtx -> PhkdfCtx) -> PhkdfCtx
forall a b. a -> (a -> b) -> b
&
        [ByteString] -> PhkdfCtx -> PhkdfCtx
forall (f :: * -> *).
Foldable f =>
f ByteString -> PhkdfCtx -> PhkdfCtx
phkdfCtx_feedArgConcat [ByteString]
longPadding PhkdfCtx -> (PhkdfCtx -> PhkdfCtx) -> PhkdfCtx
forall a b. a -> (a -> b) -> b
&
        Word64 -> PhkdfCtx -> PhkdfCtx
phkdfCtx_assertBufferPosition' Word64
32 PhkdfCtx -> (PhkdfCtx -> PhkdfCtx) -> PhkdfCtx
forall a b. a -> (a -> b) -> b
&
        Vector ByteString -> PhkdfCtx -> PhkdfCtx
forall (f :: * -> *).
Foldable f =>
f ByteString -> PhkdfCtx -> PhkdfCtx
phkdfCtx_feedArgs Vector ByteString
credentials PhkdfCtx -> (PhkdfCtx -> PhkdfCtx) -> PhkdfCtx
forall a b. a -> (a -> b) -> b
&
        [ByteString] -> PhkdfCtx -> PhkdfCtx
forall (f :: * -> *).
Foldable f =>
f ByteString -> PhkdfCtx -> PhkdfCtx
phkdfCtx_feedArgConcat [ByteString]
credsPadding PhkdfCtx -> (PhkdfCtx -> PhkdfCtx) -> PhkdfCtx
forall a b. a -> (a -> b) -> b
&
        Word64 -> PhkdfCtx -> PhkdfCtx
phkdfCtx_assertBufferPosition' Word64
29 PhkdfCtx -> (PhkdfCtx -> PhkdfCtx) -> PhkdfCtx
forall a b. a -> (a -> b) -> b
&
        Vector ByteString -> PhkdfCtx -> PhkdfCtx
forall (f :: * -> *).
Foldable f =>
f ByteString -> PhkdfCtx -> PhkdfCtx
phkdfCtx_feedArgs Vector ByteString
contextTags PhkdfCtx -> (PhkdfCtx -> PhkdfCtx) -> PhkdfCtx
forall a b. a -> (a -> b) -> b
&
        ByteString -> PhkdfCtx -> PhkdfCtx
phkdfCtx_feedArg (Int -> ByteString
forall b. (Integral b, FiniteBits b) => b -> ByteString
bareEncode (Vector ByteString -> Int
forall a. Vector a -> Int
V.length Vector ByteString
contextTags)) PhkdfCtx -> (PhkdfCtx -> Stream ByteString) -> Stream ByteString
forall a b. a -> (a -> b) -> b
&
        (Int -> ByteString)
-> Word32 -> ByteString -> PhkdfCtx -> Stream ByteString
phkdfCtx_toStream Int -> ByteString
endPadding
           (ByteString -> Word32
word32 ByteString
"go\x00\x00" Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
+ Word32
2024) ByteString
domainTag Stream ByteString
-> (Stream ByteString -> Stream PairBS) -> Stream PairBS
forall a b. a -> (a -> b) -> b
&
        Stream ByteString -> Stream PairBS
xorScan Stream PairBS -> (Stream PairBS -> Stream PairBS) -> Stream PairBS
forall a b. a -> (a -> b) -> b
& Word32 -> Stream PairBS -> Stream PairBS
forall a. Word32 -> Stream a -> Stream a
myDrop' Word32
1 Stream PairBS -> (Stream PairBS -> Stream PairBS) -> Stream PairBS
forall a b. a -> (a -> b) -> b
& -- ensure that the sum is not filled with nulls
        Word32 -> Stream PairBS -> Stream PairBS
forall a. Word32 -> Stream a -> Stream a
myDrop' Word32
phkdfRounds Stream PairBS -> (Stream PairBS -> PairBS) -> PairBS
forall a b. a -> (a -> b) -> b
& -- do the requested number of additional rounds
        Stream PairBS -> PairBS
forall a. Stream a -> a
Stream.head

    endPadding :: Int -> ByteString
endPadding = [ByteString] -> ByteString
B.concat ([ByteString] -> ByteString)
-> (Int -> [ByteString]) -> Int -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int64 -> [ByteString] -> [ByteString])
-> [ByteString] -> Int64 -> [ByteString]
forall a b c. (a -> b -> c) -> b -> a -> c
flip Int64 -> [ByteString] -> [ByteString]
takeBs ([ByteString] -> [ByteString]
forall a. HasCallStack => [a] -> [a]
cycle [ByteString
longTag, ByteString
"\x00"]) (Int64 -> [ByteString]) -> (Int -> Int64) -> Int -> [ByteString]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral

    bravo :: ByteString
bravo = ByteString
"G3Pb2 bravo"

    headerBravo :: [ByteString]
headerBravo =
        [ ByteString
bravo, ByteString
alfaExt ] [ByteString] -> [ByteString] -> [ByteString]
forall a. [a] -> [a] -> [a]
++ Int64 -> [ByteString] -> [ByteString]
takeBs Int64
53 ([ByteString] -> [ByteString]
forall a. HasCallStack => [a] -> [a]
cycle [ByteString
longTag, ByteString
"\x00"]) [ByteString] -> [ByteString] -> [ByteString]
forall a. [a] -> [a] -> [a]
++
        [ ByteString
alfaSum ]

    -- keyB: key bravo begins bcrypt (and key bullshit baffles brains)
    -- keyB was generated by the call to G3Pb2 bravo, and starts bcrypt
    -- keyB is used to generate a prefixed hmac key to bcrypt,
    --   which is used to generate round keys for bcrypt, as well
    --   to summarize bcrypt's pBox and sBox

    (ByteString
"",HmacKeyPrefixed
prefixBravo) = HmacKey -> HmacKeyPrefixed
hmacKeyPrefixed_init HmacKey
seguid HmacKeyPrefixed
-> (HmacKeyPrefixed -> (ByteString, HmacKeyPrefixed))
-> (ByteString, HmacKeyPrefixed)
forall a b. a -> (a -> b) -> b
&
                       [ByteString] -> HmacKeyPrefixed -> (ByteString, HmacKeyPrefixed)
forall (f :: * -> *).
Foldable f =>
f ByteString -> HmacKeyPrefixed -> (ByteString, HmacKeyPrefixed)
hmacKeyPrefixed_feeds [ByteString]
headerBravo

    bravoKeyPad :: ByteString -> ByteString
bravoKeyPad ByteString
b = [ByteString] -> ByteString
B.concat ([ByteString] -> ByteString) -> [ByteString] -> ByteString
forall a b. (a -> b) -> a -> b
$
        Int64 -> [ByteString] -> [ByteString]
takeBs Int64
31 [ByteString
domainTag, ByteString
"\x00", ByteString
bravo, ByteString
nullBuffer] [ByteString] -> [ByteString] -> [ByteString]
forall a. [a] -> [a] -> [a]
++ [ByteString
b]

    keyB :: ByteString
keyB = ByteString -> HmacKeyPrefixed -> PhkdfCtx
phkdfCtx_initPrefixed (ByteString -> ByteString
bravoKeyPad ByteString
"B") HmacKeyPrefixed
prefixBravo PhkdfCtx -> (PhkdfCtx -> PhkdfCtx) -> PhkdfCtx
forall a b. a -> (a -> b) -> b
&
           Vector ByteString -> PhkdfCtx -> PhkdfCtx
forall (f :: * -> *).
Foldable f =>
f ByteString -> PhkdfCtx -> PhkdfCtx
phkdfCtx_feedArgs Vector ByteString
contextTags PhkdfCtx -> (PhkdfCtx -> ByteString) -> ByteString
forall a b. a -> (a -> b) -> b
&
           (Int -> ByteString)
-> Word32 -> ByteString -> PhkdfCtx -> ByteString
phkdfCtx_finalize Int -> ByteString
endPadding (ByteString -> Word32
word32 ByteString
"KEYB") ByteString
domainTag

    -- keyC, charlie's continuation control key
    --   It's inclusion (or omission) is a fundamental design tradeoff.

    --   This key allows a low-power device to outsource (part of) the
    --   bcrypt computation without losing control of the continuation
    --   that leads to the seed.

    --   The downside is that keyC has less key stretching than the bcrypt
    --   computation, and cannot be forgotten until after the bcrypt key
    --   stretching is complete, or the computation is abandoned.

    --   Given that this is already at PBKDF2-level key stretching,
    --   and that many password hash functions have historically not
    --   cared about how soon (and often) their computation becomes
    --   unreversable, I think this is a good tradeoff in the
    --   primary intended context of a client-side prehash function.

    keyC :: ByteString
keyC = ByteString -> HmacKeyPrefixed -> PhkdfCtx
phkdfCtx_initPrefixed (ByteString -> ByteString
bravoKeyPad ByteString
"C") HmacKeyPrefixed
prefixBravo PhkdfCtx -> (PhkdfCtx -> PhkdfCtx) -> PhkdfCtx
forall a b. a -> (a -> b) -> b
&
           Vector ByteString -> PhkdfCtx -> PhkdfCtx
forall (f :: * -> *).
Foldable f =>
f ByteString -> PhkdfCtx -> PhkdfCtx
phkdfCtx_feedArgs Vector ByteString
contextTags PhkdfCtx -> (PhkdfCtx -> ByteString) -> ByteString
forall a b. a -> (a -> b) -> b
&
           (Int -> ByteString)
-> Word32 -> ByteString -> PhkdfCtx -> ByteString
phkdfCtx_finalize Int -> ByteString
endPadding (ByteString -> Word32
word32 ByteString
"KEYC") ByteString
domainTag

    -- Note that the two keys above are derived to be independent of
    -- each other regardless of whether the seguid and domain tag are
    -- public or private knowledge.  Once you get the final output
    -- stream, there's no need to do this yourself, as the hmac key
    -- powering the stream generator can be assumed to be secret.

    -- Thus, if you want to use the G3P to loft something bigger than
    -- bcrypt, you could just put (word32 "KEYB") in as the echo counter
    -- and take the first key of the stream to be the beginning key
    -- take the second key of the stream to be the continuation key.
    -- However we avoid doing this here because of the issue above.

    -- There is of course no harm in a deployment choosing to emulate
    -- the construction used above. One could use the echo header,
    -- echo counter, echo tag, or even move this particular form of
    -- domain separation earlier in the derivation chain.
    -- (i.e. deeper in the Merkle tree)

    -- It's just that using the PHKDF output stream is an option then,
    -- and it isn't now. A deployment just has to commit to one mode of
    -- operation or the other, and I don't understand why it might matter
    -- too much one way or the other.

    spark :: G3PSpark
spark = G3PSpark
       { g3pSpark_beginKey :: ByteString
g3pSpark_beginKey = ByteString
keyB
       , g3pSpark_contKey :: ByteString
g3pSpark_contKey  = ByteString
keyC
       , g3pSpark_contextTags :: Vector ByteString
g3pSpark_contextTags = Vector ByteString
contextTags
       , g3pSpark_domainTag :: ByteString
g3pSpark_domainTag   = ByteString
domainTag
       }

myDrop' :: Word32 -> Stream a -> Stream a
myDrop' :: forall a. Word32 -> Stream a -> Stream a
myDrop' = Word32 -> Stream a -> Stream a
forall {t} {a}. (Eq t, Num t) => t -> Stream a -> Stream a
go
  where
    go :: t -> Stream a -> Stream a
go t
0 Stream a
s = Stream a
s
    go t
n (Cons a
x Stream a
s) = a
x a -> Stream a -> Stream a
forall a b. a -> b -> b
`seq` t -> Stream a -> Stream a
go (t
nt -> t -> t
forall a. Num a => a -> a -> a
-t
1) Stream a
s

xorBS :: ByteString -> ByteString -> ByteString
xorBS :: ByteString -> ByteString -> ByteString
xorBS = (Word8 -> Word8 -> Word8) -> ByteString -> ByteString -> ByteString
B.packZipWith Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
xor

data PairBS = PairBS !ByteString !ByteString

xorScan :: Stream ByteString -> Stream PairBS
xorScan :: Stream ByteString -> Stream PairBS
xorScan = Stream PairBS -> Stream PairBS
forall a. Stream a -> Stream a
Stream.tail (Stream PairBS -> Stream PairBS)
-> (Stream ByteString -> Stream PairBS)
-> Stream ByteString
-> Stream PairBS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (PairBS -> ByteString -> PairBS)
-> PairBS -> Stream ByteString -> Stream PairBS
forall a b. (a -> b -> a) -> a -> Stream b -> Stream a
Stream.scan' PairBS -> ByteString -> PairBS
f (ByteString -> ByteString -> PairBS
PairBS ByteString
blankChunk ByteString
blankChunk)
  where f :: PairBS -> ByteString -> PairBS
f (PairBS ByteString
acc ByteString
old) ByteString
new = ByteString -> ByteString -> PairBS
PairBS (ByteString -> ByteString -> ByteString
xorBS ByteString
acc ByteString
old) ByteString
new
        blankChunk :: ByteString
blankChunk = Int -> Word8 -> ByteString
B.replicate Int
32 Word8
0

-- | The bcrypt key-stretching phase.

g3pSpark_toSeed
  :: G3PSpark -- ^ the end of @G3Pb2 bravo@, the beginning of @G3Pb2 charlie@
  -> G3PSeedInputs -- ^ bcrypt parameters
  -> G3PSeed -- ^ the end of @G3Pb2 charlie@, the beginning of @G3Pb2 delta@
g3pSpark_toSeed :: G3PSpark -> G3PSeedInputs -> G3PSeed
g3pSpark_toSeed G3PSpark
spark G3PSeedInputs
inputs = ByteString -> G3PSeed
G3PSeed ByteString
seed
  where
    beginKey :: ByteString
beginKey = G3PSpark -> ByteString
g3pSpark_beginKey G3PSpark
spark
    contKey :: ByteString
contKey = G3PSpark -> ByteString
g3pSpark_contKey G3PSpark
spark
    contextTags :: Vector ByteString
contextTags = G3PSpark -> Vector ByteString
g3pSpark_contextTags G3PSpark
spark
    domainTag :: ByteString
domainTag = G3PSpark -> ByteString
g3pSpark_domainTag G3PSpark
spark

    bSeguid :: HmacKey
bSeguid = G3PSeedInputs -> HmacKey
g3pSeedInputs_bcryptSeguid G3PSeedInputs
inputs
    bCreds :: Vector ByteString
bCreds = G3PSeedInputs -> Vector ByteString
g3pSeedInputs_bcryptCredentials G3PSeedInputs
inputs
    bRounds :: Word32
bRounds = G3PSeedInputs -> Word32
g3pSeedInputs_bcryptRounds G3PSeedInputs
inputs
    bLongTag :: ByteString
bLongTag = G3PSeedInputs -> ByteString
g3pSeedInputs_bcryptLongTag G3PSeedInputs
inputs
    bDomainTag :: ByteString
bDomainTag = G3PSeedInputs -> ByteString
g3pSeedInputs_bcryptDomainTag G3PSeedInputs
inputs
    bContextTags :: Vector ByteString
bContextTags = G3PSeedInputs -> Vector ByteString
g3pSeedInputs_bcryptContextTags G3PSeedInputs
inputs

    charlie :: ByteString
charlie = ByteString
"G3Pb2 charlie"

    charlieHeader :: [ByteString]
charlieHeader = ByteString
charlie ByteString -> [ByteString] -> [ByteString]
forall a. a -> [a] -> [a]
: ByteString
beginKey ByteString -> [ByteString] -> [ByteString]
forall a. a -> [a] -> [a]
: Int64 -> [ByteString] -> [ByteString]
takeBs Int64
19 [ByteString
domainTag, ByteString
nullBuffer]

    (ByteString
"", HmacKeyPrefixed
charliePrefix) =
      HmacKey -> HmacKeyPrefixed
hmacKeyPrefixed_init HmacKey
bSeguid HmacKeyPrefixed
-> (HmacKeyPrefixed -> (ByteString, HmacKeyPrefixed))
-> (ByteString, HmacKeyPrefixed)
forall a b. a -> (a -> b) -> b
&
      [ByteString] -> HmacKeyPrefixed -> (ByteString, HmacKeyPrefixed)
forall (f :: * -> *).
Foldable f =>
f ByteString -> HmacKeyPrefixed -> (ByteString, HmacKeyPrefixed)
hmacKeyPrefixed_feeds [ByteString]
charlieHeader

    bcryptName :: ByteString
bcryptName = [ByteString] -> ByteString
B.concat
      [ ByteString
"G3Pb2 bcrypt-xs-free"
      , Word64 -> ByteString
bytestring64 (Word64
8 Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
* Int -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteString -> Int
B.length ByteString
bLongTag))
      ]

    (Int
_, HmacKeyPrefixed
charlieCont) =
      (ByteString -> ByteString)
-> ByteString
-> Vector ByteString
-> ByteString
-> Vector ByteString
-> ByteString
-> Word32
-> HmacKeyPrefixed
-> (Int, HmacKeyPrefixed)
forall (f :: * -> *) a.
Foldable f =>
(a -> ByteString)
-> ByteString
-> f a
-> ByteString
-> f a
-> ByteString
-> Word32
-> HmacKeyPrefixed
-> (Int, HmacKeyPrefixed)
bcryptXsFree ByteString -> ByteString
forall a. a -> a
id ByteString
bcryptName Vector ByteString
bCreds ByteString
bLongTag Vector ByteString
bContextTags ByteString
bDomainTag
                   Word32
bRounds HmacKeyPrefixed
charliePrefix

    contPad :: ByteString
contPad = [ByteString] -> ByteString
B.concat ([ByteString] -> ByteString) -> [ByteString] -> ByteString
forall a b. (a -> b) -> a -> b
$ Int64 -> [ByteString] -> [ByteString]
takeBs Int64
32 [ByteString
domainTag, ByteString
"\x00", ByteString
charlie, ByteString
nullBuffer]

    (ByteString
"", HmacKeyPrefixed
endCont) = [ByteString] -> HmacKeyPrefixed -> (ByteString, HmacKeyPrefixed)
forall (f :: * -> *).
Foldable f =>
f ByteString -> HmacKeyPrefixed -> (ByteString, HmacKeyPrefixed)
hmacKeyPrefixed_feeds [ByteString
contPad, ByteString
contKey] HmacKeyPrefixed
charlieCont

    seed :: ByteString
seed = ByteString -> HmacKeyPrefixed -> PhkdfCtx
phkdfCtx_initPrefixed ByteString
contPad HmacKeyPrefixed
endCont PhkdfCtx -> (PhkdfCtx -> PhkdfCtx) -> PhkdfCtx
forall a b. a -> (a -> b) -> b
&
           Vector ByteString -> PhkdfCtx -> PhkdfCtx
forall (f :: * -> *).
Foldable f =>
f ByteString -> PhkdfCtx -> PhkdfCtx
phkdfCtx_feedArgs Vector ByteString
contextTags PhkdfCtx -> (PhkdfCtx -> ByteString) -> ByteString
forall a b. a -> (a -> b) -> b
&
           (Int -> ByteString)
-> Word32 -> ByteString -> PhkdfCtx -> ByteString
phkdfCtx_finalize Int -> ByteString
endPadding (ByteString -> Word32
word32 ByteString
"SEED") ByteString
domainTag

    endPadding :: Int -> ByteString
endPadding = [ByteString] -> ByteString
B.concat ([ByteString] -> ByteString)
-> (Int -> [ByteString]) -> Int -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int64 -> [ByteString] -> [ByteString])
-> [ByteString] -> Int64 -> [ByteString]
forall a b c. (a -> b -> c) -> b -> a -> c
flip Int64 -> [ByteString] -> [ByteString]
takeBs ([ByteString] -> [ByteString]
forall a. HasCallStack => [a] -> [a]
cycle [ByteString
domainTag, ByteString
"\x00"]) (Int64 -> [ByteString]) -> (Int -> Int64) -> Int -> [ByteString]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral

-- | Start a call to @G3Pb2 delta@, starting with the Sprout's Seguid.

g3pSeed_toSprout
  :: G3PSeed -- ^ the end of @G3Pb2 charlie@, the beginning of @G3Pb2 delta@
  -> HmacKey -- ^ Sprout Seguid
  -> G3PSprout -- ^ the middle of @G3Pb2 delta@
g3pSeed_toSprout :: G3PSeed -> HmacKey -> G3PSprout
g3pSeed_toSprout (G3PSeed ByteString
seed) HmacKey
key = PhkdfCtx -> G3PSprout
G3PSprout PhkdfCtx
ctx
  where
    delta :: ByteString
delta = ByteString
"G3Pb2 delta"
    ctx :: PhkdfCtx
ctx = HmacKey -> PhkdfCtx
phkdfCtx_init HmacKey
key PhkdfCtx -> (PhkdfCtx -> PhkdfCtx) -> PhkdfCtx
forall a b. a -> (a -> b) -> b
&
          ByteString -> PhkdfCtx -> PhkdfCtx
phkdfCtx_feedArg (ByteString
delta ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
seed)

-- | flipped version of 'g3pSprout_arg'

g3pSprout_feedArg
  :: ByteString -- ^ arg
  -> G3PSprout -- ^ the middle of @G3Pb2 delta@
  -> G3PSprout -- ^ a later middle of @G3Pb2 delta@, ready for more args, or grow into a @G3PTree@
g3pSprout_feedArg :: ByteString -> G3PSprout -> G3PSprout
g3pSprout_feedArg ByteString
x = PhkdfCtx -> G3PSprout
G3PSprout (PhkdfCtx -> G3PSprout)
-> (G3PSprout -> PhkdfCtx) -> G3PSprout -> G3PSprout
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> PhkdfCtx -> PhkdfCtx
phkdfCtx_feedArg ByteString
x (PhkdfCtx -> PhkdfCtx)
-> (G3PSprout -> PhkdfCtx) -> G3PSprout -> PhkdfCtx
forall b c a. (b -> c) -> (a -> b) -> a -> c
. G3PSprout -> PhkdfCtx
g3pSprout_phkdfCtx

-- | flipped version of 'g3pSprout_args'

g3pSprout_feedArgs
  :: Foldable f
  => f ByteString -- ^ zero or more args
  -> G3PSprout -- ^ the middle of @G3Pb2 delta@
  -> G3PSprout -- ^ a later middle of @G3Pb2 delta@, ready for more args, or grow into a @G3PTree@
g3pSprout_feedArgs :: forall (f :: * -> *).
Foldable f =>
f ByteString -> G3PSprout -> G3PSprout
g3pSprout_feedArgs f ByteString
xs = PhkdfCtx -> G3PSprout
G3PSprout (PhkdfCtx -> G3PSprout)
-> (G3PSprout -> PhkdfCtx) -> G3PSprout -> G3PSprout
forall b c a. (b -> c) -> (a -> b) -> a -> c
. f ByteString -> PhkdfCtx -> PhkdfCtx
forall (f :: * -> *).
Foldable f =>
f ByteString -> PhkdfCtx -> PhkdfCtx
phkdfCtx_feedArgs f ByteString
xs (PhkdfCtx -> PhkdfCtx)
-> (G3PSprout -> PhkdfCtx) -> G3PSprout -> PhkdfCtx
forall b c a. (b -> c) -> (a -> b) -> a -> c
. G3PSprout -> PhkdfCtx
g3pSprout_phkdfCtx

-- | The name of this function is a mnemonic for the argument order, which
--   takes an sprout and adds a single length-delimited argument to it.

g3pSprout_arg
  :: G3PSprout -- ^ the middle of @G3Pb2 delta@
  -> ByteString  -- ^ arg
  -> G3PSprout -- ^ a later middle of @G3Pb2 delta@, ready for more args, or grow into a @G3PTree@
g3pSprout_arg :: G3PSprout -> ByteString -> G3PSprout
g3pSprout_arg = (ByteString -> G3PSprout -> G3PSprout)
-> G3PSprout -> ByteString -> G3PSprout
forall a b c. (a -> b -> c) -> b -> a -> c
flip ByteString -> G3PSprout -> G3PSprout
g3pSprout_feedArg

-- | The name of this function is a mnemonic for the argument order, which
--   takes a sprout and adds zero or more length-delimited arguments to it.

g3pSprout_args
   :: Foldable f
   => G3PSprout -- ^ the middle of @G3Pb2 delta@
   -> f ByteString -- ^ zero or more args
   -> G3PSprout -- ^ a later middle of @G3Pb2 delta@, ready for more args, or grow into a @G3PTree@
g3pSprout_args :: forall (f :: * -> *).
Foldable f =>
G3PSprout -> f ByteString -> G3PSprout
g3pSprout_args = (f ByteString -> G3PSprout -> G3PSprout)
-> G3PSprout -> f ByteString -> G3PSprout
forall a b c. (a -> b -> c) -> b -> a -> c
flip f ByteString -> G3PSprout -> G3PSprout
forall (f :: * -> *).
Foldable f =>
f ByteString -> G3PSprout -> G3PSprout
g3pSprout_feedArgs

g3pSprout_toTree
   :: G3PSprout -- ^ the middle of @G3Pb2 delta@
   -> ByteString  -- ^ Sprout Domain Tag
   -> G3PTree -- the end of @G3Pb2 delta@, the beginning of @G3Pb2 echo@
g3pSprout_toTree :: G3PSprout -> ByteString -> G3PTree
g3pSprout_toTree (G3PSprout PhkdfCtx
ctx) ByteString
domainTag = ByteString -> G3PTree
G3PTree ByteString
key
  where
    key :: ByteString
key = (Int -> ByteString)
-> Word32 -> ByteString -> PhkdfCtx -> ByteString
phkdfCtx_finalize Int -> ByteString
endPadding (ByteString -> Word32
word32 ByteString
"KEYL") ByteString
domainTag PhkdfCtx
ctx
    endPadding :: Int -> ByteString
endPadding = [ByteString] -> ByteString
B.concat ([ByteString] -> ByteString)
-> (Int -> [ByteString]) -> Int -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int64 -> [ByteString] -> [ByteString])
-> [ByteString] -> Int64 -> [ByteString]
forall a b c. (a -> b -> c) -> b -> a -> c
flip Int64 -> [ByteString] -> [ByteString]
takeBs ([ByteString] -> [ByteString]
forall a. HasCallStack => [a] -> [a]
cycle [ByteString
domainTag, ByteString
"\x00"]) (Int64 -> [ByteString]) -> (Int -> Int64) -> Int -> [ByteString]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral

g3pTree_toKey
  :: G3PTree -- the end of @G3Pb2 delta@, the beginning of @G3Pb2 echo@
  -> ByteString -- ^ echo key right
  -> G3PKey -- ^ the middle of @G3Pb2 echo@
g3pTree_toKey :: G3PTree -> ByteString -> G3PKey
g3pTree_toKey (G3PTree ByteString
echoKeyL) ByteString
echoKeyR = HmacKeyHashed -> G3PKey
G3PKey (ByteString -> HmacKeyHashed
hmacKeyHashed ByteString
key)
  where
    keyR :: [ByteString]
keyR = Int64 -> [ByteString] -> [ByteString]
takeBs Int64
32 [ByteString
echoKeyR, ByteString
"\x00", ByteString
"G3Pb2 echo key right padding", ByteString
nullBuffer]
    -- Note that echoKeyL should already be 32 bytes, so this should be id:
    keyL :: [ByteString]
keyL = Int64 -> [ByteString] -> [ByteString]
takeBs Int64
32 [ByteString
echoKeyL, ByteString
nullBuffer]
    key :: ByteString
key = [ByteString] -> ByteString
B.concat ([ByteString]
keyL [ByteString] -> [ByteString] -> [ByteString]
forall a. [a] -> [a] -> [a]
++ [ByteString]
keyR)

-- | Variant of 'g3pKey_toStream' that returns plain old data.

g3pKey_toSource
  :: G3PKey -- ^ the middle of @G3Pb2 echo@
  -> ByteString -- ^ echo header
  -> Word32 -- ^ echo counter
  -> ByteString -- ^ echo tag
  -> G3PSource -- ^ plain-old data representation of an output stream
g3pKey_toSource :: G3PKey -> ByteString -> Word32 -> ByteString -> G3PSource
g3pKey_toSource (G3PKey HmacKeyHashed
key) ByteString
echoHeader Word32
echoCtr ByteString
echoTag = G3PSource
gen
  where
    hdr :: ByteString
hdr = [ByteString] -> ByteString
B.concat ([ByteString] -> ByteString) -> [ByteString] -> ByteString
forall a b. (a -> b) -> a -> b
$
      Int64 -> [ByteString] -> [ByteString]
takeBs Int64
32 [ByteString
echoHeader, ByteString
"\x00", ByteString
"G3Pb2 echo header padding", ByteString
nullBuffer]
    gen :: G3PSource
gen = HmacKeyHashed -> ByteString -> Word32 -> ByteString -> G3PSource
phkdfGen_initHashed HmacKeyHashed
key ByteString
hdr Word32
echoCtr ByteString
echoTag

g3pSource_head :: G3PSource -> ByteString
g3pSource_head :: G3PSource -> ByteString
g3pSource_head = (ByteString, G3PSource) -> ByteString
forall a b. (a, b) -> a
fst ((ByteString, G3PSource) -> ByteString)
-> (G3PSource -> (ByteString, G3PSource))
-> G3PSource
-> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. G3PSource -> (ByteString, G3PSource)
phkdfGen_read

g3pSource_read :: G3PSource -> (ByteString, G3PSource)
g3pSource_read :: G3PSource -> (ByteString, G3PSource)
g3pSource_read = G3PSource -> (ByteString, G3PSource)
phkdfGen_read

g3pSource_peek :: G3PSource -> Maybe ByteString
g3pSource_peek :: G3PSource -> Maybe ByteString
g3pSource_peek = G3PSource -> Maybe ByteString
phkdfGen_peek

g3pSource_toStream :: G3PSource -> Stream ByteString
g3pSource_toStream :: G3PSource -> Stream ByteString
g3pSource_toStream = G3PSource -> Stream ByteString
phkdfGen_toStream

type G3PSource = PhkdfGen

-- | Turn a secret, derived 'HmacKeyHashed' into an unbounded
--   stream of 32-byte output blocks.

g3pKey_toStream
  :: G3PKey -- ^ the middle of @G3Pb2 echo@
  -> ByteString -- ^ echo header
  -> Word32
  -- ^ The @echo counter@, functionally a bonus HKDF info parameter.  The test suite defaults to (word32 "OUT\x00")
  -> ByteString
  -- ^ The @echo tag@, functionally identical to HKDF's info parameter.
  -> Stream ByteString
g3pKey_toStream :: G3PKey -> ByteString -> Word32 -> ByteString -> Stream ByteString
g3pKey_toStream G3PKey
key ByteString
hdr Word32
ctr ByteString
tag =
  G3PSource -> Stream ByteString
phkdfGen_toStream (G3PKey -> ByteString -> Word32 -> ByteString -> G3PSource
g3pKey_toSource G3PKey
key ByteString
hdr Word32
ctr ByteString
tag)

g3pTree_toStream
  :: G3PTree -- ^ the end of @G3Pb2 delta@, the beginning of @G3Pb2 echo@
  -> ByteString -- ^ echo key right
  -> ByteString -- ^ echo header
  -> Word32 -- ^ echo counter
  -> ByteString -- ^ echo tag
  -> Stream ByteString
g3pTree_toStream :: G3PTree
-> ByteString
-> ByteString
-> Word32
-> ByteString
-> Stream ByteString
g3pTree_toStream = (G3PKey -> ByteString -> Word32 -> ByteString -> Stream ByteString)
-> (ByteString -> G3PKey)
-> ByteString
-> ByteString
-> Word32
-> ByteString
-> Stream ByteString
forall a b. (a -> b) -> (ByteString -> a) -> ByteString -> b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap G3PKey -> ByteString -> Word32 -> ByteString -> Stream ByteString
g3pKey_toStream ((ByteString -> G3PKey)
 -> ByteString
 -> ByteString
 -> Word32
 -> ByteString
 -> Stream ByteString)
-> (G3PTree -> ByteString -> G3PKey)
-> G3PTree
-> ByteString
-> ByteString
-> Word32
-> ByteString
-> Stream ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. G3PTree -> ByteString -> G3PKey
g3pTree_toKey

g3pSprout_toStream
  :: Foldable f
  => G3PSprout -- ^ the middle of @G3Pb2 delta@
  -> f ByteString -- ^ sprout role
  -> ByteString -- ^ sprout tag
  -> ByteString -- ^ echo key right
  -> ByteString -- ^ echo header
  -> Word32 -- ^ echo counter
  -> ByteString -- ^ echo tag
  -> Stream ByteString
g3pSprout_toStream :: forall (f :: * -> *).
Foldable f =>
G3PSprout
-> f ByteString
-> ByteString
-> ByteString
-> ByteString
-> Word32
-> ByteString
-> Stream ByteString
g3pSprout_toStream =
  (G3PSprout
 -> ByteString
 -> ByteString
 -> ByteString
 -> Word32
 -> ByteString
 -> Stream ByteString)
-> (f ByteString -> G3PSprout)
-> f ByteString
-> ByteString
-> ByteString
-> ByteString
-> Word32
-> ByteString
-> Stream ByteString
forall a b. (a -> b) -> (f ByteString -> a) -> f ByteString -> b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((G3PTree
 -> ByteString
 -> ByteString
 -> Word32
 -> ByteString
 -> Stream ByteString)
-> (ByteString -> G3PTree)
-> ByteString
-> ByteString
-> ByteString
-> Word32
-> ByteString
-> Stream ByteString
forall a b. (a -> b) -> (ByteString -> a) -> ByteString -> b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap G3PTree
-> ByteString
-> ByteString
-> Word32
-> ByteString
-> Stream ByteString
g3pTree_toStream ((ByteString -> G3PTree)
 -> ByteString
 -> ByteString
 -> ByteString
 -> Word32
 -> ByteString
 -> Stream ByteString)
-> (G3PSprout -> ByteString -> G3PTree)
-> G3PSprout
-> ByteString
-> ByteString
-> ByteString
-> Word32
-> ByteString
-> Stream ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. G3PSprout -> ByteString -> G3PTree
g3pSprout_toTree) ((f ByteString -> G3PSprout)
 -> f ByteString
 -> ByteString
 -> ByteString
 -> ByteString
 -> Word32
 -> ByteString
 -> Stream ByteString)
-> (G3PSprout -> f ByteString -> G3PSprout)
-> G3PSprout
-> f ByteString
-> ByteString
-> ByteString
-> ByteString
-> Word32
-> ByteString
-> Stream ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. G3PSprout -> f ByteString -> G3PSprout
forall (f :: * -> *).
Foldable f =>
G3PSprout -> f ByteString -> G3PSprout
g3pSprout_args

g3pSeed_toStream
  :: Foldable f
  => G3PSeed -- ^ the end of @G3Pb2 charlie@, the beginning of @G3Pb2 delta@
  -> HmacKey -- ^ sprout seguid
  -> f ByteString -- ^ sprout role
  -> ByteString -- ^ sprout tag
  -> ByteString -- ^ echo key right
  -> ByteString -- ^ echo header
  -> Word32 -- ^ echo counter
  -> ByteString -- ^ echo tag
  -> Stream ByteString
g3pSeed_toStream :: forall (f :: * -> *).
Foldable f =>
G3PSeed
-> HmacKey
-> f ByteString
-> ByteString
-> ByteString
-> ByteString
-> Word32
-> ByteString
-> Stream ByteString
g3pSeed_toStream = (G3PSprout
 -> f ByteString
 -> ByteString
 -> ByteString
 -> ByteString
 -> Word32
 -> ByteString
 -> Stream ByteString)
-> (HmacKey -> G3PSprout)
-> HmacKey
-> f ByteString
-> ByteString
-> ByteString
-> ByteString
-> Word32
-> ByteString
-> Stream ByteString
forall a b. (a -> b) -> (HmacKey -> a) -> HmacKey -> b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap G3PSprout
-> f ByteString
-> ByteString
-> ByteString
-> ByteString
-> Word32
-> ByteString
-> Stream ByteString
forall (f :: * -> *).
Foldable f =>
G3PSprout
-> f ByteString
-> ByteString
-> ByteString
-> ByteString
-> Word32
-> ByteString
-> Stream ByteString
g3pSprout_toStream ((HmacKey -> G3PSprout)
 -> HmacKey
 -> f ByteString
 -> ByteString
 -> ByteString
 -> ByteString
 -> Word32
 -> ByteString
 -> Stream ByteString)
-> (G3PSeed -> HmacKey -> G3PSprout)
-> G3PSeed
-> HmacKey
-> f ByteString
-> ByteString
-> ByteString
-> ByteString
-> Word32
-> ByteString
-> Stream ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. G3PSeed -> HmacKey -> G3PSprout
g3pSeed_toSprout

g3pSpark_toStream
  :: Foldable f
  => G3PSpark -- ^ a partial evaluation of @G3Pb2 bravo@
  -> G3PSeedInputs -- ^ bcrypt parameters
  -> HmacKey -- ^ sprout seguid
  -> f ByteString -- ^ sprout role
  -> ByteString -- ^ sprout tag
  -> ByteString -- ^ echo key right
  -> ByteString -- ^ echo header
  -> Word32 -- ^ echo counter
  -> ByteString -- ^ echo tag
  -> Stream ByteString
g3pSpark_toStream :: forall (f :: * -> *).
Foldable f =>
G3PSpark
-> G3PSeedInputs
-> HmacKey
-> f ByteString
-> ByteString
-> ByteString
-> ByteString
-> Word32
-> ByteString
-> Stream ByteString
g3pSpark_toStream = (G3PSeed
 -> HmacKey
 -> f ByteString
 -> ByteString
 -> ByteString
 -> ByteString
 -> Word32
 -> ByteString
 -> Stream ByteString)
-> (G3PSeedInputs -> G3PSeed)
-> G3PSeedInputs
-> HmacKey
-> f ByteString
-> ByteString
-> ByteString
-> ByteString
-> Word32
-> ByteString
-> Stream ByteString
forall a b. (a -> b) -> (G3PSeedInputs -> a) -> G3PSeedInputs -> b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap G3PSeed
-> HmacKey
-> f ByteString
-> ByteString
-> ByteString
-> ByteString
-> Word32
-> ByteString
-> Stream ByteString
forall (f :: * -> *).
Foldable f =>
G3PSeed
-> HmacKey
-> f ByteString
-> ByteString
-> ByteString
-> ByteString
-> Word32
-> ByteString
-> Stream ByteString
g3pSeed_toStream ((G3PSeedInputs -> G3PSeed)
 -> G3PSeedInputs
 -> HmacKey
 -> f ByteString
 -> ByteString
 -> ByteString
 -> ByteString
 -> Word32
 -> ByteString
 -> Stream ByteString)
-> (G3PSpark -> G3PSeedInputs -> G3PSeed)
-> G3PSpark
-> G3PSeedInputs
-> HmacKey
-> f ByteString
-> ByteString
-> ByteString
-> ByteString
-> Word32
-> ByteString
-> Stream ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. G3PSpark -> G3PSeedInputs -> G3PSeed
g3pSpark_toSeed


g3pSpark_toSprout
  :: G3PSpark -- ^ a partial evaluation of @G3Pb2 bravo@
  -> G3PSeedInputs -- ^ bcrypt parameters
  -> HmacKey -- ^ sprout seguid
  -> G3PSprout -- ^ the middle of @G3Pb2 delta@
g3pSpark_toSprout :: G3PSpark -> G3PSeedInputs -> HmacKey -> G3PSprout
g3pSpark_toSprout = (G3PSeed -> HmacKey -> G3PSprout)
-> (G3PSeedInputs -> G3PSeed)
-> G3PSeedInputs
-> HmacKey
-> G3PSprout
forall a b. (a -> b) -> (G3PSeedInputs -> a) -> G3PSeedInputs -> b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap G3PSeed -> HmacKey -> G3PSprout
g3pSeed_toSprout ((G3PSeedInputs -> G3PSeed)
 -> G3PSeedInputs -> HmacKey -> G3PSprout)
-> (G3PSpark -> G3PSeedInputs -> G3PSeed)
-> G3PSpark
-> G3PSeedInputs
-> HmacKey
-> G3PSprout
forall b c a. (b -> c) -> (a -> b) -> a -> c
. G3PSpark -> G3PSeedInputs -> G3PSeed
g3pSpark_toSeed

g3pSpark_toTree
  :: Foldable f
  => G3PSpark -- ^ a partial evaluation of @G3Pb2 bravo@
  -> G3PSeedInputs -- ^ bcrypt parameters
  -> HmacKey -- ^ sprout seguid
  -> f ByteString -- ^ sprout role
  -> ByteString -- ^ sprout tag
  -> G3PTree -- ^ the end of @G3Pb2 delta@, the beginning of @G3Pb2 echo@
g3pSpark_toTree :: forall (f :: * -> *).
Foldable f =>
G3PSpark
-> G3PSeedInputs
-> HmacKey
-> f ByteString
-> ByteString
-> G3PTree
g3pSpark_toTree = (G3PSeed -> HmacKey -> f ByteString -> ByteString -> G3PTree)
-> (G3PSeedInputs -> G3PSeed)
-> G3PSeedInputs
-> HmacKey
-> f ByteString
-> ByteString
-> G3PTree
forall a b. (a -> b) -> (G3PSeedInputs -> a) -> G3PSeedInputs -> b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap G3PSeed -> HmacKey -> f ByteString -> ByteString -> G3PTree
forall (f :: * -> *).
Foldable f =>
G3PSeed -> HmacKey -> f ByteString -> ByteString -> G3PTree
g3pSeed_toTree ((G3PSeedInputs -> G3PSeed)
 -> G3PSeedInputs
 -> HmacKey
 -> f ByteString
 -> ByteString
 -> G3PTree)
-> (G3PSpark -> G3PSeedInputs -> G3PSeed)
-> G3PSpark
-> G3PSeedInputs
-> HmacKey
-> f ByteString
-> ByteString
-> G3PTree
forall b c a. (b -> c) -> (a -> b) -> a -> c
. G3PSpark -> G3PSeedInputs -> G3PSeed
g3pSpark_toSeed

g3pSpark_toKey
  :: Foldable f
  => G3PSpark -- ^ a partial evaluation of @G3Pb2 bravo@
  -> G3PSeedInputs -- ^ bcrypt parameters
  -> HmacKey -- ^ sprout seguid
  -> f ByteString -- ^ sprout role
  -> ByteString -- ^ sprout tag
  -> ByteString -- ^ echo key right
  -> G3PKey -- ^ the middle of @G3Pb2 echo@
g3pSpark_toKey :: forall (f :: * -> *).
Foldable f =>
G3PSpark
-> G3PSeedInputs
-> HmacKey
-> f ByteString
-> ByteString
-> ByteString
-> G3PKey
g3pSpark_toKey = (G3PSeed
 -> HmacKey -> f ByteString -> ByteString -> ByteString -> G3PKey)
-> (G3PSeedInputs -> G3PSeed)
-> G3PSeedInputs
-> HmacKey
-> f ByteString
-> ByteString
-> ByteString
-> G3PKey
forall a b. (a -> b) -> (G3PSeedInputs -> a) -> G3PSeedInputs -> b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap G3PSeed
-> HmacKey -> f ByteString -> ByteString -> ByteString -> G3PKey
forall (f :: * -> *).
Foldable f =>
G3PSeed
-> HmacKey -> f ByteString -> ByteString -> ByteString -> G3PKey
g3pSeed_toKey ((G3PSeedInputs -> G3PSeed)
 -> G3PSeedInputs
 -> HmacKey
 -> f ByteString
 -> ByteString
 -> ByteString
 -> G3PKey)
-> (G3PSpark -> G3PSeedInputs -> G3PSeed)
-> G3PSpark
-> G3PSeedInputs
-> HmacKey
-> f ByteString
-> ByteString
-> ByteString
-> G3PKey
forall b c a. (b -> c) -> (a -> b) -> a -> c
. G3PSpark -> G3PSeedInputs -> G3PSeed
g3pSpark_toSeed

g3pSpark_toSource
  :: Foldable f
  => G3PSpark -- ^ a partial evaluation of @G3Pb2 bravo@
  -> G3PSeedInputs -- ^ bcrypt parameters
  -> HmacKey -- ^ sprout seguid
  -> f ByteString -- ^ sprout role
  -> ByteString -- ^ sprout tag
  -> ByteString -- ^ echo key right
  -> ByteString -- ^ echo header
  -> Word32 -- ^ echo counter
  -> ByteString -- ^ echo tag
  -> G3PSource -- ^ plain-old data representation of an output stream
g3pSpark_toSource :: forall (f :: * -> *).
Foldable f =>
G3PSpark
-> G3PSeedInputs
-> HmacKey
-> f ByteString
-> ByteString
-> ByteString
-> ByteString
-> Word32
-> ByteString
-> G3PSource
g3pSpark_toSource = (G3PSeed
 -> HmacKey
 -> f ByteString
 -> ByteString
 -> ByteString
 -> ByteString
 -> Word32
 -> ByteString
 -> G3PSource)
-> (G3PSeedInputs -> G3PSeed)
-> G3PSeedInputs
-> HmacKey
-> f ByteString
-> ByteString
-> ByteString
-> ByteString
-> Word32
-> ByteString
-> G3PSource
forall a b. (a -> b) -> (G3PSeedInputs -> a) -> G3PSeedInputs -> b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap G3PSeed
-> HmacKey
-> f ByteString
-> ByteString
-> ByteString
-> ByteString
-> Word32
-> ByteString
-> G3PSource
forall (f :: * -> *).
Foldable f =>
G3PSeed
-> HmacKey
-> f ByteString
-> ByteString
-> ByteString
-> ByteString
-> Word32
-> ByteString
-> G3PSource
g3pSeed_toSource ((G3PSeedInputs -> G3PSeed)
 -> G3PSeedInputs
 -> HmacKey
 -> f ByteString
 -> ByteString
 -> ByteString
 -> ByteString
 -> Word32
 -> ByteString
 -> G3PSource)
-> (G3PSpark -> G3PSeedInputs -> G3PSeed)
-> G3PSpark
-> G3PSeedInputs
-> HmacKey
-> f ByteString
-> ByteString
-> ByteString
-> ByteString
-> Word32
-> ByteString
-> G3PSource
forall b c a. (b -> c) -> (a -> b) -> a -> c
. G3PSpark -> G3PSeedInputs -> G3PSeed
g3pSpark_toSeed

g3pSeed
  :: G3PSalt -- ^ salt parameters, typically specified by deployment, typically needed throughout PHKDF key stretching
  -> G3PInputs -- ^ input parameters, often provided by the user, ready to be forgotten soon after the computation starts
  -> G3PSeedInputs
  -> G3PSeed -- ^ the end of @G3Pb2 charlie@, the beginning of @G3Pb2 delta@
g3pSeed :: G3PSalt -> G3PInputs -> G3PSeedInputs -> G3PSeed
g3pSeed = (((G3PInputs -> G3PSpark) -> G3PInputs -> G3PSeedInputs -> G3PSeed)
-> (G3PSalt -> G3PInputs -> G3PSpark)
-> G3PSalt
-> G3PInputs
-> G3PSeedInputs
-> G3PSeed
forall a b. (a -> b) -> (G3PSalt -> a) -> G3PSalt -> b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (((G3PInputs -> G3PSpark) -> G3PInputs -> G3PSeedInputs -> G3PSeed)
 -> (G3PSalt -> G3PInputs -> G3PSpark)
 -> G3PSalt
 -> G3PInputs
 -> G3PSeedInputs
 -> G3PSeed)
-> ((G3PSpark -> G3PSeedInputs -> G3PSeed)
    -> (G3PInputs -> G3PSpark)
    -> G3PInputs
    -> G3PSeedInputs
    -> G3PSeed)
-> (G3PSpark -> G3PSeedInputs -> G3PSeed)
-> (G3PSalt -> G3PInputs -> G3PSpark)
-> G3PSalt
-> G3PInputs
-> G3PSeedInputs
-> G3PSeed
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (G3PSpark -> G3PSeedInputs -> G3PSeed)
-> (G3PInputs -> G3PSpark) -> G3PInputs -> G3PSeedInputs -> G3PSeed
forall a b. (a -> b) -> (G3PInputs -> a) -> G3PInputs -> b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((G3PSpark -> G3PSeedInputs -> G3PSeed)
 -> (G3PSalt -> G3PInputs -> G3PSpark)
 -> G3PSalt
 -> G3PInputs
 -> G3PSeedInputs
 -> G3PSeed)
-> (G3PSpark -> G3PSeedInputs -> G3PSeed)
-> (G3PSalt -> G3PInputs -> G3PSpark)
-> G3PSalt
-> G3PInputs
-> G3PSeedInputs
-> G3PSeed
forall a b. (a -> b) -> a -> b
$ G3PSpark -> G3PSeedInputs -> G3PSeed
g3pSpark_toSeed) G3PSalt -> G3PInputs -> G3PSpark
g3pSpark

g3pSeed_fromSpark
  :: G3PSeedInputs -- ^ bcrypt parameters
  -> G3PSpark -- ^ a partial evaluation of @G3Pb2 bravo@
  -> G3PSeed -- ^ the end of @G3Pb2 charlie@, the beginning of @G3Pb2 delta@
g3pSeed_fromSpark :: G3PSeedInputs -> G3PSpark -> G3PSeed
g3pSeed_fromSpark = (G3PSpark -> G3PSeedInputs -> G3PSeed)
-> G3PSeedInputs -> G3PSpark -> G3PSeed
forall a b c. (a -> b -> c) -> b -> a -> c
flip G3PSpark -> G3PSeedInputs -> G3PSeed
g3pSpark_toSeed

g3pSeed_toTree
  :: Foldable f
  => G3PSeed -- ^ the end of @G3Pb2 charlie@, the beginning of @G3Pb2 delta@
  -> HmacKey -- ^ sprout seguid
  -> f ByteString -- ^ sprout role
  -> ByteString -- ^ sprout tag
  -> G3PTree -- ^ the end of @G3Pb2 delta@, the beginning of @G3Pb2 echo@
g3pSeed_toTree :: forall (f :: * -> *).
Foldable f =>
G3PSeed -> HmacKey -> f ByteString -> ByteString -> G3PTree
g3pSeed_toTree = (G3PSprout -> f ByteString -> ByteString -> G3PTree)
-> (HmacKey -> G3PSprout)
-> HmacKey
-> f ByteString
-> ByteString
-> G3PTree
forall a b. (a -> b) -> (HmacKey -> a) -> HmacKey -> b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((G3PSprout -> ByteString -> G3PTree)
-> (f ByteString -> G3PSprout)
-> f ByteString
-> ByteString
-> G3PTree
forall a b. (a -> b) -> (f ByteString -> a) -> f ByteString -> b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap G3PSprout -> ByteString -> G3PTree
g3pSprout_toTree ((f ByteString -> G3PSprout)
 -> f ByteString -> ByteString -> G3PTree)
-> (G3PSprout -> f ByteString -> G3PSprout)
-> G3PSprout
-> f ByteString
-> ByteString
-> G3PTree
forall b c a. (b -> c) -> (a -> b) -> a -> c
. G3PSprout -> f ByteString -> G3PSprout
forall (f :: * -> *).
Foldable f =>
G3PSprout -> f ByteString -> G3PSprout
g3pSprout_args) ((HmacKey -> G3PSprout)
 -> HmacKey -> f ByteString -> ByteString -> G3PTree)
-> (G3PSeed -> HmacKey -> G3PSprout)
-> G3PSeed
-> HmacKey
-> f ByteString
-> ByteString
-> G3PTree
forall b c a. (b -> c) -> (a -> b) -> a -> c
. G3PSeed -> HmacKey -> G3PSprout
g3pSeed_toSprout

g3pSeed_toKey
  :: Foldable f
  => G3PSeed -- ^ the end of @G3Pb2 charlie@, the beginning of @G3Pb2 delta@
  -> HmacKey -- ^ sprout seguid
  -> f ByteString -- ^ sprout role
  -> ByteString -- ^ sprout tag
  -> ByteString -- ^ echo key right
  -> G3PKey -- ^ the middle of @G3Pb2 echo@
g3pSeed_toKey :: forall (f :: * -> *).
Foldable f =>
G3PSeed
-> HmacKey -> f ByteString -> ByteString -> ByteString -> G3PKey
g3pSeed_toKey = (G3PSprout -> f ByteString -> ByteString -> ByteString -> G3PKey)
-> (HmacKey -> G3PSprout)
-> HmacKey
-> f ByteString
-> ByteString
-> ByteString
-> G3PKey
forall a b. (a -> b) -> (HmacKey -> a) -> HmacKey -> b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap G3PSprout -> f ByteString -> ByteString -> ByteString -> G3PKey
forall (f :: * -> *).
Foldable f =>
G3PSprout -> f ByteString -> ByteString -> ByteString -> G3PKey
g3pSprout_toKey ((HmacKey -> G3PSprout)
 -> HmacKey -> f ByteString -> ByteString -> ByteString -> G3PKey)
-> (G3PSeed -> HmacKey -> G3PSprout)
-> G3PSeed
-> HmacKey
-> f ByteString
-> ByteString
-> ByteString
-> G3PKey
forall b c a. (b -> c) -> (a -> b) -> a -> c
. G3PSeed -> HmacKey -> G3PSprout
g3pSeed_toSprout

g3pSeed_toSource
  :: Foldable f
  => G3PSeed -- ^ the end of @G3Pb2 charlie@, the beginning of @G3Pb2 delta@
  -> HmacKey -- ^ sprout seguid
  -> f ByteString -- ^ sprout role
  -> ByteString -- ^ sprout tag
  -> ByteString -- ^ echo key right
  -> ByteString -- ^ echo header
  -> Word32 -- ^ echo counter
  -> ByteString -- ^ echo tag
  -> G3PSource -- ^ plain-old data representation of an output stream
g3pSeed_toSource :: forall (f :: * -> *).
Foldable f =>
G3PSeed
-> HmacKey
-> f ByteString
-> ByteString
-> ByteString
-> ByteString
-> Word32
-> ByteString
-> G3PSource
g3pSeed_toSource = (G3PSprout
 -> f ByteString
 -> ByteString
 -> ByteString
 -> ByteString
 -> Word32
 -> ByteString
 -> G3PSource)
-> (HmacKey -> G3PSprout)
-> HmacKey
-> f ByteString
-> ByteString
-> ByteString
-> ByteString
-> Word32
-> ByteString
-> G3PSource
forall a b. (a -> b) -> (HmacKey -> a) -> HmacKey -> b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap G3PSprout
-> f ByteString
-> ByteString
-> ByteString
-> ByteString
-> Word32
-> ByteString
-> G3PSource
forall (f :: * -> *).
Foldable f =>
G3PSprout
-> f ByteString
-> ByteString
-> ByteString
-> ByteString
-> Word32
-> ByteString
-> G3PSource
g3pSprout_toSource ((HmacKey -> G3PSprout)
 -> HmacKey
 -> f ByteString
 -> ByteString
 -> ByteString
 -> ByteString
 -> Word32
 -> ByteString
 -> G3PSource)
-> (G3PSeed -> HmacKey -> G3PSprout)
-> G3PSeed
-> HmacKey
-> f ByteString
-> ByteString
-> ByteString
-> ByteString
-> Word32
-> ByteString
-> G3PSource
forall b c a. (b -> c) -> (a -> b) -> a -> c
. G3PSeed -> HmacKey -> G3PSprout
g3pSeed_toSprout

g3pSprout
  :: G3PSalt -- ^ salt parameters, typically specified by deployment, typically needed throughout PHKDF key stretching
  -> G3PInputs -- ^ input parameters, often provided by the user, ready to be forgotten soon after the computation starts
  -> G3PSeedInputs -- ^ bcrypt parameters
  -> HmacKey -- ^ sprout seguid
  -> G3PSprout -- ^ the middle of @G3Pb2 delta@
g3pSprout :: G3PSalt -> G3PInputs -> G3PSeedInputs -> HmacKey -> G3PSprout
g3pSprout = (G3PSpark -> G3PSeedInputs -> HmacKey -> G3PSprout)
-> (G3PInputs -> G3PSpark)
-> G3PInputs
-> G3PSeedInputs
-> HmacKey
-> G3PSprout
forall a b. (a -> b) -> (G3PInputs -> a) -> G3PInputs -> b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap G3PSpark -> G3PSeedInputs -> HmacKey -> G3PSprout
g3pSpark_toSprout ((G3PInputs -> G3PSpark)
 -> G3PInputs -> G3PSeedInputs -> HmacKey -> G3PSprout)
-> (G3PSalt -> G3PInputs -> G3PSpark)
-> G3PSalt
-> G3PInputs
-> G3PSeedInputs
-> HmacKey
-> G3PSprout
forall b c a. (b -> c) -> (a -> b) -> a -> c
. G3PSalt -> G3PInputs -> G3PSpark
g3pSpark

-- There is no need to use the point-free style on the "from" variants, as the
-- order of arguments obviates the useful and interesting partial applications
g3pSprout_fromSpark
  :: G3PSeedInputs -- ^ bcrypt parameters
  -> HmacKey -- ^ sprout seguid
  -> G3PSpark -- ^ the end of @G3Pb2 bravo@, the beginning of @G3P charlie@
  -> G3PSprout -- ^ the middle of @G3Pb2 delta@
g3pSprout_fromSpark :: G3PSeedInputs -> HmacKey -> G3PSpark -> G3PSprout
g3pSprout_fromSpark G3PSeedInputs
inputs HmacKey
key G3PSpark
spark =
  G3PSpark -> G3PSeedInputs -> HmacKey -> G3PSprout
g3pSpark_toSprout G3PSpark
spark G3PSeedInputs
inputs HmacKey
key

g3pSprout_fromSeed
  :: HmacKey -- ^ sprout seguid
  -> G3PSeed -> G3PSprout -- ^ the middle of @G3Pb2 delta@
g3pSprout_fromSeed :: HmacKey -> G3PSeed -> G3PSprout
g3pSprout_fromSeed = (G3PSeed -> HmacKey -> G3PSprout)
-> HmacKey -> G3PSeed -> G3PSprout
forall a b c. (a -> b -> c) -> b -> a -> c
flip G3PSeed -> HmacKey -> G3PSprout
g3pSeed_toSprout

g3pSprout_toKey
  :: Foldable f
  => G3PSprout -- ^ a partial evaluation of @G3Pb2 delta@
  -> f ByteString -- ^ sprout role
  -> ByteString -- ^ sprout tag
  -> ByteString -- ^ echo key right
  -> G3PKey -- ^ the beginning of @G3P echo@
g3pSprout_toKey :: forall (f :: * -> *).
Foldable f =>
G3PSprout -> f ByteString -> ByteString -> ByteString -> G3PKey
g3pSprout_toKey = (G3PSprout -> ByteString -> ByteString -> G3PKey)
-> (f ByteString -> G3PSprout)
-> f ByteString
-> ByteString
-> ByteString
-> G3PKey
forall a b. (a -> b) -> (f ByteString -> a) -> f ByteString -> b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((G3PTree -> ByteString -> G3PKey)
-> (ByteString -> G3PTree) -> ByteString -> ByteString -> G3PKey
forall a b. (a -> b) -> (ByteString -> a) -> ByteString -> b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap G3PTree -> ByteString -> G3PKey
g3pTree_toKey ((ByteString -> G3PTree) -> ByteString -> ByteString -> G3PKey)
-> (G3PSprout -> ByteString -> G3PTree)
-> G3PSprout
-> ByteString
-> ByteString
-> G3PKey
forall b c a. (b -> c) -> (a -> b) -> a -> c
. G3PSprout -> ByteString -> G3PTree
g3pSprout_toTree) ((f ByteString -> G3PSprout)
 -> f ByteString -> ByteString -> ByteString -> G3PKey)
-> (G3PSprout -> f ByteString -> G3PSprout)
-> G3PSprout
-> f ByteString
-> ByteString
-> ByteString
-> G3PKey
forall b c a. (b -> c) -> (a -> b) -> a -> c
. G3PSprout -> f ByteString -> G3PSprout
forall (f :: * -> *).
Foldable f =>
G3PSprout -> f ByteString -> G3PSprout
g3pSprout_args

g3pSprout_toSource
  :: Foldable f
  => G3PSprout -- ^ the middle of @G3Pb2 delta@
  -> f ByteString -- ^ sprout role
  -> ByteString -- ^ sprout tag
  -> ByteString -- ^ echo key right
  -> ByteString -- ^ echo header
  -> Word32 -- ^ echo counter
  -> ByteString -- ^ echo tag
  -> G3PSource -- ^ plain-old data representation of an output stream
g3pSprout_toSource :: forall (f :: * -> *).
Foldable f =>
G3PSprout
-> f ByteString
-> ByteString
-> ByteString
-> ByteString
-> Word32
-> ByteString
-> G3PSource
g3pSprout_toSource =
  (G3PSprout
 -> ByteString
 -> ByteString
 -> ByteString
 -> Word32
 -> ByteString
 -> G3PSource)
-> (f ByteString -> G3PSprout)
-> f ByteString
-> ByteString
-> ByteString
-> ByteString
-> Word32
-> ByteString
-> G3PSource
forall a b. (a -> b) -> (f ByteString -> a) -> f ByteString -> b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((G3PTree
 -> ByteString -> ByteString -> Word32 -> ByteString -> G3PSource)
-> (ByteString -> G3PTree)
-> ByteString
-> ByteString
-> ByteString
-> Word32
-> ByteString
-> G3PSource
forall a b. (a -> b) -> (ByteString -> a) -> ByteString -> b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap G3PTree
-> ByteString -> ByteString -> Word32 -> ByteString -> G3PSource
g3pTree_toSource ((ByteString -> G3PTree)
 -> ByteString
 -> ByteString
 -> ByteString
 -> Word32
 -> ByteString
 -> G3PSource)
-> (G3PSprout -> ByteString -> G3PTree)
-> G3PSprout
-> ByteString
-> ByteString
-> ByteString
-> Word32
-> ByteString
-> G3PSource
forall b c a. (b -> c) -> (a -> b) -> a -> c
. G3PSprout -> ByteString -> G3PTree
g3pSprout_toTree) ((f ByteString -> G3PSprout)
 -> f ByteString
 -> ByteString
 -> ByteString
 -> ByteString
 -> Word32
 -> ByteString
 -> G3PSource)
-> (G3PSprout -> f ByteString -> G3PSprout)
-> G3PSprout
-> f ByteString
-> ByteString
-> ByteString
-> ByteString
-> Word32
-> ByteString
-> G3PSource
forall b c a. (b -> c) -> (a -> b) -> a -> c
. G3PSprout -> f ByteString -> G3PSprout
forall (f :: * -> *).
Foldable f =>
G3PSprout -> f ByteString -> G3PSprout
g3pSprout_args

g3pTree
  :: Foldable f
  => G3PSalt -- ^ salt parameters, typically specified by deployment, typically needed throughout PHKDF key stretching
  -> G3PInputs -- ^ input parameters, often provided by the user, ready to be forgotten soon after the computation starts
  -> G3PSeedInputs -- ^ bcrypt parameters
  -> HmacKey -- ^ sprout seguid
  -> f ByteString -- ^ sprout role
  -> ByteString -- ^ sprout tag
  -> G3PTree -- ^ the end of @G3Pb2 delta@, the beginning of @G3Pb2 echo@
g3pTree :: forall (f :: * -> *).
Foldable f =>
G3PSalt
-> G3PInputs
-> G3PSeedInputs
-> HmacKey
-> f ByteString
-> ByteString
-> G3PTree
g3pTree = (G3PSpark
 -> G3PSeedInputs
 -> HmacKey
 -> f ByteString
 -> ByteString
 -> G3PTree)
-> (G3PInputs -> G3PSpark)
-> G3PInputs
-> G3PSeedInputs
-> HmacKey
-> f ByteString
-> ByteString
-> G3PTree
forall a b. (a -> b) -> (G3PInputs -> a) -> G3PInputs -> b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap G3PSpark
-> G3PSeedInputs
-> HmacKey
-> f ByteString
-> ByteString
-> G3PTree
forall (f :: * -> *).
Foldable f =>
G3PSpark
-> G3PSeedInputs
-> HmacKey
-> f ByteString
-> ByteString
-> G3PTree
g3pSpark_toTree ((G3PInputs -> G3PSpark)
 -> G3PInputs
 -> G3PSeedInputs
 -> HmacKey
 -> f ByteString
 -> ByteString
 -> G3PTree)
-> (G3PSalt -> G3PInputs -> G3PSpark)
-> G3PSalt
-> G3PInputs
-> G3PSeedInputs
-> HmacKey
-> f ByteString
-> ByteString
-> G3PTree
forall b c a. (b -> c) -> (a -> b) -> a -> c
. G3PSalt -> G3PInputs -> G3PSpark
g3pSpark

g3pTree_fromSpark
  :: Foldable f
  => G3PSeedInputs -- ^ bcrypt parameters
  -> HmacKey -- ^ sprout seguid
  -> f ByteString -- ^ sprout role
  -> ByteString -- ^ sprout tag
  -> G3PSpark -- ^ the end of @G3Pb2 bravo@, the beginning of @G3Pb2 charlie@
  -> G3PTree -- ^ the end of @G3Pb2 delta@, the beginning of @G3Pb2 echo@
g3pTree_fromSpark :: forall (f :: * -> *).
Foldable f =>
G3PSeedInputs
-> HmacKey -> f ByteString -> ByteString -> G3PSpark -> G3PTree
g3pTree_fromSpark G3PSeedInputs
inputs HmacKey
key f ByteString
role ByteString
tag G3PSpark
spark =
  G3PSpark
-> G3PSeedInputs
-> HmacKey
-> f ByteString
-> ByteString
-> G3PTree
forall (f :: * -> *).
Foldable f =>
G3PSpark
-> G3PSeedInputs
-> HmacKey
-> f ByteString
-> ByteString
-> G3PTree
g3pSpark_toTree G3PSpark
spark G3PSeedInputs
inputs HmacKey
key f ByteString
role ByteString
tag

g3pTree_fromSeed
  :: Foldable f
  => HmacKey -- ^ sprout seguid
  -> f ByteString -- ^ sprout role
  -> ByteString -- ^ sprout tag
  -> G3PSeed -- ^ the end of @G3Pb2 charlie@, the beginning of @G3Pb2 delta@
  -> G3PTree -- ^ the end of @G3Pb2 delta@, the beginning of @G3Pb2 echo@
g3pTree_fromSeed :: forall (f :: * -> *).
Foldable f =>
HmacKey -> f ByteString -> ByteString -> G3PSeed -> G3PTree
g3pTree_fromSeed HmacKey
key f ByteString
role ByteString
tag G3PSeed
seed =
  G3PSeed -> HmacKey -> f ByteString -> ByteString -> G3PTree
forall (f :: * -> *).
Foldable f =>
G3PSeed -> HmacKey -> f ByteString -> ByteString -> G3PTree
g3pSeed_toTree G3PSeed
seed HmacKey
key f ByteString
role ByteString
tag

g3pTree_fromSprout
  :: ByteString -- ^ sprout tag
  -> G3PSprout -> G3PTree -- ^  the end of @G3Pb2 delta@, the beginning of @G3Pb2 echo@
g3pTree_fromSprout :: ByteString -> G3PSprout -> G3PTree
g3pTree_fromSprout = (G3PSprout -> ByteString -> G3PTree)
-> ByteString -> G3PSprout -> G3PTree
forall a b c. (a -> b -> c) -> b -> a -> c
flip G3PSprout -> ByteString -> G3PTree
g3pSprout_toTree

g3pTree_toSource
  :: G3PTree -- ^ the end of @G3Pb2 delta@, the beginning of @G3Pb2 echo@
  -> ByteString -- ^ echo key right
  -> ByteString -- ^ echo header
  -> Word32 -- ^ echo counter
  -> ByteString -- ^ echo tag
  -> G3PSource -- ^ plain-old data representation of an output stream
g3pTree_toSource :: G3PTree
-> ByteString -> ByteString -> Word32 -> ByteString -> G3PSource
g3pTree_toSource = (G3PKey -> ByteString -> Word32 -> ByteString -> G3PSource)
-> (ByteString -> G3PKey)
-> ByteString
-> ByteString
-> Word32
-> ByteString
-> G3PSource
forall a b. (a -> b) -> (ByteString -> a) -> ByteString -> b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap G3PKey -> ByteString -> Word32 -> ByteString -> G3PSource
g3pKey_toSource ((ByteString -> G3PKey)
 -> ByteString -> ByteString -> Word32 -> ByteString -> G3PSource)
-> (G3PTree -> ByteString -> G3PKey)
-> G3PTree
-> ByteString
-> ByteString
-> Word32
-> ByteString
-> G3PSource
forall b c a. (b -> c) -> (a -> b) -> a -> c
. G3PTree -> ByteString -> G3PKey
g3pTree_toKey

g3pKey
  :: Foldable f
  => G3PSalt -- ^ salt parameters, typically specified by deployment, typically needed throughout PHKDF key stretching
  -> G3PInputs -- ^ input parameters, often provided by the user, ready to be forgotten soon after the computation starts
  -> G3PSeedInputs -- ^ bcrypt parameters
  -> HmacKey -- ^ sprout seguid
  -> f ByteString -- ^ sprout role
  -> ByteString -- ^ sprout tag
  -> ByteString -- ^ echo key right
  -> G3PKey -- ^ the beginning of @G3P echo@
g3pKey :: forall (f :: * -> *).
Foldable f =>
G3PSalt
-> G3PInputs
-> G3PSeedInputs
-> HmacKey
-> f ByteString
-> ByteString
-> ByteString
-> G3PKey
g3pKey = (G3PSpark
 -> G3PSeedInputs
 -> HmacKey
 -> f ByteString
 -> ByteString
 -> ByteString
 -> G3PKey)
-> (G3PInputs -> G3PSpark)
-> G3PInputs
-> G3PSeedInputs
-> HmacKey
-> f ByteString
-> ByteString
-> ByteString
-> G3PKey
forall a b. (a -> b) -> (G3PInputs -> a) -> G3PInputs -> b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap G3PSpark
-> G3PSeedInputs
-> HmacKey
-> f ByteString
-> ByteString
-> ByteString
-> G3PKey
forall (f :: * -> *).
Foldable f =>
G3PSpark
-> G3PSeedInputs
-> HmacKey
-> f ByteString
-> ByteString
-> ByteString
-> G3PKey
g3pSpark_toKey ((G3PInputs -> G3PSpark)
 -> G3PInputs
 -> G3PSeedInputs
 -> HmacKey
 -> f ByteString
 -> ByteString
 -> ByteString
 -> G3PKey)
-> (G3PSalt -> G3PInputs -> G3PSpark)
-> G3PSalt
-> G3PInputs
-> G3PSeedInputs
-> HmacKey
-> f ByteString
-> ByteString
-> ByteString
-> G3PKey
forall b c a. (b -> c) -> (a -> b) -> a -> c
. G3PSalt -> G3PInputs -> G3PSpark
g3pSpark

g3pKey_fromSpark
  :: Foldable f
  => G3PSeedInputs -- ^ bcrypt parameters
  -> HmacKey -- ^ sprout seguid
  -> f ByteString -- ^ sprout role
  -> ByteString -- ^ sprout tag
  -> ByteString -- ^ echo key right
  -> G3PSpark -- ^ a partial evaluation of @G3P bravo@
  -> G3PKey -- ^ the beginning of @G3P echo@
g3pKey_fromSpark :: forall (f :: * -> *).
Foldable f =>
G3PSeedInputs
-> HmacKey
-> f ByteString
-> ByteString
-> ByteString
-> G3PSpark
-> G3PKey
g3pKey_fromSpark G3PSeedInputs
inputs HmacKey
key f ByteString
role ByteString
tag ByteString
ekey G3PSpark
spark =
  G3PSpark
-> G3PSeedInputs
-> HmacKey
-> f ByteString
-> ByteString
-> ByteString
-> G3PKey
forall (f :: * -> *).
Foldable f =>
G3PSpark
-> G3PSeedInputs
-> HmacKey
-> f ByteString
-> ByteString
-> ByteString
-> G3PKey
g3pSpark_toKey G3PSpark
spark G3PSeedInputs
inputs HmacKey
key f ByteString
role ByteString
tag ByteString
ekey

g3pKey_fromSeed
  :: Foldable f
  => HmacKey -- ^ sprout seguid
  -> f ByteString -- ^ sprout role
  -> ByteString -- ^ sprout tag
  -> ByteString -- ^ echo key right
  -> G3PSeed -- ^ the end of @G3Pb2 charlie@, the beginning of @G3Pb2 delta@
  -> G3PKey -- ^ the middle of @G3Pb2 echo@
g3pKey_fromSeed :: forall (f :: * -> *).
Foldable f =>
HmacKey
-> f ByteString -> ByteString -> ByteString -> G3PSeed -> G3PKey
g3pKey_fromSeed HmacKey
key f ByteString
role ByteString
tag ByteString
ekey G3PSeed
seed =
  G3PSeed
-> HmacKey -> f ByteString -> ByteString -> ByteString -> G3PKey
forall (f :: * -> *).
Foldable f =>
G3PSeed
-> HmacKey -> f ByteString -> ByteString -> ByteString -> G3PKey
g3pSeed_toKey G3PSeed
seed HmacKey
key f ByteString
role ByteString
tag ByteString
ekey

g3pKey_fromSprout
  :: Foldable f
  => f ByteString -- ^ sprout role
  -> ByteString -- ^ sprout tag
  -> ByteString -- ^ echo key right
  -> G3PSprout -- ^ the middle of @G3Pb2 delta@
  -> G3PKey -- ^ the middle of @G3Pb2 echo@
g3pKey_fromSprout :: forall (f :: * -> *).
Foldable f =>
f ByteString -> ByteString -> ByteString -> G3PSprout -> G3PKey
g3pKey_fromSprout f ByteString
role ByteString
tag ByteString
key G3PSprout
sprout =
  G3PSprout -> f ByteString -> ByteString -> ByteString -> G3PKey
forall (f :: * -> *).
Foldable f =>
G3PSprout -> f ByteString -> ByteString -> ByteString -> G3PKey
g3pSprout_toKey G3PSprout
sprout f ByteString
role ByteString
tag ByteString
key

g3pKey_fromTree
  :: ByteString -- ^ echo key right
  -> G3PTree -- ^ the end of @G3Pb2 delta@, the beginning of @G3Pb2 echo@
  -> G3PKey -- ^ the middle of @G3Pb2 echo@
g3pKey_fromTree :: ByteString -> G3PTree -> G3PKey
g3pKey_fromTree = (G3PTree -> ByteString -> G3PKey)
-> ByteString -> G3PTree -> G3PKey
forall a b c. (a -> b -> c) -> b -> a -> c
flip G3PTree -> ByteString -> G3PKey
g3pTree_toKey

g3pSource
  :: Foldable f
  => G3PSalt -- ^ salt parameters, typically specified by deployment, typically needed throughout PHKDF key stretching
  -> G3PInputs -- ^ input parameters, often provided by the user, ready to be forgotten soon after the computation starts
  -> G3PSeedInputs -- ^ bcrypt parameters
  -> HmacKey -- ^ sprout seguid
  -> f ByteString -- ^ sprout role
  -> ByteString -- ^ sprout tag
  -> ByteString -- ^ echo key right
  -> ByteString -- ^ echo header
  -> Word32 -- ^ echo counter
  -> ByteString -- ^ echo tag
  -> G3PSource -- ^ A plain-old-data representation of a G3P output stream
g3pSource :: forall (f :: * -> *).
Foldable f =>
G3PSalt
-> G3PInputs
-> G3PSeedInputs
-> HmacKey
-> f ByteString
-> ByteString
-> ByteString
-> ByteString
-> Word32
-> ByteString
-> G3PSource
g3pSource = (G3PSpark
 -> G3PSeedInputs
 -> HmacKey
 -> f ByteString
 -> ByteString
 -> ByteString
 -> ByteString
 -> Word32
 -> ByteString
 -> G3PSource)
-> (G3PInputs -> G3PSpark)
-> G3PInputs
-> G3PSeedInputs
-> HmacKey
-> f ByteString
-> ByteString
-> ByteString
-> ByteString
-> Word32
-> ByteString
-> G3PSource
forall a b. (a -> b) -> (G3PInputs -> a) -> G3PInputs -> b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap G3PSpark
-> G3PSeedInputs
-> HmacKey
-> f ByteString
-> ByteString
-> ByteString
-> ByteString
-> Word32
-> ByteString
-> G3PSource
forall (f :: * -> *).
Foldable f =>
G3PSpark
-> G3PSeedInputs
-> HmacKey
-> f ByteString
-> ByteString
-> ByteString
-> ByteString
-> Word32
-> ByteString
-> G3PSource
g3pSpark_toSource ((G3PInputs -> G3PSpark)
 -> G3PInputs
 -> G3PSeedInputs
 -> HmacKey
 -> f ByteString
 -> ByteString
 -> ByteString
 -> ByteString
 -> Word32
 -> ByteString
 -> G3PSource)
-> (G3PSalt -> G3PInputs -> G3PSpark)
-> G3PSalt
-> G3PInputs
-> G3PSeedInputs
-> HmacKey
-> f ByteString
-> ByteString
-> ByteString
-> ByteString
-> Word32
-> ByteString
-> G3PSource
forall b c a. (b -> c) -> (a -> b) -> a -> c
. G3PSalt -> G3PInputs -> G3PSpark
g3pSpark

g3pSource_fromSpark
  :: Foldable f
  => G3PSeedInputs -- ^ bcrypt parameters
  -> HmacKey -- ^ sprout seguid
  -> f ByteString -- ^ sprout role
  -> ByteString -- ^ sprout tag
  -> ByteString -- ^ echo key right
  -> ByteString -- ^ echo header
  -> Word32 -- ^ echo counter
  -> ByteString -- ^ echo tag
  -> G3PSpark -> G3PSource -- ^ plain-old data representation of an output stream
g3pSource_fromSpark :: forall (f :: * -> *).
Foldable f =>
G3PSeedInputs
-> HmacKey
-> f ByteString
-> ByteString
-> ByteString
-> ByteString
-> Word32
-> ByteString
-> G3PSpark
-> G3PSource
g3pSource_fromSpark G3PSeedInputs
inputs HmacKey
key f ByteString
role ByteString
tag ByteString
ekey ByteString
ehdr Word32
ectr ByteString
etag G3PSpark
spark =
  G3PSpark
-> G3PSeedInputs
-> HmacKey
-> f ByteString
-> ByteString
-> ByteString
-> ByteString
-> Word32
-> ByteString
-> G3PSource
forall (f :: * -> *).
Foldable f =>
G3PSpark
-> G3PSeedInputs
-> HmacKey
-> f ByteString
-> ByteString
-> ByteString
-> ByteString
-> Word32
-> ByteString
-> G3PSource
g3pSpark_toSource G3PSpark
spark G3PSeedInputs
inputs HmacKey
key f ByteString
role ByteString
tag ByteString
ekey ByteString
ehdr Word32
ectr ByteString
etag

g3pSource_fromSeed
  :: Foldable f
  => HmacKey -- ^ sprout seguid
  -> f ByteString -- ^ sprout role
  -> ByteString -- ^ sprout tag
  -> ByteString -- ^ echo key right
  -> ByteString -- ^ echo header
  -> Word32 -- ^ echo counter
  -> ByteString -- ^ echo tag
  -> G3PSeed -- ^ the end of @G3Pb2 charlie@, the beginning of @G3Pb2 delta@
  -> G3PSource -- ^ plain-old data representation of an output stream
g3pSource_fromSeed :: forall (f :: * -> *).
Foldable f =>
HmacKey
-> f ByteString
-> ByteString
-> ByteString
-> ByteString
-> Word32
-> ByteString
-> G3PSeed
-> G3PSource
g3pSource_fromSeed HmacKey
key f ByteString
role ByteString
tag ByteString
ekey ByteString
ehdr Word32
ectr ByteString
etag G3PSeed
seed =
  G3PSeed
-> HmacKey
-> f ByteString
-> ByteString
-> ByteString
-> ByteString
-> Word32
-> ByteString
-> G3PSource
forall (f :: * -> *).
Foldable f =>
G3PSeed
-> HmacKey
-> f ByteString
-> ByteString
-> ByteString
-> ByteString
-> Word32
-> ByteString
-> G3PSource
g3pSeed_toSource G3PSeed
seed HmacKey
key f ByteString
role ByteString
tag ByteString
ekey ByteString
ehdr Word32
ectr ByteString
etag

g3pSource_fromSprout
  :: Foldable f
  => f ByteString -- ^ sprout role
  -> ByteString -- ^ sprout tag
  -> ByteString -- ^ echo key right
  -> ByteString -- ^ echo header
  -> Word32 -- ^ echo counter
  -> ByteString -- ^ echo tag
  -> G3PSprout -- ^ the middle of @G3Pb2 delta@
  -> G3PSource -- ^ plain-old data representation of an output stream
g3pSource_fromSprout :: forall (f :: * -> *).
Foldable f =>
f ByteString
-> ByteString
-> ByteString
-> ByteString
-> Word32
-> ByteString
-> G3PSprout
-> G3PSource
g3pSource_fromSprout f ByteString
role ByteString
tag ByteString
ekey ByteString
ehdr Word32
ectr ByteString
etag G3PSprout
sprout =
  G3PSprout
-> f ByteString
-> ByteString
-> ByteString
-> ByteString
-> Word32
-> ByteString
-> G3PSource
forall (f :: * -> *).
Foldable f =>
G3PSprout
-> f ByteString
-> ByteString
-> ByteString
-> ByteString
-> Word32
-> ByteString
-> G3PSource
g3pSprout_toSource G3PSprout
sprout f ByteString
role ByteString
tag ByteString
ekey ByteString
ehdr Word32
ectr ByteString
etag

g3pSource_fromTree
  :: ByteString -- ^ echo key right
  -> ByteString -- ^ echo header
  -> Word32 -- ^ echo counter
  -> ByteString -- ^ echo tag
  -> G3PTree -- ^ the end of @G3Pb2 delta@, the beginning of @G3Pb2 echo@
  -> G3PSource -- ^ plain-old data representation of an output stream
g3pSource_fromTree :: ByteString
-> ByteString -> Word32 -> ByteString -> G3PTree -> G3PSource
g3pSource_fromTree ByteString
ekey ByteString
ehdr Word32
ectr ByteString
etag G3PTree
tree =
  G3PTree
-> ByteString -> ByteString -> Word32 -> ByteString -> G3PSource
g3pTree_toSource G3PTree
tree ByteString
ekey ByteString
ehdr Word32
ectr ByteString
etag

g3pSource_fromKey
  :: ByteString -- ^ echo header
  -> Word32 -- ^ echo counter
  -> ByteString -- ^ echo tag
  -> G3PKey -- ^ the middle of @G3Pb2 echo@
  -> G3PSource -- ^ plain-old data representation of an output stream
g3pSource_fromKey :: ByteString -> Word32 -> ByteString -> G3PKey -> G3PSource
g3pSource_fromKey ByteString
ehdr Word32
ectr ByteString
etag G3PKey
key =
  G3PKey -> ByteString -> Word32 -> ByteString -> G3PSource
g3pKey_toSource G3PKey
key ByteString
ehdr Word32
ectr ByteString
etag

-- | This variant of 'g3pHash' returns an unbounded stream of 32-byte output
--   blocks.  Use as many or as few as you want. Assuming the non-echo-header
--   inputs contain at least one strong secret, the output blocks are
--   cryptographically independent. You can partition the output into
--   non-overlapping chunks and use those chunks however you see fit.
--
--   NIST SP 800-108 recommendations imply that you shouldn't look at more
--   than 137.4 GB of output. This recommendation is extremely cautious, and
--   it's probably okay-ish in most circumstances to exceed that limit by a
--   considerable margin.
--
--   On the other hand, if you really want that much CSPRNG data, you may
--   well be better off using this function to generate keys for another,
--   faster CSPRNG.

g3pStream
  :: Foldable f
  => G3PSalt -- ^ salt parameters, typically specified by deployment, typically needed throughout PHKDF key stretching
  -> G3PInputs -- ^ input parameters, often provided by the user, ready to be forgotten soon after the computation starts
  -> G3PSeedInputs -- ^ bcrypt parameters
  -> HmacKey -- ^ sprout seguid
  -> f ByteString -- ^ sprout role
  -> ByteString -- ^ sprout tag
  -> ByteString -- ^ echo key right
  -> ByteString -- ^ echo header
  -> Word32 -- ^ echo counter
  -> ByteString -- ^ echo tag
  -> Stream ByteString
g3pStream :: forall (f :: * -> *).
Foldable f =>
G3PSalt
-> G3PInputs
-> G3PSeedInputs
-> HmacKey
-> f ByteString
-> ByteString
-> ByteString
-> ByteString
-> Word32
-> ByteString
-> Stream ByteString
g3pStream = (G3PSpark
 -> G3PSeedInputs
 -> HmacKey
 -> f ByteString
 -> ByteString
 -> ByteString
 -> ByteString
 -> Word32
 -> ByteString
 -> Stream ByteString)
-> (G3PInputs -> G3PSpark)
-> G3PInputs
-> G3PSeedInputs
-> HmacKey
-> f ByteString
-> ByteString
-> ByteString
-> ByteString
-> Word32
-> ByteString
-> Stream ByteString
forall a b. (a -> b) -> (G3PInputs -> a) -> G3PInputs -> b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap G3PSpark
-> G3PSeedInputs
-> HmacKey
-> f ByteString
-> ByteString
-> ByteString
-> ByteString
-> Word32
-> ByteString
-> Stream ByteString
forall (f :: * -> *).
Foldable f =>
G3PSpark
-> G3PSeedInputs
-> HmacKey
-> f ByteString
-> ByteString
-> ByteString
-> ByteString
-> Word32
-> ByteString
-> Stream ByteString
g3pSpark_toStream ((G3PInputs -> G3PSpark)
 -> G3PInputs
 -> G3PSeedInputs
 -> HmacKey
 -> f ByteString
 -> ByteString
 -> ByteString
 -> ByteString
 -> Word32
 -> ByteString
 -> Stream ByteString)
-> (G3PSalt -> G3PInputs -> G3PSpark)
-> G3PSalt
-> G3PInputs
-> G3PSeedInputs
-> HmacKey
-> f ByteString
-> ByteString
-> ByteString
-> ByteString
-> Word32
-> ByteString
-> Stream ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. G3PSalt -> G3PInputs -> G3PSpark
g3pSpark

g3pStream_fromSpark
  :: Foldable f
  => G3PSeedInputs -- ^ bcrypt parameters
  -> HmacKey -- ^ sprout seguid
  -> f ByteString -- ^ sprout role
  -> ByteString -- ^ sprout tag
  -> ByteString -- ^ echo key right
  -> ByteString -- ^ echo header
  -> Word32 -- ^ echo counter
  -> ByteString -- ^ echo tag
  -> G3PSpark -> Stream ByteString
g3pStream_fromSpark :: forall (f :: * -> *).
Foldable f =>
G3PSeedInputs
-> HmacKey
-> f ByteString
-> ByteString
-> ByteString
-> ByteString
-> Word32
-> ByteString
-> G3PSpark
-> Stream ByteString
g3pStream_fromSpark G3PSeedInputs
inputs HmacKey
key f ByteString
role ByteString
tag ByteString
ekey ByteString
ehdr Word32
ectr ByteString
etag G3PSpark
spark =
  G3PSpark
-> G3PSeedInputs
-> HmacKey
-> f ByteString
-> ByteString
-> ByteString
-> ByteString
-> Word32
-> ByteString
-> Stream ByteString
forall (f :: * -> *).
Foldable f =>
G3PSpark
-> G3PSeedInputs
-> HmacKey
-> f ByteString
-> ByteString
-> ByteString
-> ByteString
-> Word32
-> ByteString
-> Stream ByteString
g3pSpark_toStream G3PSpark
spark G3PSeedInputs
inputs HmacKey
key f ByteString
role ByteString
tag ByteString
ekey ByteString
ehdr Word32
ectr ByteString
etag

g3pStream_fromSeed
  :: Foldable f
  => HmacKey -- ^ sprout seguid
  -> f ByteString -- ^ sprout role
  -> ByteString -- ^ sprout tag
  -> ByteString -- ^ echo key right
  -> ByteString -- ^ echo header
  -> Word32 -- ^ echo counter
  -> ByteString -- ^ echo tag
  -> G3PSeed -- ^ the end of @G3Pb2 charlie@, the beginning of @G3Pb2 delta@
  -> Stream ByteString
g3pStream_fromSeed :: forall (f :: * -> *).
Foldable f =>
HmacKey
-> f ByteString
-> ByteString
-> ByteString
-> ByteString
-> Word32
-> ByteString
-> G3PSeed
-> Stream ByteString
g3pStream_fromSeed HmacKey
key f ByteString
role ByteString
tag ByteString
ekey ByteString
ehdr Word32
ectr ByteString
etag G3PSeed
seed =
  G3PSeed
-> HmacKey
-> f ByteString
-> ByteString
-> ByteString
-> ByteString
-> Word32
-> ByteString
-> Stream ByteString
forall (f :: * -> *).
Foldable f =>
G3PSeed
-> HmacKey
-> f ByteString
-> ByteString
-> ByteString
-> ByteString
-> Word32
-> ByteString
-> Stream ByteString
g3pSeed_toStream G3PSeed
seed HmacKey
key f ByteString
role ByteString
tag ByteString
ekey ByteString
ehdr Word32
ectr ByteString
etag

g3pStream_fromSprout
  :: Foldable f
  => f ByteString -- ^ sprout role
  -> ByteString -- ^ sprout tag
  -> ByteString -- ^ echo key right
  -> ByteString -- ^ echo header
  -> Word32 -- ^ echo counter
  -> ByteString -- ^ echo tag
  -> G3PSprout -> Stream ByteString
g3pStream_fromSprout :: forall (f :: * -> *).
Foldable f =>
f ByteString
-> ByteString
-> ByteString
-> ByteString
-> Word32
-> ByteString
-> G3PSprout
-> Stream ByteString
g3pStream_fromSprout f ByteString
role ByteString
tag ByteString
ekey ByteString
ehdr Word32
ectr ByteString
etag G3PSprout
sprout =
  G3PSprout
-> f ByteString
-> ByteString
-> ByteString
-> ByteString
-> Word32
-> ByteString
-> Stream ByteString
forall (f :: * -> *).
Foldable f =>
G3PSprout
-> f ByteString
-> ByteString
-> ByteString
-> ByteString
-> Word32
-> ByteString
-> Stream ByteString
g3pSprout_toStream G3PSprout
sprout f ByteString
role ByteString
tag ByteString
ekey ByteString
ehdr Word32
ectr ByteString
etag

g3pStream_fromTree
  :: ByteString -- ^ echo key right
  -> ByteString -- ^ echo header
  -> Word32 -- ^ echo counter
  -> ByteString -- ^ echo tag
  -> G3PTree -> Stream ByteString
g3pStream_fromTree :: ByteString
-> ByteString
-> Word32
-> ByteString
-> G3PTree
-> Stream ByteString
g3pStream_fromTree ByteString
key ByteString
hdr Word32
ctr ByteString
tag G3PTree
tree =
  G3PTree
-> ByteString
-> ByteString
-> Word32
-> ByteString
-> Stream ByteString
g3pTree_toStream G3PTree
tree ByteString
key ByteString
hdr Word32
ctr ByteString
tag

g3pStream_fromKey
  :: ByteString -- ^ echo header
  -> Word32 -- ^ echo counter
  -> ByteString -- ^ echo tag
  -> G3PKey -> Stream ByteString
g3pStream_fromKey :: ByteString -> Word32 -> ByteString -> G3PKey -> Stream ByteString
g3pStream_fromKey ByteString
hdr Word32
ctr ByteString
tag G3PKey
key =
  G3PKey -> ByteString -> Word32 -> ByteString -> Stream ByteString
g3pKey_toStream G3PKey
key ByteString
hdr Word32
ctr ByteString
tag

g3pStream_fromSource :: G3PSource -> Stream ByteString
g3pStream_fromSource :: G3PSource -> Stream ByteString
g3pStream_fromSource = G3PSource -> Stream ByteString
g3pSource_toStream