-- Rewritten by Vincent Hanquez (c) 2015
--              Lars Petersen (c) 2018
--
-- Original code:
--      Crypto.Cipher.Blowfish.Primitive, copyright (c) 2012 Stijn van Drongelen
--      based on: BlowfishAux.hs (C) 2002 HardCore SoftWare, Doug Hoyte
--           (as found in Crypto-4.2.4)
{-# LANGUAGE BangPatterns #-}

-- |
-- Module      : Crypto.Cipher.Blowfish.Primitive
-- License     : BSD-style
-- Stability   : experimental
-- Portability : Good
--
-- The cipher itself is in C, as is the key setup bcrypt wraps around it:
-- what the schedule costs is the whole of what bcrypt is for, and in Haskell
-- it cost about twice what the usual implementations do.
module Crypto.Cipher.Blowfish.Primitive (
    Context,
    initBlowfish,
    encrypt,
    decrypt,
    bcryptHash,
    bcryptPbkdfHash,
) where

import Crypto.Error
import Crypto.Internal.ByteArray (ByteArray, ByteArrayAccess, ScrubbedBytes)
import qualified Crypto.Internal.ByteArray as B
import Crypto.Internal.Compat
import Crypto.Internal.Imports
import Foreign.C.Types (CInt (..))
import Foreign.Ptr (Ptr)

-- | The key schedule: the P array and the four S boxes, as the C keeps them.
newtype Context = Context ScrubbedBytes

instance NFData Context where
    rnf :: Context -> ()
rnf Context
a = Context
a Context -> () -> ()
forall a b. a -> b -> b
`seq` ()

-- | How many bytes of schedule the C wants: eighteen words and four boxes of
-- two hundred and fifty-six.
contextSize :: Int
contextSize :: Int
contextSize = (Int
18 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
4 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
256) Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
4

-- | Initialize a new Blowfish context from a key.
--
-- key needs to be between 0 and 448 bits.
initBlowfish :: ByteArrayAccess key => key -> CryptoFailable Context
initBlowfish :: forall key. ByteArrayAccess key => key -> CryptoFailable Context
initBlowfish key
key
    | key -> Int
forall ba. ByteArrayAccess ba => ba -> Int
B.length key
key Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> (Int
448 Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
8) = CryptoError -> CryptoFailable Context
forall a. CryptoError -> CryptoFailable a
CryptoFailed CryptoError
CryptoError_KeySizeInvalid
    | Bool
otherwise = Context -> CryptoFailable Context
forall a. a -> CryptoFailable a
CryptoPassed (Context -> CryptoFailable Context)
-> Context -> CryptoFailable Context
forall a b. (a -> b) -> a -> b
$
        IO Context -> Context
forall a. IO a -> a
unsafeDoIO (IO Context -> Context) -> IO Context -> Context
forall a b. (a -> b) -> a -> b
$
            (ScrubbedBytes -> Context) -> IO ScrubbedBytes -> IO Context
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ScrubbedBytes -> Context
Context (IO ScrubbedBytes -> IO Context) -> IO ScrubbedBytes -> IO Context
forall a b. (a -> b) -> a -> b
$
                Int -> (Ptr Word8 -> IO ()) -> IO ScrubbedBytes
forall ba p. ByteArray ba => Int -> (Ptr p -> IO ()) -> IO ba
B.alloc Int
contextSize ((Ptr Word8 -> IO ()) -> IO ScrubbedBytes)
-> (Ptr Word8 -> IO ()) -> IO ScrubbedBytes
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
ctx ->
                    key -> (Ptr Word8 -> IO ()) -> IO ()
forall ba p a. ByteArrayAccess ba => ba -> (Ptr p -> IO a) -> IO a
forall p a. key -> (Ptr p -> IO a) -> IO a
B.withByteArray key
key ((Ptr Word8 -> IO ()) -> IO ()) -> (Ptr Word8 -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
k ->
                        Ptr Word8 -> Ptr Word8 -> Word32 -> IO ()
c_blowfish_init Ptr Word8
ctx Ptr Word8
k (Int -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (key -> Int
forall ba. ByteArrayAccess ba => ba -> Int
B.length key
key))

-- | Encrypt blocks
--
-- Input need to be a multiple of 8 bytes
encrypt :: ByteArray ba => Context -> ba -> ba
encrypt :: forall ba. ByteArray ba => Context -> ba -> ba
encrypt = (Ptr Word8 -> Ptr Word8 -> Ptr Word8 -> Word32 -> IO ())
-> Context -> ba -> ba
forall ba.
ByteArray ba =>
(Ptr Word8 -> Ptr Word8 -> Ptr Word8 -> Word32 -> IO ())
-> Context -> ba -> ba
through Ptr Word8 -> Ptr Word8 -> Ptr Word8 -> Word32 -> IO ()
c_blowfish_encrypt

-- | Decrypt blocks
--
-- Input need to be a multiple of 8 bytes
decrypt :: ByteArray ba => Context -> ba -> ba
decrypt :: forall ba. ByteArray ba => Context -> ba -> ba
decrypt = (Ptr Word8 -> Ptr Word8 -> Ptr Word8 -> Word32 -> IO ())
-> Context -> ba -> ba
forall ba.
ByteArray ba =>
(Ptr Word8 -> Ptr Word8 -> Ptr Word8 -> Word32 -> IO ())
-> Context -> ba -> ba
through Ptr Word8 -> Ptr Word8 -> Ptr Word8 -> Word32 -> IO ()
c_blowfish_decrypt

through
    :: ByteArray ba
    => (Ptr Word8 -> Ptr Word8 -> Ptr Word8 -> Word32 -> IO ())
    -> Context
    -> ba
    -> ba
through :: forall ba.
ByteArray ba =>
(Ptr Word8 -> Ptr Word8 -> Ptr Word8 -> Word32 -> IO ())
-> Context -> ba -> ba
through Ptr Word8 -> Ptr Word8 -> Ptr Word8 -> Word32 -> IO ()
f (Context ScrubbedBytes
ctx) ba
input
    | Int
len Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` Int
8 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
0 =
        [Char] -> ba
forall a. HasCallStack => [Char] -> a
error [Char]
"Crypto.Cipher.Blowfish: input length must be a multiple of 8"
    | Bool
otherwise = IO ba -> ba
forall a. IO a -> a
unsafeDoIO (IO ba -> ba) -> IO ba -> ba
forall a b. (a -> b) -> a -> b
$
        Int -> (Ptr Word8 -> IO ()) -> IO ba
forall ba p. ByteArray ba => Int -> (Ptr p -> IO ()) -> IO ba
B.alloc Int
len ((Ptr Word8 -> IO ()) -> IO ba) -> (Ptr Word8 -> IO ()) -> IO ba
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
out ->
            ScrubbedBytes -> (Ptr Word8 -> IO ()) -> IO ()
forall ba p a. ByteArrayAccess ba => ba -> (Ptr p -> IO a) -> IO a
forall p a. ScrubbedBytes -> (Ptr p -> IO a) -> IO a
B.withByteArray ScrubbedBytes
ctx ((Ptr Word8 -> IO ()) -> IO ()) -> (Ptr Word8 -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
c ->
                ba -> (Ptr Word8 -> IO ()) -> IO ()
forall ba p a. ByteArrayAccess ba => ba -> (Ptr p -> IO a) -> IO a
forall p a. ba -> (Ptr p -> IO a) -> IO a
B.withByteArray ba
input ((Ptr Word8 -> IO ()) -> IO ()) -> (Ptr Word8 -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
i -> Ptr Word8 -> Ptr Word8 -> Ptr Word8 -> Word32 -> IO ()
f Ptr Word8
c Ptr Word8
out Ptr Word8
i (Int -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
len)
  where
    len :: Int
len = ba -> Int
forall ba. ByteArrayAccess ba => ba -> Int
B.length ba
input

-- | What bcrypt does with Blowfish: the key setup that costs what the cost
-- says, and then the sixty-four encryptions.  The answer is 24 bytes, of
-- which bcrypt keeps 23.
--
-- The salt has to be 16 bytes and the key 1 to 73, which is a password of at
-- most 72 with the zero byte the original implementation appends.  'Nothing'
-- means it was given something else.
bcryptHash
    :: (ByteArrayAccess salt, ByteArrayAccess key, ByteArray output)
    => Int
    -- ^ the cost, between 4 and 31
    -> salt
    -> key
    -> Maybe output
bcryptHash :: forall salt key output.
(ByteArrayAccess salt, ByteArrayAccess key, ByteArray output) =>
Int -> salt -> key -> Maybe output
bcryptHash Int
cost salt
salt key
key
    | Int
cost Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
4 Bool -> Bool -> Bool
|| Int
cost Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
31 = Maybe output
forall a. Maybe a
Nothing
    | salt -> Int
forall ba. ByteArrayAccess ba => ba -> Int
B.length salt
salt Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
16 = Maybe output
forall a. Maybe a
Nothing
    | key -> Int
forall ba. ByteArrayAccess ba => ba -> Int
B.length key
key Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
1 Bool -> Bool -> Bool
|| key -> Int
forall ba. ByteArrayAccess ba => ba -> Int
B.length key
key Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
73 = Maybe output
forall a. Maybe a
Nothing
    | Bool
otherwise = IO (Maybe output) -> Maybe output
forall a. IO a -> a
unsafeDoIO (IO (Maybe output) -> Maybe output)
-> IO (Maybe output) -> Maybe output
forall a b. (a -> b) -> a -> b
$ do
        (CInt
r, output
out) <- Int -> (Ptr Word8 -> IO CInt) -> IO (CInt, output)
forall ba p a. ByteArray ba => Int -> (Ptr p -> IO a) -> IO (a, ba)
forall p a. Int -> (Ptr p -> IO a) -> IO (a, output)
B.allocRet Int
24 ((Ptr Word8 -> IO CInt) -> IO (CInt, output))
-> (Ptr Word8 -> IO CInt) -> IO (CInt, output)
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
o ->
            salt -> (Ptr Word8 -> IO CInt) -> IO CInt
forall ba p a. ByteArrayAccess ba => ba -> (Ptr p -> IO a) -> IO a
forall p a. salt -> (Ptr p -> IO a) -> IO a
B.withByteArray salt
salt ((Ptr Word8 -> IO CInt) -> IO CInt)
-> (Ptr Word8 -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
s ->
                key -> (Ptr Word8 -> IO CInt) -> IO CInt
forall ba p a. ByteArrayAccess ba => ba -> (Ptr p -> IO a) -> IO a
forall p a. key -> (Ptr p -> IO a) -> IO a
B.withByteArray key
key ((Ptr Word8 -> IO CInt) -> IO CInt)
-> (Ptr Word8 -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
k ->
                    Ptr Word8 -> Word32 -> Ptr Word8 -> Ptr Word8 -> Word32 -> IO CInt
c_bcrypt Ptr Word8
o (Int -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
cost) Ptr Word8
s Ptr Word8
k (Int -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (key -> Int
forall ba. ByteArrayAccess ba => ba -> Int
B.length key
key))
        Maybe output -> IO (Maybe output)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe output -> IO (Maybe output))
-> Maybe output -> IO (Maybe output)
forall a b. (a -> b) -> a -> b
$ if CInt
r CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== CInt
0 then output -> Maybe output
forall a. a -> Maybe a
Just output
out else Maybe output
forall a. Maybe a
Nothing

foreign import ccall unsafe "crypton_blowfish_init"
    c_blowfish_init :: Ptr Word8 -> Ptr Word8 -> Word32 -> IO ()

foreign import ccall unsafe "crypton_blowfish_encrypt"
    c_blowfish_encrypt :: Ptr Word8 -> Ptr Word8 -> Ptr Word8 -> Word32 -> IO ()

foreign import ccall unsafe "crypton_blowfish_decrypt"
    c_blowfish_decrypt :: Ptr Word8 -> Ptr Word8 -> Ptr Word8 -> Word32 -> IO ()

-- the work is what the cost says, so this one may take a while: it is a safe
-- call, which lets the other capabilities carry on while it does
foreign import ccall safe "crypton_bcrypt"
    c_bcrypt :: Ptr Word8 -> Word32 -> Ptr Word8 -> Ptr Word8 -> Word32 -> IO CInt

-- | What bcrypt_pbkdf does with Blowfish: the same key setup sixty-four times
-- over, and then the four blocks of its own magic.  Writes 32 bytes where it
-- is pointed, which is what the caller of this one wants.
bcryptPbkdfHash
    :: (ByteArrayAccess pass, ByteArrayAccess salt)
    => pass
    -> salt
    -> Ptr Word8
    -> IO ()
bcryptPbkdfHash :: forall pass salt.
(ByteArrayAccess pass, ByteArrayAccess salt) =>
pass -> salt -> Ptr Word8 -> IO ()
bcryptPbkdfHash pass
pass salt
salt Ptr Word8
out =
    pass -> (Ptr Word8 -> IO ()) -> IO ()
forall ba p a. ByteArrayAccess ba => ba -> (Ptr p -> IO a) -> IO a
forall p a. pass -> (Ptr p -> IO a) -> IO a
B.withByteArray pass
pass ((Ptr Word8 -> IO ()) -> IO ()) -> (Ptr Word8 -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
p ->
        salt -> (Ptr Word8 -> IO ()) -> IO ()
forall ba p a. ByteArrayAccess ba => ba -> (Ptr p -> IO a) -> IO a
forall p a. salt -> (Ptr p -> IO a) -> IO a
B.withByteArray salt
salt ((Ptr Word8 -> IO ()) -> IO ()) -> (Ptr Word8 -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
s -> do
            CInt
_ <-
                Ptr Word8 -> Ptr Word8 -> Word32 -> Ptr Word8 -> Word32 -> IO CInt
c_bcrypt_pbkdf_hash
                    Ptr Word8
out
                    Ptr Word8
p
                    (Int -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (pass -> Int
forall ba. ByteArrayAccess ba => ba -> Int
B.length pass
pass))
                    Ptr Word8
s
                    (Int -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (salt -> Int
forall ba. ByteArrayAccess ba => ba -> Int
B.length salt
salt))
            () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

foreign import ccall safe "crypton_bcrypt_pbkdf_hash"
    c_bcrypt_pbkdf_hash
        :: Ptr Word8 -> Ptr Word8 -> Word32 -> Ptr Word8 -> Word32 -> IO CInt