{-# 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 #include "g3p_bcrypt.h" 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 = "OrpheanBeholderScryDoubt" bcrypt_outputSalt :: ByteString bcrypt_outputSalt = orpheanBeholderScryDoubt bcryptRaw_outputSalt :: ByteString bcryptRaw_outputSalt = 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 x f = if B.null x then f nullPtr else B.unsafeUseAsCString x f data BCryptXs = BCryptXs { bcryptXs_key0 :: !ByteString , bcryptXs_salt0 :: !ByteString , bcryptXs_keyL :: !ByteString , bcryptXs_saltL :: !ByteString , bcryptXs_keyR :: !ByteString , bcryptXs_saltR :: !ByteString , bcryptXs_saltZ :: !ByteString -- ^ not subject to maxSaltLength, but that doesn't seem overly relevant , bcryptXs_rounds :: !Word32 , bcryptXs_implicitNull :: !Bool } data BCryptXsCtr = BCryptXsCtr { bcryptXsCtr_key0 :: !ByteString , bcryptXsCtr_key1 :: !ByteString , bcryptXsCtr_tag :: !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 = (#const BCRYPT_XS_MAX_KEY_LENGTH) -- | Any salt longer than 4168 bytes will be truncated. bcryptXs_maxSaltLength :: Int bcryptXs_maxSaltLength = (#const BCRYPT_XS_MAX_SALT_LENGTH) -- | returns 4168 bytes bcryptXsCtr_outputLength :: Int bcryptXsCtr_outputLength = (#const G3P_BLF_CTX_LENGTH) -- | 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 x = if B.null sZ then "" else unsafePerformIO $ do myUseAsCString k0 $ \k0' -> do myUseAsCString s0 $ \s0' -> do myUseAsCString kL $ \kL' -> do myUseAsCString sL $ \sL' -> do myUseAsCString kR $ \kR' -> do myUseAsCString sR $ \sR' -> do myUseAsCString sZ $ \sZ' -> do B.create (B.length sZ) $ \out' -> do (c_bcrypt_xs k0' (len16 k0) s0' (len16 s0) kL' (len16 kL) sL' (len16 sL) kR' (len16 kR) sR' (len16 sR) sZ' (len32 sZ) rounds implicitNull out') where k0 = bcryptXs_key0 x s0 = bcryptXs_salt0 x kL = bcryptXs_keyL x sL = bcryptXs_saltL x kR = bcryptXs_keyR x sR = bcryptXs_saltR x sZ = bcryptXs_saltZ x rounds = bcryptXs_rounds x implicitNull = bcryptXs_implicitNull 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 x tagPos rounds ctr mst = unsafePerformIO $ do myUseAsCString k0 $ \k0' -> do myUseAsCString k1 $ \k1' -> do myUseAsCString tt $ \tt' -> do myUseAsCString nn $ \nn' -> do myUseAsCString st $ \st' -> do outPtr <- B.mallocByteString bcryptXsCtr_outputLength let out = B.BS outPtr bcryptXsCtr_outputLength myUseAsCString out $ \out' -> do tagPos' <- c_bcrypt_xs_ctr_superround st' k0' (len32 k0) k1' (len32 k1) nn' (len32 nn) tt' (len32 tt) tagPos rounds ctr out' return (tagPos',BCryptState out) where k0 = bcryptXsCtr_key0 x k1 = bcryptXsCtr_key1 x tt = bcryptXsCtr_tag x nn = bcryptXsCtr_name x st = maybe "" bcryptState_toByteString mst maxLen16 :: Int maxLen16 = fromIntegral (maxBound :: Word16) len16 :: ByteString -> Word16 len16 x = fromIntegral (min maxLen16 (B.length x)) maxWord32 :: Int64 maxWord32 = fromIntegral (maxBound :: Word32) maxInt :: Int64 maxInt = fromIntegral (maxBound :: Int) maxLen32 :: Int maxLen32 = fromIntegral (min maxWord32 maxInt) len32 :: ByteString -> Word32 len32 x = fromIntegral (min maxLen32 (B.length x)) newtype BCryptState = BCryptState { bcryptState_toByteString :: ByteString } deriving (Eq, Ord, 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 n = 4 * q + if r == 0 then 0 else 1 + r where (q,r) = n `divMod` 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 n | r == 0 = Just (3 * q) | r == 1 = Nothing | otherwise = Just ((3 * q) + (r - 1)) where (q,r) = n `divMod` 4 base64Decode :: ByteString -> Maybe ByteString base64Decode input = case base64DecodeLength inLen of Nothing -> Nothing Just outLen -> unsafePerformIO $ do myUseAsCString input $ \inPtr -> do out <- B.mallocByteString outLen err <- withForeignPtr out $ \outPtr -> do c_bcrypt_base64Decode outPtr inPtr (fromIntegral inLen) if err == 0 then return $! Just $! B.BS out outLen else return Nothing where inLen = B.length input base64Encode :: ByteString -> ByteString base64Encode input = B.unsafeCreate outLen $ \outPtr -> do myUseAsCString input $ \inPtr -> do c_bcrypt_base64Encode outPtr inPtr (fromIntegral inLen) where inLen = B.length input outLen = base64EncodeLength inLen bcryptRaw_genInputs :: ByteString -> ByteString -> Word32 -> BCryptXs bcryptRaw_genInputs (truncateKey -> key) (truncateKey -> salt) rounds = BCryptXs { bcryptXs_key0 = key , bcryptXs_salt0 = salt , bcryptXs_keyL = key , bcryptXs_saltL = B.empty , bcryptXs_keyR = salt , bcryptXs_saltR = B.empty , bcryptXs_saltZ = bcryptRaw_outputSalt , bcryptXs_rounds = rounds , bcryptXs_implicitNull = True } truncateKey :: ByteString -> ByteString truncateKey = B.take bcryptXs_maxKeyLength