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

-- |  A very minimal binding to the core of the bcrypt algorithm, adapted from
--    OpenBSD's implementation. The Global Password Prehash Protocol version
--    G3Pb1 cannot be implemented in terms of standard bcrypt interfaces for
--    several reasons:
--
--    1.  Standard bcrypt hashes are truncated to 23 bytes.  The G3P depends
--        on all 24 output bytes.
--
--    2.  Standard bcrypt must specify a number of rounds that is a power of
--        two. The G3P allows any number of rounds between 1 and 2^32 inclusive.
--
--    3.  the G3P needs unimpeded access to the full 72 byte password input.
--        This is not doable with all bcrypt variants.
--
--    4.  Standard bcrypt limits salt length to 16 bytes.  The G3P depends on
--        72 byte salt parameters.
--
--    For this reason, this binding completely removes the code for handling
--    unix-style bcrypt hashes, which has repeatedly proven problematic. One
--    of the major design motifs of the G3P is to replace this cruft with PHKDF,
--    which is intended to be bulletproof.
--
--    Similarly, this binding cannot be directly used to process unix-style
--    bcrypt hashes, which does make testing a bit of a challenge.  However,
--    the core algorithm is unmodified, so implementing unix-style hash
--    handling in terms of this binding is very much possible.
--
--    This will be done in the test suite for this library.  Hopefully that
--    implementation will eventually migrate here, once it's production-ready,
--    so that this binding might also be used to handle standard bcrypt hashes
--    directly.

module Crypto.G3P.BCrypt
  ( bcryptRaw
  , bcryptRaw_maxInputLength
  , bcryptRaw_outputLength
  ) where



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

import           Foreign.C.String
import           System.IO.Unsafe

foreign import capi "bcrypt_raw.h bcrypt_raw" c_bcrypt_raw :: CString -> Word32 -> CString -> Word32 -> CString -> Word32 -> IO ()

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

bcryptRaw_maxInputLength :: Int
bcryptRaw_maxInputLength :: Int
bcryptRaw_maxInputLength = (Int
72)
{-# LINE 57 "lib/Crypto/G3P/BCrypt.hsc" #-}

-- | Any output hash from 'bcryptRaw' will be exactly 24 bytes long.

bcryptRaw_outputLength :: Int
bcryptRaw_outputLength :: Int
bcryptRaw_outputLength = (Int
24)
{-# LINE 62 "lib/Crypto/G3P/BCrypt.hsc" #-}

-- | @bcryptRaw key salt rounds@ Be aware that keys and salts that are longer
--   than 72 bytes do get truncated to exactly 72 bytes. This binding will
--   return a hash that is exactly 24 bytes long.
--
--   Note the rounds parameter is one less than the number of rounds to be
--   computed. Thus if you want something equivalent to the traditional bcrypt
--   cost parameter of 12, you need to specify 4095 rounds.  This is because
--   @2^12 - 1 = 4095@.

bcryptRaw :: ByteString -> ByteString -> Word32 -> ByteString
bcryptRaw :: ByteString -> ByteString -> Word32 -> ByteString
bcryptRaw (ByteString -> ByteString
f -> ByteString
key) (ByteString -> ByteString
f -> ByteString
salt) Word32
rounds
  = 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
B.unsafeUseAsCString ByteString
key ((CString -> IO ByteString) -> IO ByteString)
-> (CString -> IO ByteString) -> IO ByteString
forall a b. (a -> b) -> a -> b
$ \CString
keyPtr -> do
        ByteString -> (CString -> IO ByteString) -> IO ByteString
forall a. ByteString -> (CString -> IO a) -> IO a
B.unsafeUseAsCString ByteString
salt ((CString -> IO ByteString) -> IO ByteString)
-> (CString -> IO ByteString) -> IO ByteString
forall a b. (a -> b) -> a -> b
$ \CString
saltPtr -> do
          -- using a superfluous `seq` to try to ensure that this allocates a new
          -- unique bytestring.   FIXME: there's almost certainly a better, more
          -- proper, more idiomatic solution here
          let output :: ByteString
output = Int -> Word8 -> ByteString
B.replicate Int
bcryptRaw_outputLength (CString
saltPtr CString -> Word8 -> Word8
forall a b. a -> b -> b
`seq` Word8
0)
          ByteString -> (CString -> IO ByteString) -> IO ByteString
forall a. ByteString -> (CString -> IO a) -> IO a
B.unsafeUseAsCString ByteString
output ((CString -> IO ByteString) -> IO ByteString)
-> (CString -> IO ByteString) -> IO ByteString
forall a b. (a -> b) -> a -> b
$ \CString
outPtr -> do
            CString
-> Word32 -> CString -> Word32 -> CString -> Word32 -> IO ()
c_bcrypt_raw CString
keyPtr (ByteString -> Word32
forall {b}. Num b => ByteString -> b
len ByteString
key) CString
saltPtr (ByteString -> Word32
forall {b}. Num b => ByteString -> b
len ByteString
salt) CString
outPtr Word32
rounds
            ByteString -> IO ByteString
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ByteString
output
  where
    len :: ByteString -> b
len ByteString
x = Int -> b
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Int -> Int
forall a. Ord a => a -> a -> a
min Int
bcryptRaw_maxInputLength (ByteString -> Int
B.length ByteString
x))

f :: ByteString -> ByteString
f :: ByteString -> ByteString
f ByteString
key = if ByteString -> Bool
B.null ByteString
key then Int -> Word8 -> ByteString
B.replicate Int
bcryptRaw_maxInputLength Word8
0 else ByteString
key