-- |
-- Module      : Crypto.Cipher.Blowfish
-- License     : BSD-style
-- Maintainer  : Vincent Hanquez <vincent@snarc.org>
-- Stability   : stable
-- Portability : good
--
{-# LANGUAGE CPP #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
module Crypto.Cipher.Blowfish
    ( Blowfish
    , Blowfish64
    , Blowfish128
    , Blowfish256
    , Blowfish448
    ) where

import Crypto.Internal.Imports
import Crypto.Cipher.Types
import Crypto.Cipher.Blowfish.Primitive

-- | variable keyed blowfish state
newtype Blowfish = Blowfish Context
    deriving (Blowfish -> ()
(Blowfish -> ()) -> NFData Blowfish
forall a. (a -> ()) -> NFData a
rnf :: Blowfish -> ()
$crnf :: Blowfish -> ()
NFData)

-- | 64 bit keyed blowfish state
newtype Blowfish64 = Blowfish64 Context
    deriving (Blowfish64 -> ()
(Blowfish64 -> ()) -> NFData Blowfish64
forall a. (a -> ()) -> NFData a
rnf :: Blowfish64 -> ()
$crnf :: Blowfish64 -> ()
NFData)

-- | 128 bit keyed blowfish state
newtype Blowfish128 = Blowfish128 Context
    deriving (Blowfish128 -> ()
(Blowfish128 -> ()) -> NFData Blowfish128
forall a. (a -> ()) -> NFData a
rnf :: Blowfish128 -> ()
$crnf :: Blowfish128 -> ()
NFData)

-- | 256 bit keyed blowfish state
newtype Blowfish256 = Blowfish256 Context
    deriving (Blowfish256 -> ()
(Blowfish256 -> ()) -> NFData Blowfish256
forall a. (a -> ()) -> NFData a
rnf :: Blowfish256 -> ()
$crnf :: Blowfish256 -> ()
NFData)

-- | 448 bit keyed blowfish state
newtype Blowfish448 = Blowfish448 Context
    deriving (Blowfish448 -> ()
(Blowfish448 -> ()) -> NFData Blowfish448
forall a. (a -> ()) -> NFData a
rnf :: Blowfish448 -> ()
$crnf :: Blowfish448 -> ()
NFData)

instance Cipher Blowfish where
    cipherName :: Blowfish -> String
cipherName Blowfish
_    = String
"blowfish"
    cipherKeySize :: Blowfish -> KeySizeSpecifier
cipherKeySize Blowfish
_ = Int -> Int -> KeySizeSpecifier
KeySizeRange Int
6 Int
56
    cipherInit :: key -> CryptoFailable Blowfish
cipherInit key
k    = Context -> Blowfish
Blowfish (Context -> Blowfish)
-> CryptoFailable Context -> CryptoFailable Blowfish
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` key -> CryptoFailable Context
forall key. ByteArrayAccess key => key -> CryptoFailable Context
initBlowfish key
k

instance BlockCipher Blowfish where
    blockSize :: Blowfish -> Int
blockSize Blowfish
_ = Int
8
    ecbEncrypt :: Blowfish -> ba -> ba
ecbEncrypt (Blowfish Context
bf) = Context -> ba -> ba
forall ba. ByteArray ba => Context -> ba -> ba
encrypt Context
bf
    ecbDecrypt :: Blowfish -> ba -> ba
ecbDecrypt (Blowfish Context
bf) = Context -> ba -> ba
forall ba. ByteArray ba => Context -> ba -> ba
decrypt Context
bf

#define INSTANCE_CIPHER(CSTR, NAME, KEYSIZE) \
instance Cipher CSTR where \
    { cipherName _ = NAME \
    ; cipherKeySize _ = KeySizeFixed KEYSIZE \
    ; cipherInit k = CSTR `fmap` initBlowfish k \
    }; \
instance BlockCipher CSTR where \
    { blockSize _ = 8 \
    ; ecbEncrypt (CSTR bf) = encrypt bf \
    ; ecbDecrypt (CSTR bf) = decrypt bf \
    };

INSTANCE_CIPHER(Blowfish64, "blowfish64", 8)
INSTANCE_CIPHER(Blowfish128, "blowfish128", 16)
INSTANCE_CIPHER(Blowfish256, "blowfish256", 32)
INSTANCE_CIPHER(Blowfish448, "blowfish448", 56)