    -- |
    -- Module      : Crypto.Cipher.Types.GF
    -- License     : BSD-style
    -- Maintainer  : Vincent Hanquez <vincent@snarc.org>
    -- Stability   : Stable
    -- Portability : Excellent
    --
    -- Slow Galois Field arithmetic for generic XTS and GCM implementation
    module Crypto.Cipher.Types.GF (
        -- * XTS support
        xtsGFMul,
    ) where

    import Crypto.Internal.ByteArray (ByteArray, withByteArray)
    import qualified Crypto.Internal.ByteArray as B
    import Crypto.Internal.Imports
    import Data.Bits
    import Foreign.Ptr
    import Foreign.Storable

    -- | Compute the gfmul with the XTS polynomial
    --
    -- block size need to be 128 bits.
    --
    -- FIXME: add support for big endian.
    xtsGFMul :: ByteArray ba => ba -> ba
    xtsGFMul :: forall ba. ByteArray ba => ba -> ba
    xtsGFMul ba
    b
        | Int
    len Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    == Int
    16 =
            Int -> (Ptr (ZonkAny 0) -> IO ()) -> ba
    forall a p. ByteArray a => Int -> (Ptr p -> IO ()) -> a
    B.allocAndFreeze Int
    len ((Ptr (ZonkAny 0) -> IO ()) -> ba)
    -> (Ptr (ZonkAny 0) -> IO ()) -> ba
    forall a b. (a -> b) -> a -> b
    $ \Ptr (ZonkAny 0)
    dst ->
                ba -> (Ptr (ZonkAny 1) -> 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
    withByteArray ba
    b ((Ptr (ZonkAny 1) -> IO ()) -> IO ())
    -> (Ptr (ZonkAny 1) -> IO ()) -> IO ()
    forall a b. (a -> b) -> a -> b
    $ \Ptr (ZonkAny 1)
    src -> do
                    (hi, lo) <- Word64 -> Word64 -> (Word64, Word64)
    gf (Word64 -> Word64 -> (Word64, Word64))
    -> IO Word64 -> IO (Word64 -> (Word64, Word64))
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Ptr Word64 -> IO Word64
    forall a. Storable a => Ptr a -> IO a
    peek (Ptr (ZonkAny 1) -> Ptr Word64
    forall a b. Ptr a -> Ptr b
    castPtr Ptr (ZonkAny 1)
    src) IO (Word64 -> (Word64, Word64)) -> IO Word64 -> IO (Word64, Word64)
    forall a b. IO (a -> b) -> IO a -> IO b
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> Ptr Word64 -> IO Word64
    forall a. Storable a => Ptr a -> IO a
    peek (Ptr (ZonkAny 1) -> Ptr (ZonkAny 2)
    forall a b. Ptr a -> Ptr b
    castPtr Ptr (ZonkAny 1)
    src Ptr (ZonkAny 2) -> Int -> Ptr Word64
    forall a b. Ptr a -> Int -> Ptr b
    `plusPtr` Int
    8)
                    poke (castPtr dst) lo
                    poke (castPtr dst `plusPtr` 8) hi
        | Bool
    otherwise = [Char] -> ba
    forall a. HasCallStack => [Char] -> a
    error [Char]
    "unsupported block size in GF"
      where
        gf :: Word64 -> Word64 -> (Word64, Word64)
        gf :: Word64 -> Word64 -> (Word64, Word64)
    gf Word64
    srcLo Word64
    srcHi =
            ( (if Bool
    carryLo then (Word64 -> Word64 -> Word64
    forall a. Bits a => a -> a -> a
    .|. Word64
    1) else Word64 -> Word64
    forall a. a -> a
    id) (Word64
    srcHi Word64 -> Int -> Word64
    forall a. Bits a => a -> Int -> a
    `shiftL` Int
    1)
            , (if Bool
    carryHi then Word64 -> Word64 -> Word64
    forall a. Bits a => a -> a -> a
    xor Word64
    0x87 else Word64 -> Word64
    forall a. a -> a
    id) (Word64 -> Word64) -> Word64 -> Word64
    forall a b. (a -> b) -> a -> b
    $ (Word64
    srcLo Word64 -> Int -> Word64
    forall a. Bits a => a -> Int -> a
    `shiftL` Int
    1)
            )
          where
            carryHi :: Bool
    carryHi = Word64
    srcHi Word64 -> Int -> Bool
    forall a. Bits a => a -> Int -> Bool
    `testBit` Int
    63
            carryLo :: Bool
    carryLo = Word64
    srcLo Word64 -> Int -> Bool
    forall a. Bits a => a -> Int -> Bool
    `testBit` Int
    63
        len :: Int
    len = ba -> Int
    forall ba. ByteArrayAccess ba => ba -> Int
    B.length ba
    b

    {-
    	const uint64_t gf_mask = cpu_to_le64(0x8000000000000000ULL);
    	uint64_t r = ((a->q[1] & gf_mask) ? cpu_to_le64(0x87) : 0);
    	a->q[1] = cpu_to_le64((le64_to_cpu(a->q[1]) << 1) | (a->q[0] & gf_mask ? 1 : 0));
    	a->q[0] = cpu_to_le64(le64_to_cpu(a->q[0]) << 1) ^ r;
    -}