-----------------------------------------------------------------------------
-- |
-- Module      :  Coded.Encryption.Blowfish
-- Copyright   :  (c) Dominic Steinitz 2003
-- License     :  BSD-style (see the file ReadMe.tex)
-- 
-- Stability   :  experimental
-- Portability :  non-portable
--
-- Takes the Blowfish module supplied by Doug Hoyte and wraps it so it can
-- used with the standard modes.
--
-----------------------------------------------------------------------------

module Codec.Encryption.Blowfish
   (
   -- * Function Types
   encrypt,
   decrypt
   ) where

import Data.Bits
import Data.Word
import Data.Char
import Codec.Utils
import Codec.Encryption.BlowfishAux

-- * Basic Blowfish Encryption

-- | Basic Blowfish encryption which takes a key and a block of plaintext 
-- and returns the encrypted block of ciphertext according to the standard.
-- Typical keys are Word8, Word16, Word32, Word64, Word128. See 
-- <http://www.counterpane.com/vectors.txt>.

encrypt :: (Integral a) => a -> Word64 -> Word64
encrypt :: forall a. Integral a => a -> Word64 -> Word64
encrypt a
k Word64
p = (Word32, Word32) -> Word64
mergeWord32 (Word32
lo,Word32
hi) where
   lo :: Word32
lo = forall a. [a] -> a
head [Word32]
e
   hi :: Word32
hi = forall a. [a] -> a
head forall a b. (a -> b) -> a -> b
$ forall a. [a] -> [a]
tail [Word32]
e
   e :: [Word32]
e = BF -> [Word32] -> [Word32]
bfEnc ([Char] -> BF
bfMakeKey (forall a b. (a -> b) -> [a] -> [b]
map (Int -> Char
chr forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Integral a, Num b) => a -> b
fromIntegral) (forall a b. (Integral a, Integral b) => a -> b -> [Octet]
toOctets Integer
256 a
k))) [Word32
lo',Word32
hi']
   (Word32
lo',Word32
hi') = (Word64 -> (Word32, Word32)
splitZord64 Word64
p)

-- | Basic Blowfish decryption which takes a key and a block of ciphertext
-- and returns the decrypted block of plaintext.

decrypt :: (Integral a) => a -> Word64 -> Word64
decrypt :: forall a. Integral a => a -> Word64 -> Word64
decrypt a
k Word64
p = (Word32, Word32) -> Word64
mergeWord32 (Word32
lo,Word32
hi) where
   lo :: Word32
lo = forall a. [a] -> a
head [Word32]
d
   hi :: Word32
hi = forall a. [a] -> a
head forall a b. (a -> b) -> a -> b
$ forall a. [a] -> [a]
tail [Word32]
d
   d :: [Word32]
d = BF -> [Word32] -> [Word32]
bfDec ([Char] -> BF
bfMakeKey (forall a b. (a -> b) -> [a] -> [b]
map (Int -> Char
chr forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Integral a, Num b) => a -> b
fromIntegral) (forall a b. (Integral a, Integral b) => a -> b -> [Octet]
toOctets Integer
256 a
k))) [Word32
lo',Word32
hi']
   (Word32
lo',Word32
hi') = Word64 -> (Word32, Word32)
splitZord64 Word64
p

splitZord64 :: Word64 -> (Word32,Word32)
splitZord64 :: Word64 -> (Word32, Word32)
splitZord64 Word64
x = (forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall a. Bits a => a -> Int -> a
shiftR (Word64
x forall a. Bits a => a -> a -> a
.&. Word64
0xffffffff00000000) Int
32),
                 forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64
x forall a. Bits a => a -> a -> a
.&. Word64
0x00000000ffffffff)) 

mergeWord32 :: (Word32,Word32) -> Word64
mergeWord32 :: (Word32, Word32) -> Word64
mergeWord32 (Word32
lo,Word32
hi) = forall a. Bits a => a -> Int -> a
shift (forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
lo) Int
32 forall a. Num a => a -> a -> a
+ forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
hi