{-# LINE 1 "lib/Crypto/G3P/BCrypt/Subtle.hsc" #-}
{-# LANGUAGE CApiFFI, OverloadedStrings, ViewPatterns #-}

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

{- |

Bcrypt with an excessive amount of freedom and salt, appropriate for
our excessively salty era. This module exports bindings that are
potentially cryptographically unsafe to lower-level functions written in C.

Bcrypt's state machine exhibits a beautiful grouplike structure known as a
/quasigroup/, see [wikipedia](https://en.wikipedia.org/wiki/Quasigroup) or the
[ncat wiki](https://ncatlab.org/nlab/show/quasigroup). Blowfish's state machine
is exactly 4168 bytes, and bcrypt's modification to blowfish's key expansion
represents a /transition code/ that is also exactly 4168 bytes long.

Basically, each call to /Blowfish_expandstate/ encrypts the transition code
with the Blowfish block cipher in Cipher Block Chaining (CBC) mode of operation.
Well, not quite, as this key setup process actually uses each output block
to overwrite part of the key, so it's more like CBC with key feedback.

/Blowfish_expandstate/ is part of a relation between input states, transition
codes, and output states. Given any two components of any one of these
3-tuples, one can efficiently compute the third component.

/Blowfish_expandstate/ is what computes output states from input states
and transition codes.  One can also implement /Blowfish_reverseExpandstate/
that computes input states from output states and transition codes, and
/Blowfish_transitionCode/ that computes transition codes from input states
and output states. Together they form the triple of functions needed to satisfy
the universal-algebra-flavored definition of a quasigroup.

This quasigroup implies that no state or transition code is particularly
special, and that choosing a different transition code does not change the
dynamical properties of the blowfish state machine /on average/.

Of course, the molecules in a cup full of room-temperature water /on average/
are moving much too slowly to ever become a gas, yet a cup full of water that
is exposed to the open air will reliably evaporate over time. Similarly,
this quasigroup structure also implies that allowing unrestricted use of
transition codes, as the 'bcryptXs' binding allows you to do, is horribly
broken from a security perspective.

Yet this also implies that choosing transition codes in an open and honest
way is a perfectly safe modification to the bcrypt algorithm. Thus the goal
of bcrypt-xs-ctr is to add enough restrictions to how these transition codes
are chosen and used to tame excessively long tags and keep everything secure.

The first and safest recommendation is to include the excess salt in the
derivation of other inputs to bcrypt, thus enforcing the requirement
that the tags be chosen before the inputs are examined.

As a fallback, the bcryptXsCtrSuperRound has a couple of design features that
somewhat naively attempt to address this issue:

1.  The initial call to @expand@ is designed to rapidly and completely
    encode both @key0@ and @key1@ into the bcrypt state, relative to
    the starting round state. This ensures a complete transfer of entropy
    after a small number of Blowfish block encryptions.

    (This argument assumes @length key0 + length key1 <= 72@ bytes long)

2.  The first N bytes of the p-box are protected by the function name, which
    exists primarily to prohibit nearly all possible transition codes, to
    ensure the firt N bytes of the transition code aren't under any possible
    control of external input.

    (This argument assumes @length name == N@)

3.  Every bcrypt round (a miniround within the superround) repeats the same
    4168 - N external bytes in four different places, each in the same relative
    position with respect to a 4168-byte state or transition code.

    Two of these repetitions occur by xor-ing the external bytes with the
    last bytes of the state vector. The first N bytes of the state-xor are
    reserved, once for key0 and once for key1.

    Two of these repeititons occur as the last bytes of the transition code.
    The first 4 bytes of the transition code is reserved for a counter, which
    is complemented between repetitions for a guaranteed non-linear effect.
    The remaining (N - 4) bytes are taken up by the function name.

    This breaks all the obvious attacks, and may well break many or all of
    the less obvious attacks too. I wouldn't want to rely too much on this
    particular combinatorial block design structure without further study,
    which is likely to suggest further design improvements.

    However, this was a no-risk move that didn't cost the intended use cases
    anything, but looked plausibly strong against issues that lay well beyond
    the intended scope of the design.

    (This argument assumes @4 < length key0 == length key1 == length name@)

4.  The transition code includes a counter to ensure that the transitions
    are different on every call to @expand@.  The counter takes up the
    first four bytes of the transition code to ensure it affects the first
    output block.

    This implies that in the highly unlikely case that bcrypt's machine
    ever loops back around to the same state within a single key-stretching
    computation, this counter /ensures/ that the next state transitioned
    to /will/ be different than before, and will be different within the
    first blowfish block, thus breaking any cycles.

-}

module Crypto.G3P.BCrypt.Subtle
  ( orpheanBeholderScryDoubt
  , bcrypt_outputSalt
  , bcryptRaw_outputSalt
  , bcryptRaw_genInputs
  , BCryptXs(..)
  , bcryptXs
  , BCryptXsCtr(..)
  , bcryptXsCtrSuperRound
  , bcryptXs_maxKeyLength
  , bcryptXs_maxSaltLength
  , bcryptXsCtr_outputLength
  , BCryptState(..)
  , base64Encode
  , base64Decode
  ) where



import           Data.ByteString(ByteString)
import qualified Data.ByteString as B
import qualified Data.ByteString.Unsafe as B
import qualified Data.ByteString.Internal as B
import           Data.Word
import           Data.Int

import           Foreign.C.String
import           Foreign.C.Types
import           Foreign.ForeignPtr
import           Foreign.Ptr
import           System.IO.Unsafe


orpheanBeholderScryDoubt :: ByteString
orpheanBeholderScryDoubt :: ByteString
orpheanBeholderScryDoubt = ByteString
"OrpheanBeholderScryDoubt"

bcrypt_outputSalt :: ByteString
bcrypt_outputSalt :: ByteString
bcrypt_outputSalt = ByteString
orpheanBeholderScryDoubt

bcryptRaw_outputSalt :: ByteString
bcryptRaw_outputSalt :: ByteString
bcryptRaw_outputSalt = ByteString
orpheanBeholderScryDoubt

-- uhh, whut? Am I looking at the wrong version of some documentation? Figuring
-- out why this is at least sometimes necessary is a good puzzle for later:

myUseAsCString :: ByteString -> (CString -> IO a) -> IO a
myUseAsCString :: forall a. ByteString -> (CString -> IO a) -> IO a
myUseAsCString ByteString
x CString -> IO a
f = if ByteString -> Bool
B.null ByteString
x then CString -> IO a
f CString
forall a. Ptr a
nullPtr else ByteString -> (CString -> IO a) -> IO a
forall a. ByteString -> (CString -> IO a) -> IO a
B.unsafeUseAsCString ByteString
x CString -> IO a
f

data BCryptXs = BCryptXs
  { BCryptXs -> ByteString
bcryptXs_key0 :: !ByteString
  , BCryptXs -> ByteString
bcryptXs_salt0 :: !ByteString
  , BCryptXs -> ByteString
bcryptXs_keyL :: !ByteString
  , BCryptXs -> ByteString
bcryptXs_saltL :: !ByteString
  , BCryptXs -> ByteString
bcryptXs_keyR :: !ByteString
  , BCryptXs -> ByteString
bcryptXs_saltR :: !ByteString
  , BCryptXs -> ByteString
bcryptXs_saltZ :: !ByteString -- ^ not subject to maxSaltLength, but that doesn't seem overly relevant
  , BCryptXs -> Word32
bcryptXs_rounds :: !Word32
  , BCryptXs -> Bool
bcryptXs_implicitNull :: !Bool
  }

data BCryptXsCtr = BCryptXsCtr
  { BCryptXsCtr -> ByteString
bcryptXsCtr_key0 :: !ByteString
  , BCryptXsCtr -> ByteString
bcryptXsCtr_key1 :: !ByteString
  , BCryptXsCtr -> ByteString
bcryptXsCtr_tag  :: !ByteString
  , BCryptXsCtr -> ByteString
bcryptXsCtr_name :: !ByteString
  }

foreign import capi "g3p_bcrypt.h G3P_bcrypt_xs"
  c_bcrypt_xs
    :: CString -> Word16 -> CString -> Word16
    -> CString -> Word16 -> CString -> Word16
    -> CString -> Word16 -> CString -> Word16
    -> CString -> Word32 -> Word32 -> Bool -> Ptr Word8 -> IO ()

foreign import capi "g3p_bcrypt.h G3P_bcrypt_xs_ctr_superround"
  c_bcrypt_xs_ctr_superround
    :: CString
    -> CString -> Word32 -> CString -> Word32
    -> CString -> Word32 -> CString -> Word32
    -> Word32 -> Word32 -> Word32 -> CString -> IO Word32

foreign import capi "g3p_bcrypt_base64.h G3P_bcrypt_base64Encode"
  c_bcrypt_base64Encode
    :: Ptr Word8
    -> CString
    -> Word32
    -> IO ()

foreign import capi "g3p_bcrypt_base64.h G3P_bcrypt_base64Decode"
  c_bcrypt_base64Decode
    :: Ptr Word8
    -> CString
    -> Word32
    -> IO CInt

-- | Any key longer than 72 bytes will be truncated.

bcryptXs_maxKeyLength :: Int
bcryptXs_maxKeyLength :: Int
bcryptXs_maxKeyLength = (Int
72)
{-# LINE 212 "lib/Crypto/G3P/BCrypt/Subtle.hsc" #-}

-- | Any salt longer than 4168 bytes will be truncated.

bcryptXs_maxSaltLength :: Int
bcryptXs_maxSaltLength :: Int
bcryptXs_maxSaltLength = (Int
4168)
{-# LINE 217 "lib/Crypto/G3P/BCrypt/Subtle.hsc" #-}

-- | returns 4168 bytes
bcryptXsCtr_outputLength :: Int
bcryptXsCtr_outputLength :: Int
bcryptXsCtr_outputLength = (Int
4168)
{-# LINE 221 "lib/Crypto/G3P/BCrypt/Subtle.hsc" #-}

-- | bcrypt with an excessive amount of freedom. As such, this function
--   is trivially insecure, but it can still be used to implement secure
--   password hashing functions, including standard bcrypt and the very
--   lightly generalized bcryptRaw.
--
--   This was the starting point for 'bcryptXsCtrSuperRound' and 'bcryptXsFree'

bcryptXs :: BCryptXs -> ByteString
bcryptXs :: BCryptXs -> ByteString
bcryptXs BCryptXs
x = if ByteString -> Bool
B.null ByteString
sZ then ByteString
"" else IO ByteString -> ByteString
forall a. IO a -> a
unsafePerformIO (IO ByteString -> ByteString) -> IO ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ do
  ByteString -> (CString -> IO ByteString) -> IO ByteString
forall a. ByteString -> (CString -> IO a) -> IO a
myUseAsCString ByteString
k0 ((CString -> IO ByteString) -> IO ByteString)
-> (CString -> IO ByteString) -> IO ByteString
forall a b. (a -> b) -> a -> b
$ \CString
k0' -> do
    ByteString -> (CString -> IO ByteString) -> IO ByteString
forall a. ByteString -> (CString -> IO a) -> IO a
myUseAsCString ByteString
s0 ((CString -> IO ByteString) -> IO ByteString)
-> (CString -> IO ByteString) -> IO ByteString
forall a b. (a -> b) -> a -> b
$ \CString
s0' -> do
      ByteString -> (CString -> IO ByteString) -> IO ByteString
forall a. ByteString -> (CString -> IO a) -> IO a
myUseAsCString ByteString
kL ((CString -> IO ByteString) -> IO ByteString)
-> (CString -> IO ByteString) -> IO ByteString
forall a b. (a -> b) -> a -> b
$ \CString
kL' -> do
        ByteString -> (CString -> IO ByteString) -> IO ByteString
forall a. ByteString -> (CString -> IO a) -> IO a
myUseAsCString ByteString
sL ((CString -> IO ByteString) -> IO ByteString)
-> (CString -> IO ByteString) -> IO ByteString
forall a b. (a -> b) -> a -> b
$ \CString
sL' -> do
          ByteString -> (CString -> IO ByteString) -> IO ByteString
forall a. ByteString -> (CString -> IO a) -> IO a
myUseAsCString ByteString
kR ((CString -> IO ByteString) -> IO ByteString)
-> (CString -> IO ByteString) -> IO ByteString
forall a b. (a -> b) -> a -> b
$ \CString
kR' -> do
            ByteString -> (CString -> IO ByteString) -> IO ByteString
forall a. ByteString -> (CString -> IO a) -> IO a
myUseAsCString ByteString
sR ((CString -> IO ByteString) -> IO ByteString)
-> (CString -> IO ByteString) -> IO ByteString
forall a b. (a -> b) -> a -> b
$ \CString
sR' -> do
              ByteString -> (CString -> IO ByteString) -> IO ByteString
forall a. ByteString -> (CString -> IO a) -> IO a
myUseAsCString ByteString
sZ ((CString -> IO ByteString) -> IO ByteString)
-> (CString -> IO ByteString) -> IO ByteString
forall a b. (a -> b) -> a -> b
$ \CString
sZ' -> do
                Int -> (Ptr Word8 -> IO ()) -> IO ByteString
B.create (ByteString -> Int
B.length ByteString
sZ) ((Ptr Word8 -> IO ()) -> IO ByteString)
-> (Ptr Word8 -> IO ()) -> IO ByteString
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
out' -> do
                    (CString
-> Word16
-> CString
-> Word16
-> CString
-> Word16
-> CString
-> Word16
-> CString
-> Word16
-> CString
-> Word16
-> CString
-> Word32
-> Word32
-> Bool
-> Ptr Word8
-> IO ()
c_bcrypt_xs
                        CString
k0' (ByteString -> Word16
len16 ByteString
k0) CString
s0' (ByteString -> Word16
len16 ByteString
s0)
                        CString
kL' (ByteString -> Word16
len16 ByteString
kL) CString
sL' (ByteString -> Word16
len16 ByteString
sL)
                        CString
kR' (ByteString -> Word16
len16 ByteString
kR) CString
sR' (ByteString -> Word16
len16 ByteString
sR)
                        CString
sZ' (ByteString -> Word32
len32 ByteString
sZ) Word32
rounds Bool
implicitNull Ptr Word8
out')
  where
    k0 :: ByteString
k0 = BCryptXs -> ByteString
bcryptXs_key0 BCryptXs
x
    s0 :: ByteString
s0 = BCryptXs -> ByteString
bcryptXs_salt0 BCryptXs
x
    kL :: ByteString
kL = BCryptXs -> ByteString
bcryptXs_keyL BCryptXs
x
    sL :: ByteString
sL = BCryptXs -> ByteString
bcryptXs_saltL BCryptXs
x
    kR :: ByteString
kR = BCryptXs -> ByteString
bcryptXs_keyR BCryptXs
x
    sR :: ByteString
sR = BCryptXs -> ByteString
bcryptXs_saltR BCryptXs
x
    sZ :: ByteString
sZ = BCryptXs -> ByteString
bcryptXs_saltZ BCryptXs
x
    rounds :: Word32
rounds = BCryptXs -> Word32
bcryptXs_rounds BCryptXs
x
    implicitNull :: Bool
implicitNull = BCryptXs -> Bool
bcryptXs_implicitNull BCryptXs
x

-- | Likely at least somewhat less subtle than the one above, thanks to the addition of a counter.

bcryptXsCtrSuperRound :: BCryptXsCtr -> Word32 -> Word32 -> Word32 -> Maybe BCryptState -> (Word32, BCryptState)
bcryptXsCtrSuperRound :: BCryptXsCtr
-> Word32
-> Word32
-> Word32
-> Maybe BCryptState
-> (Word32, BCryptState)
bcryptXsCtrSuperRound BCryptXsCtr
x Word32
tagPos Word32
rounds Word32
ctr Maybe BCryptState
mst = IO (Word32, BCryptState) -> (Word32, BCryptState)
forall a. IO a -> a
unsafePerformIO (IO (Word32, BCryptState) -> (Word32, BCryptState))
-> IO (Word32, BCryptState) -> (Word32, BCryptState)
forall a b. (a -> b) -> a -> b
$ do
  ByteString
-> (CString -> IO (Word32, BCryptState))
-> IO (Word32, BCryptState)
forall a. ByteString -> (CString -> IO a) -> IO a
myUseAsCString ByteString
k0 ((CString -> IO (Word32, BCryptState)) -> IO (Word32, BCryptState))
-> (CString -> IO (Word32, BCryptState))
-> IO (Word32, BCryptState)
forall a b. (a -> b) -> a -> b
$ \CString
k0' -> do
    ByteString
-> (CString -> IO (Word32, BCryptState))
-> IO (Word32, BCryptState)
forall a. ByteString -> (CString -> IO a) -> IO a
myUseAsCString ByteString
k1 ((CString -> IO (Word32, BCryptState)) -> IO (Word32, BCryptState))
-> (CString -> IO (Word32, BCryptState))
-> IO (Word32, BCryptState)
forall a b. (a -> b) -> a -> b
$ \CString
k1' -> do
      ByteString
-> (CString -> IO (Word32, BCryptState))
-> IO (Word32, BCryptState)
forall a. ByteString -> (CString -> IO a) -> IO a
myUseAsCString ByteString
tt ((CString -> IO (Word32, BCryptState)) -> IO (Word32, BCryptState))
-> (CString -> IO (Word32, BCryptState))
-> IO (Word32, BCryptState)
forall a b. (a -> b) -> a -> b
$ \CString
tt' -> do
        ByteString
-> (CString -> IO (Word32, BCryptState))
-> IO (Word32, BCryptState)
forall a. ByteString -> (CString -> IO a) -> IO a
myUseAsCString ByteString
nn ((CString -> IO (Word32, BCryptState)) -> IO (Word32, BCryptState))
-> (CString -> IO (Word32, BCryptState))
-> IO (Word32, BCryptState)
forall a b. (a -> b) -> a -> b
$ \CString
nn' -> do
          ByteString
-> (CString -> IO (Word32, BCryptState))
-> IO (Word32, BCryptState)
forall a. ByteString -> (CString -> IO a) -> IO a
myUseAsCString ByteString
st ((CString -> IO (Word32, BCryptState)) -> IO (Word32, BCryptState))
-> (CString -> IO (Word32, BCryptState))
-> IO (Word32, BCryptState)
forall a b. (a -> b) -> a -> b
$ \CString
st' -> do
            ForeignPtr Word8
outPtr <- Int -> IO (ForeignPtr Word8)
forall a. Int -> IO (ForeignPtr a)
B.mallocByteString Int
bcryptXsCtr_outputLength
            let out :: ByteString
out = ForeignPtr Word8 -> Int -> ByteString
B.BS ForeignPtr Word8
outPtr Int
bcryptXsCtr_outputLength
            ByteString
-> (CString -> IO (Word32, BCryptState))
-> IO (Word32, BCryptState)
forall a. ByteString -> (CString -> IO a) -> IO a
myUseAsCString ByteString
out ((CString -> IO (Word32, BCryptState)) -> IO (Word32, BCryptState))
-> (CString -> IO (Word32, BCryptState))
-> IO (Word32, BCryptState)
forall a b. (a -> b) -> a -> b
$ \CString
out' -> do
                Word32
tagPos' <- CString
-> CString
-> Word32
-> CString
-> Word32
-> CString
-> Word32
-> CString
-> Word32
-> Word32
-> Word32
-> Word32
-> CString
-> IO Word32
c_bcrypt_xs_ctr_superround
                              CString
st'
                              CString
k0' (ByteString -> Word32
len32 ByteString
k0) CString
k1' (ByteString -> Word32
len32 ByteString
k1)
                              CString
nn' (ByteString -> Word32
len32 ByteString
nn) CString
tt' (ByteString -> Word32
len32 ByteString
tt)
                              Word32
tagPos Word32
rounds Word32
ctr CString
out'
                (Word32, BCryptState) -> IO (Word32, BCryptState)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Word32
tagPos',ByteString -> BCryptState
BCryptState ByteString
out)
  where
    k0 :: ByteString
k0 = BCryptXsCtr -> ByteString
bcryptXsCtr_key0 BCryptXsCtr
x
    k1 :: ByteString
k1 = BCryptXsCtr -> ByteString
bcryptXsCtr_key1 BCryptXsCtr
x
    tt :: ByteString
tt = BCryptXsCtr -> ByteString
bcryptXsCtr_tag BCryptXsCtr
x
    nn :: ByteString
nn = BCryptXsCtr -> ByteString
bcryptXsCtr_name BCryptXsCtr
x
    st :: ByteString
st = ByteString
-> (BCryptState -> ByteString) -> Maybe BCryptState -> ByteString
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ByteString
"" BCryptState -> ByteString
bcryptState_toByteString Maybe BCryptState
mst

maxLen16 :: Int
maxLen16 :: Int
maxLen16 = Word16 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word16
forall a. Bounded a => a
maxBound :: Word16)

len16 :: ByteString -> Word16
len16 :: ByteString -> Word16
len16 ByteString
x = Int -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Int -> Int
forall a. Ord a => a -> a -> a
min Int
maxLen16 (ByteString -> Int
B.length ByteString
x))


maxWord32 :: Int64
maxWord32 :: Int64
maxWord32 = Word32 -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32
forall a. Bounded a => a
maxBound :: Word32)

maxInt :: Int64
maxInt :: Int64
maxInt = Int -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int
forall a. Bounded a => a
maxBound :: Int)

maxLen32 :: Int
maxLen32 :: Int
maxLen32 = Int64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int64 -> Int64 -> Int64
forall a. Ord a => a -> a -> a
min Int64
maxWord32 Int64
maxInt)

len32 :: ByteString -> Word32
len32 :: ByteString -> Word32
len32 ByteString
x = Int -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Int -> Int
forall a. Ord a => a -> a -> a
min Int
maxLen32 (ByteString -> Int
B.length ByteString
x))

newtype BCryptState = BCryptState { BCryptState -> ByteString
bcryptState_toByteString :: ByteString } deriving (BCryptState -> BCryptState -> Bool
(BCryptState -> BCryptState -> Bool)
-> (BCryptState -> BCryptState -> Bool) -> Eq BCryptState
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: BCryptState -> BCryptState -> Bool
== :: BCryptState -> BCryptState -> Bool
$c/= :: BCryptState -> BCryptState -> Bool
/= :: BCryptState -> BCryptState -> Bool
Eq, Eq BCryptState
Eq BCryptState =>
(BCryptState -> BCryptState -> Ordering)
-> (BCryptState -> BCryptState -> Bool)
-> (BCryptState -> BCryptState -> Bool)
-> (BCryptState -> BCryptState -> Bool)
-> (BCryptState -> BCryptState -> Bool)
-> (BCryptState -> BCryptState -> BCryptState)
-> (BCryptState -> BCryptState -> BCryptState)
-> Ord BCryptState
BCryptState -> BCryptState -> Bool
BCryptState -> BCryptState -> Ordering
BCryptState -> BCryptState -> BCryptState
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: BCryptState -> BCryptState -> Ordering
compare :: BCryptState -> BCryptState -> Ordering
$c< :: BCryptState -> BCryptState -> Bool
< :: BCryptState -> BCryptState -> Bool
$c<= :: BCryptState -> BCryptState -> Bool
<= :: BCryptState -> BCryptState -> Bool
$c> :: BCryptState -> BCryptState -> Bool
> :: BCryptState -> BCryptState -> Bool
$c>= :: BCryptState -> BCryptState -> Bool
>= :: BCryptState -> BCryptState -> Bool
$cmax :: BCryptState -> BCryptState -> BCryptState
max :: BCryptState -> BCryptState -> BCryptState
$cmin :: BCryptState -> BCryptState -> BCryptState
min :: BCryptState -> BCryptState -> BCryptState
Ord, Int -> BCryptState -> ShowS
[BCryptState] -> ShowS
BCryptState -> String
(Int -> BCryptState -> ShowS)
-> (BCryptState -> String)
-> ([BCryptState] -> ShowS)
-> Show BCryptState
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> BCryptState -> ShowS
showsPrec :: Int -> BCryptState -> ShowS
$cshow :: BCryptState -> String
show :: BCryptState -> String
$cshowList :: [BCryptState] -> ShowS
showList :: [BCryptState] -> ShowS
Show)

-- | Given the length of some binary blob of data, how long will the base64 encoded
--   version be, without padding?

-- There's probably a "cleaner" way to compute this with bit tricks
base64EncodeLength :: Int -> Int
base64EncodeLength :: Int -> Int
base64EncodeLength Int
n =
    Int
4 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
q Int -> Int -> Int
forall a. Num a => a -> a -> a
+ if Int
r Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 then Int
0 else Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
r
  where
    (Int
q,Int
r) = Int
n Int -> Int -> (Int, Int)
forall a. Integral a => a -> a -> (a, a)
`divMod` Int
3

-- | Given the length of some base64 encoded data, how long will the binar blob be?
--   The input length must not include any padding, commonly appearing as one or
--   two @=@ characters at the end of a string.

-- There's probably a "cleaner" way to compute this with bit tricks
base64DecodeLength :: Int -> Maybe Int
base64DecodeLength :: Int -> Maybe Int
base64DecodeLength Int
n
    | Int
r Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 = Int -> Maybe Int
forall a. a -> Maybe a
Just (Int
3 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
q)
    | Int
r Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1 = Maybe Int
forall a. Maybe a
Nothing
    | Bool
otherwise = Int -> Maybe Int
forall a. a -> Maybe a
Just ((Int
3 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
q) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ (Int
r Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1))
  where
    (Int
q,Int
r) = Int
n Int -> Int -> (Int, Int)
forall a. Integral a => a -> a -> (a, a)
`divMod` Int
4

base64Decode :: ByteString -> Maybe ByteString
base64Decode :: ByteString -> Maybe ByteString
base64Decode ByteString
input =
  case Int -> Maybe Int
base64DecodeLength Int
inLen of
    Maybe Int
Nothing -> Maybe ByteString
forall a. Maybe a
Nothing
    Just Int
outLen ->
      IO (Maybe ByteString) -> Maybe ByteString
forall a. IO a -> a
unsafePerformIO (IO (Maybe ByteString) -> Maybe ByteString)
-> IO (Maybe ByteString) -> Maybe ByteString
forall a b. (a -> b) -> a -> b
$ do
        ByteString
-> (CString -> IO (Maybe ByteString)) -> IO (Maybe ByteString)
forall a. ByteString -> (CString -> IO a) -> IO a
myUseAsCString ByteString
input ((CString -> IO (Maybe ByteString)) -> IO (Maybe ByteString))
-> (CString -> IO (Maybe ByteString)) -> IO (Maybe ByteString)
forall a b. (a -> b) -> a -> b
$ \CString
inPtr -> do
          ForeignPtr Word8
out <- Int -> IO (ForeignPtr Word8)
forall a. Int -> IO (ForeignPtr a)
B.mallocByteString Int
outLen
          CInt
err <- ForeignPtr Word8 -> (Ptr Word8 -> IO CInt) -> IO CInt
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Word8
out ((Ptr Word8 -> IO CInt) -> IO CInt)
-> (Ptr Word8 -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
outPtr -> do
            Ptr Word8 -> CString -> Word32 -> IO CInt
c_bcrypt_base64Decode Ptr Word8
outPtr CString
inPtr (Int -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
inLen)
          if CInt
err CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== CInt
0
          then Maybe ByteString -> IO (Maybe ByteString)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe ByteString -> IO (Maybe ByteString))
-> Maybe ByteString -> IO (Maybe ByteString)
forall a b. (a -> b) -> a -> b
$! ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just (ByteString -> Maybe ByteString) -> ByteString -> Maybe ByteString
forall a b. (a -> b) -> a -> b
$! ForeignPtr Word8 -> Int -> ByteString
B.BS ForeignPtr Word8
out Int
outLen
          else Maybe ByteString -> IO (Maybe ByteString)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe ByteString
forall a. Maybe a
Nothing
  where
    inLen :: Int
inLen = ByteString -> Int
B.length ByteString
input

base64Encode :: ByteString -> ByteString
base64Encode :: ByteString -> ByteString
base64Encode ByteString
input =
  Int -> (Ptr Word8 -> IO ()) -> ByteString
B.unsafeCreate Int
outLen ((Ptr Word8 -> IO ()) -> ByteString)
-> (Ptr Word8 -> IO ()) -> ByteString
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
outPtr -> do
    ByteString -> (CString -> IO ()) -> IO ()
forall a. ByteString -> (CString -> IO a) -> IO a
myUseAsCString ByteString
input ((CString -> IO ()) -> IO ()) -> (CString -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \CString
inPtr -> do
      Ptr Word8 -> CString -> Word32 -> IO ()
c_bcrypt_base64Encode Ptr Word8
outPtr CString
inPtr (Int -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
inLen)
  where
    inLen :: Int
inLen = ByteString -> Int
B.length ByteString
input
    outLen :: Int
outLen = Int -> Int
base64EncodeLength Int
inLen

bcryptRaw_genInputs :: ByteString -> ByteString -> Word32 -> BCryptXs
bcryptRaw_genInputs :: ByteString -> ByteString -> Word32 -> BCryptXs
bcryptRaw_genInputs (ByteString -> ByteString
truncateKey -> ByteString
key) (ByteString -> ByteString
truncateKey -> ByteString
salt) Word32
rounds =
    BCryptXs
    { bcryptXs_key0 :: ByteString
bcryptXs_key0 = ByteString
key
    , bcryptXs_salt0 :: ByteString
bcryptXs_salt0 = ByteString
salt
    , bcryptXs_keyL :: ByteString
bcryptXs_keyL = ByteString
key
    , bcryptXs_saltL :: ByteString
bcryptXs_saltL = ByteString
B.empty
    , bcryptXs_keyR :: ByteString
bcryptXs_keyR = ByteString
salt
    , bcryptXs_saltR :: ByteString
bcryptXs_saltR = ByteString
B.empty
    , bcryptXs_saltZ :: ByteString
bcryptXs_saltZ = ByteString
bcryptRaw_outputSalt
    , bcryptXs_rounds :: Word32
bcryptXs_rounds = Word32
rounds
    , bcryptXs_implicitNull :: Bool
bcryptXs_implicitNull = Bool
True
    }

truncateKey :: ByteString -> ByteString
truncateKey :: ByteString -> ByteString
truncateKey = Int -> ByteString -> ByteString
B.take Int
bcryptXs_maxKeyLength