-- |
-- Module      : Crypto.Cipher.DES.Serialization
-- License     : BSD-style
-- Maintainer  : Vincent Hanquez <vincent@snarc.org>
-- Stability   : stable
-- Portability : good
--
-- basic routine to convert between W64 and bytestring for DES.
--
{-# LANGUAGE CPP #-}
module Crypto.Cipher.DES.Serialization
    ( toW64
    , toBS
    , blockify
    , unblockify
    ) where

import qualified Data.ByteString as B
import Crypto.Cipher.DES.Primitive (Block(..))

#ifdef ARCH_IS_LITTLE_ENDIAN
import Data.Word (Word64)
import Data.Byteable (withBytePtr)
import qualified Data.ByteString.Internal as B (inlinePerformIO, unsafeCreate)
import Foreign.Storable
import Foreign.Ptr (castPtr, plusPtr, Ptr)
import Data.Bits (shiftL, shiftR, (.|.), (.&.))
#else
import Data.Bits (shiftL, shiftR, (.|.))
#endif

#ifdef ARCH_IS_LITTLE_ENDIAN
-- | convert a 8 byte bytestring big endian to a host one
toW64 :: B.ByteString -> Block
toW64 :: ByteString -> Block
toW64 b :: ByteString
b = Word64 -> Block
Block (Word64 -> Block) -> Word64 -> Block
forall a b. (a -> b) -> a -> b
$ IO Word64 -> Word64
forall a. IO a -> a
B.inlinePerformIO (IO Word64 -> Word64) -> IO Word64 -> Word64
forall a b. (a -> b) -> a -> b
$ ByteString -> (Ptr Word8 -> IO Word64) -> IO Word64
forall a b. Byteable a => a -> (Ptr Word8 -> IO b) -> IO b
withBytePtr ByteString
b ((Ptr Word8 -> IO Word64) -> IO Word64)
-> (Ptr Word8 -> IO Word64) -> IO Word64
forall a b. (a -> b) -> a -> b
$ \ptr :: Ptr Word8
ptr -> (Word64 -> Word64
be64 (Word64 -> Word64) -> IO Word64 -> IO Word64
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` Ptr Word64 -> IO Word64
forall a. Storable a => Ptr a -> IO a
peek (Ptr Word8 -> Ptr Word64
forall a b. Ptr a -> Ptr b
castPtr Ptr Word8
ptr))

-- | convert a word64 to a bytestring in big endian format
toBS :: Block -> B.ByteString
toBS :: Block -> ByteString
toBS (Block w :: Word64
w) = Int -> (Ptr Word8 -> IO ()) -> ByteString
B.unsafeCreate 8 ((Ptr Word8 -> IO ()) -> ByteString)
-> (Ptr Word8 -> IO ()) -> ByteString
forall a b. (a -> b) -> a -> b
$ \ptr :: Ptr Word8
ptr -> Ptr Word64 -> Word64 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr Word8 -> Ptr Word64
forall a b. Ptr a -> Ptr b
castPtr Ptr Word8
ptr) (Word64 -> Word64
be64 Word64
w)

-- | Create a strict bytestring out of DES blocks
unblockify :: [Block] -> B.ByteString
unblockify :: [Block] -> ByteString
unblockify blocks :: [Block]
blocks = Int -> (Ptr Word8 -> IO ()) -> ByteString
B.unsafeCreate (Int
nbBlocks Int -> Int -> Int
forall a. Num a => a -> a -> a
* 8) ((Ptr Word8 -> IO ()) -> ByteString)
-> (Ptr Word8 -> IO ()) -> ByteString
forall a b. (a -> b) -> a -> b
$ \initPtr :: Ptr Word8
initPtr -> Ptr Word64 -> [Block] -> IO ()
pokeTo (Ptr Word8 -> Ptr Word64
forall a b. Ptr a -> Ptr b
castPtr Ptr Word8
initPtr) [Block]
blocks
  where nbBlocks :: Int
nbBlocks = [Block] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Block]
blocks
        pokeTo :: Ptr Word64 -> [Block] -> IO ()
        pokeTo :: Ptr Word64 -> [Block] -> IO ()
pokeTo _   []           = () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
        pokeTo ptr :: Ptr Word64
ptr (Block x :: Word64
x:xs :: [Block]
xs) = Ptr Word64 -> Word64 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr Word64
ptr (Word64 -> Word64
be64 Word64
x) IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Ptr Word64 -> [Block] -> IO ()
pokeTo (Ptr Word64
ptr Ptr Word64 -> Int -> Ptr Word64
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 8) [Block]
xs

be64 :: Word64 -> Word64
be64 :: Word64 -> Word64
be64 w :: Word64
w =
        (Word64
w Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`shiftR` 56)                  Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.|. (Word64
w Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`shiftL` 56)
    Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.|. ((Word64
w Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`shiftR` 40) Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.&. 0xff00)     Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.|. ((Word64
w Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.&. 0xff00) Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`shiftL` 40)
    Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.|. ((Word64
w Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`shiftR` 24) Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.&. 0xff0000)   Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.|. ((Word64
w Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.&. 0xff0000) Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`shiftL` 24)
    Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.|. ((Word64
w Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`shiftR` 8)  Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.&. 0xff000000) Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.|. ((Word64
w Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.&. 0xff000000) Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`shiftL` 8)
#else
-- | convert a 8 byte bytestring to a little endian word64
toW64 :: B.ByteString -> Block
toW64 bs = Block $ case B.unpack bs of
            [a,b,c,d,e,f,g,h] -> shl h 0  .|. shl g 8 .|. shl f 16 .|. shl e 24 .|.
                                 shl d 32 .|. shl c 40 .|. shl b 48 .|. shl a 56
            _                 -> 0
  where shl w n = fromIntegral w `shiftL` n

-- | convert a word64 to a bytestring in little endian format
toBS :: Block -> B.ByteString
toBS (Block b) = B.pack $ map (shr b) [56,48,40,32,24,16,8,0]
  where shr w n = fromIntegral (w `shiftR` n)

-- | Create a strict bytestring out of DES blocks
unblockify :: [Block] -> B.ByteString
unblockify = B.concat . map toBS
#endif

-- | create DES blocks from a strict bytestring
blockify :: B.ByteString -> [Block]
blockify :: ByteString -> [Block]
blockify s :: ByteString
s | ByteString -> Bool
B.null ByteString
s  = []
           | Bool
otherwise = let (s1 :: ByteString
s1,s2 :: ByteString
s2) = Int -> ByteString -> (ByteString, ByteString)
B.splitAt 8 ByteString
s
                          in ByteString -> Block
toW64 ByteString
s1Block -> [Block] -> [Block]
forall a. a -> [a] -> [a]
:ByteString -> [Block]
blockify ByteString
s2