{-# LANGUAGE CPP #-}
{-|
 Maintainer: Thomas.DuBuisson@gmail.com
 Stability: beta
 Portability: portable
-}
module Crypto.Modes (
        -- * Initialization Vector Type, Modifiers (for all ciphers, all modes that use IVs)
          dblIV
        -- * Authentication modes
        , cbcMac', cbcMac, cMac, cMac'
        , cMacStar, cMacStar'
        -- Combined modes (nothing here yet)
        -- , gmc
        -- , xts
        -- , ccm
        ) where

import qualified Data.ByteString as B
import qualified Data.ByteString.Lazy as L
import Data.Serialize
import qualified Data.Serialize.Put as SP
import qualified Data.Serialize.Get as SG
import Data.Bits (xor, shift, (.&.), (.|.), testBit, setBit, clearBit, Bits, complementBit)
import Data.Tagged
import Crypto.Classes (BlockCipher(..), for, blockSizeBytes, incIV, zeroIV, chunkFor, chunkFor')
import Crypto.Random
import Crypto.Util
import Crypto.CPoly
import Crypto.Types
import System.Entropy (getEntropy)
import Control.Monad (liftM, forM_)
import Data.List (genericDrop)
import Data.Word (Word8)
import Data.List (genericDrop,genericReplicate,genericLength)

#if MIN_VERSION_tagged(0,2,0)
import Data.Proxy
#endif

-- |Cipher block chaining message authentication
cbcMac' :: BlockCipher k => k -> B.ByteString -> B.ByteString
cbcMac' :: forall k. BlockCipher k => k -> ByteString -> ByteString
cbcMac' k
k ByteString
pt = IV k -> ByteString
forall a. Serialize a => a -> ByteString
encode (IV k -> ByteString) -> IV k -> ByteString
forall a b. (a -> b) -> a -> b
$ (ByteString, IV k) -> IV k
forall a b. (a, b) -> b
snd ((ByteString, IV k) -> IV k) -> (ByteString, IV k) -> IV k
forall a b. (a -> b) -> a -> b
$ k -> IV k -> ByteString -> (ByteString, IV k)
forall k.
BlockCipher k =>
k -> IV k -> ByteString -> (ByteString, IV k)
cbc k
k IV k
forall k. BlockCipher k => IV k
zeroIV ByteString
pt
{-# INLINEABLE cbcMac' #-}

-- |Cipher block chaining message authentication
cbcMac :: BlockCipher k => k -> L.ByteString -> L.ByteString
cbcMac :: forall k. BlockCipher k => k -> ByteString -> ByteString
cbcMac k
k ByteString
pt = [ByteString] -> ByteString
L.fromChunks [IV k -> ByteString
forall a. Serialize a => a -> ByteString
encode (IV k -> ByteString) -> IV k -> ByteString
forall a b. (a -> b) -> a -> b
$ (ByteString, IV k) -> IV k
forall a b. (a, b) -> b
snd ((ByteString, IV k) -> IV k) -> (ByteString, IV k) -> IV k
forall a b. (a -> b) -> a -> b
$ k -> IV k -> ByteString -> (ByteString, IV k)
forall k.
BlockCipher k =>
k -> IV k -> ByteString -> (ByteString, IV k)
cbcLazy k
k IV k
forall k. BlockCipher k => IV k
zeroIV ByteString
pt]
{-# INLINEABLE cbcMac #-}

-- |Generate cmac subkeys.
cMacSubk :: BlockCipher k => k -> (IV k, IV k)
cMacSubk :: forall k. BlockCipher k => k -> (IV k, IV k)
cMacSubk k
k = (IV k
k1, IV k
k2) (IV k, IV k) -> (IV k, IV k) -> (IV k, IV k)
forall a b. a -> b -> b
`seq` (IV k
k1, IV k
k2)
  where
       bSize :: Int
bSize = Tagged k Int
forall k. BlockCipher k => Tagged k Int
blockSizeBytes Tagged k Int -> k -> Int
forall a b. Tagged a b -> a -> b
`for` k
k
       k1 :: IV k
k1 = IV k -> IV k
forall k. BlockCipher k => IV k -> IV k
dblIV (IV k -> IV k) -> IV k -> IV k
forall a b. (a -> b) -> a -> b
$ ByteString -> IV k
forall k. ByteString -> IV k
IV (ByteString -> IV k) -> ByteString -> IV k
forall a b. (a -> b) -> a -> b
$ k -> ByteString -> ByteString
forall k. BlockCipher k => k -> ByteString -> ByteString
encryptBlock k
k (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ Int -> Word8 -> ByteString
B.replicate Int
bSize Word8
0
       k2 :: IV k
k2 = IV k -> IV k
forall k. BlockCipher k => IV k -> IV k
dblIV (IV k -> IV k) -> IV k -> IV k
forall a b. (a -> b) -> a -> b
$ IV k
k1

-- |Pad the string as required by the cmac algorithm. In theory this
--  should work at bit level but since the API works at byte level we
--  do the same
cMacPad :: ([Word8], Bool, Int) -> Maybe (Word8,([Word8], Bool, Int))
cMacPad :: ([Word8], Bool, Int) -> Maybe (Word8, ([Word8], Bool, Int))
cMacPad ([Word8]
_, Bool
_, Int
0) = Maybe (Word8, ([Word8], Bool, Int))
forall a. Maybe a
Nothing
cMacPad ([], Bool
False, Int
n) = (Word8, ([Word8], Bool, Int))
-> Maybe (Word8, ([Word8], Bool, Int))
forall a. a -> Maybe a
Just (Word8
0,([], Bool
False, Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1))
cMacPad ([], Bool
True, Int
n) = (Word8, ([Word8], Bool, Int))
-> Maybe (Word8, ([Word8], Bool, Int))
forall a. a -> Maybe a
Just (Word8
128,([], Bool
False, Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1))
cMacPad (Word8
x:[Word8]
xs, Bool
b, Int
n) =  (Word8, ([Word8], Bool, Int))
-> Maybe (Word8, ([Word8], Bool, Int))
forall a. a -> Maybe a
Just (Word8
x,([Word8]
xs, Bool
b, Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1))

-- |Obtain the cmac with the specified subkey for lazy bytestrings
cMacWithSubK :: BlockCipher k => k -> (IV k, IV k) -> L.ByteString -> L.ByteString
cMacWithSubK :: forall k.
BlockCipher k =>
k -> (IV k, IV k) -> ByteString -> ByteString
cMacWithSubK k
k (IV ByteString
k1, IV ByteString
k2) ByteString
l = [ByteString] -> ByteString
L.fromChunks ([ByteString] -> ByteString) -> [ByteString] -> ByteString
forall a b. (a -> b) -> a -> b
$ [[ByteString] -> ByteString -> ByteString
go (k -> ByteString -> [ByteString]
forall k. BlockCipher k => k -> ByteString -> [ByteString]
chunkFor k
k ByteString
t) (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ Int -> Word8 -> ByteString
B.replicate Int
bSize1 Word8
0]
  where
       bSize1 :: Int
bSize1 = Int -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
$ Tagged k Int
forall k. BlockCipher k => Tagged k Int
blockSizeBytes Tagged k Int -> k -> Int
forall a b. Tagged a b -> a -> b
`for` k
k
       bSize2 :: Int64
bSize2 = Int -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Int64) -> Int -> Int64
forall a b. (a -> b) -> a -> b
$ Tagged k Int
forall k. BlockCipher k => Tagged k Int
blockSizeBytes Tagged k Int -> k -> Int
forall a b. Tagged a b -> a -> b
`for` k
k
       (ByteString
t,ByteString
e) = Int64 -> ByteString -> (ByteString, ByteString)
L.splitAt (((ByteString -> Int64
L.length ByteString
lInt64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
-Int64
1)Int64 -> Int64 -> Int64
forall a. Integral a => a -> a -> a
`div` Int64
bSize2)Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
*Int64
bSize2) ByteString
l
       pe :: ByteString
pe =  (ByteString, Maybe ([Word8], Bool, Int)) -> ByteString
forall a b. (a, b) -> a
fst ((ByteString, Maybe ([Word8], Bool, Int)) -> ByteString)
-> (ByteString, Maybe ([Word8], Bool, Int)) -> ByteString
forall a b. (a -> b) -> a -> b
$ Int
-> (([Word8], Bool, Int) -> Maybe (Word8, ([Word8], Bool, Int)))
-> ([Word8], Bool, Int)
-> (ByteString, Maybe ([Word8], Bool, Int))
forall a.
Int -> (a -> Maybe (Word8, a)) -> a -> (ByteString, Maybe a)
B.unfoldrN (Int
bSize1) ([Word8], Bool, Int) -> Maybe (Word8, ([Word8], Bool, Int))
cMacPad (ByteString -> [Word8]
L.unpack ByteString
e,Bool
True,Int
bSize1)
       fe :: ByteString
fe | Int64
bSize2 Int64 -> Int64 -> Bool
forall a. Eq a => a -> a -> Bool
== ByteString -> Int64
L.length ByteString
e = ByteString -> ByteString -> ByteString
zwp' ByteString
k1 ByteString
pe
          | Bool
otherwise =  ByteString -> ByteString -> ByteString
zwp' ByteString
k2 ByteString
pe
       go :: [ByteString] -> ByteString -> ByteString
go [] ByteString
c = k -> ByteString -> ByteString
forall k. BlockCipher k => k -> ByteString -> ByteString
encryptBlock k
k (ByteString -> ByteString -> ByteString
zwp' ByteString
c ByteString
fe)
       go (ByteString
x:[ByteString]
xs) ByteString
c = [ByteString] -> ByteString -> ByteString
go [ByteString]
xs (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ k -> ByteString -> ByteString
forall k. BlockCipher k => k -> ByteString -> ByteString
encryptBlock k
k (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString -> ByteString
zwp' ByteString
c ByteString
x

-- |Obtain the cmac for lazy bytestrings
cMac :: BlockCipher k => k -> L.ByteString -> L.ByteString
cMac :: forall k. BlockCipher k => k -> ByteString -> ByteString
cMac k
k = k -> (IV k, IV k) -> ByteString -> ByteString
forall k.
BlockCipher k =>
k -> (IV k, IV k) -> ByteString -> ByteString
cMacWithSubK k
k (k -> (IV k, IV k)
forall k. BlockCipher k => k -> (IV k, IV k)
cMacSubk k
k)

-- |Obtain the cmac with the specified subkey for strict bytestrings
cMacWithSubK' :: BlockCipher k => k -> (IV k, IV k) -> B.ByteString -> B.ByteString
cMacWithSubK' :: forall k.
BlockCipher k =>
k -> (IV k, IV k) -> ByteString -> ByteString
cMacWithSubK' k
k (IV ByteString
k1, IV ByteString
k2) ByteString
b = [ByteString] -> ByteString -> ByteString
go (k -> ByteString -> [ByteString]
forall k. BlockCipher k => k -> ByteString -> [ByteString]
chunkFor' k
k ByteString
t) (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ Int -> Word8 -> ByteString
B.replicate Int
bSize1 Word8
0
  where
       bSize1 :: Int
bSize1 = Int -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
$ Tagged k Int
forall k. BlockCipher k => Tagged k Int
blockSizeBytes Tagged k Int -> k -> Int
forall a b. Tagged a b -> a -> b
`for` k
k
       bSize2 :: Int
bSize2 = Int -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
$ Tagged k Int
forall k. BlockCipher k => Tagged k Int
blockSizeBytes Tagged k Int -> k -> Int
forall a b. Tagged a b -> a -> b
`for` k
k
       (ByteString
t,ByteString
e) = Int -> ByteString -> (ByteString, ByteString)
B.splitAt (((ByteString -> Int
B.length ByteString
bInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1)Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
bSize2)Int -> Int -> Int
forall a. Num a => a -> a -> a
*Int
bSize2) ByteString
b
       pe :: ByteString
pe =  (ByteString, Maybe ([Word8], Bool, Int)) -> ByteString
forall a b. (a, b) -> a
fst ((ByteString, Maybe ([Word8], Bool, Int)) -> ByteString)
-> (ByteString, Maybe ([Word8], Bool, Int)) -> ByteString
forall a b. (a -> b) -> a -> b
$ Int
-> (([Word8], Bool, Int) -> Maybe (Word8, ([Word8], Bool, Int)))
-> ([Word8], Bool, Int)
-> (ByteString, Maybe ([Word8], Bool, Int))
forall a.
Int -> (a -> Maybe (Word8, a)) -> a -> (ByteString, Maybe a)
B.unfoldrN (Int
bSize1) ([Word8], Bool, Int) -> Maybe (Word8, ([Word8], Bool, Int))
cMacPad (ByteString -> [Word8]
B.unpack ByteString
e,Bool
True,Int
bSize1)
       fe :: ByteString
fe | Int
bSize2 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== ByteString -> Int
B.length ByteString
e = ByteString -> ByteString -> ByteString
zwp' ByteString
k1 ByteString
pe
          | Bool
otherwise =  ByteString -> ByteString -> ByteString
zwp' ByteString
k2 ByteString
pe
       go :: [ByteString] -> ByteString -> ByteString
go [] ByteString
c = k -> ByteString -> ByteString
forall k. BlockCipher k => k -> ByteString -> ByteString
encryptBlock k
k (ByteString -> ByteString -> ByteString
zwp' ByteString
c ByteString
fe)
       go (ByteString
x:[ByteString]
xs) ByteString
c = [ByteString] -> ByteString -> ByteString
go [ByteString]
xs (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ k -> ByteString -> ByteString
forall k. BlockCipher k => k -> ByteString -> ByteString
encryptBlock k
k (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString -> ByteString
zwp' ByteString
c ByteString
x

-- |Obtain the cmac for strict bytestrings
cMac' :: BlockCipher k => k -> B.ByteString -> B.ByteString
cMac' :: forall k. BlockCipher k => k -> ByteString -> ByteString
cMac' k
k = k -> (IV k, IV k) -> ByteString -> ByteString
forall k.
BlockCipher k =>
k -> (IV k, IV k) -> ByteString -> ByteString
cMacWithSubK' k
k (k -> (IV k, IV k)
forall k. BlockCipher k => k -> (IV k, IV k)
cMacSubk k
k)

cMacStar :: BlockCipher k => k -> [L.ByteString] -> L.ByteString
cMacStar :: forall k. BlockCipher k => k -> [ByteString] -> ByteString
cMacStar k
k [ByteString]
l = ByteString -> [ByteString] -> ByteString
go (ByteString -> ByteString
lcmac (Int64 -> Word8 -> ByteString
L.replicate Int64
bSize Word8
0)) [ByteString]
l
  where
        bSize :: Int64
bSize = Int -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Int64) -> Int -> Int64
forall a b. (a -> b) -> a -> b
$ Tagged k Int
forall k. BlockCipher k => Tagged k Int
blockSizeBytes Tagged k Int -> k -> Int
forall a b. Tagged a b -> a -> b
`for` k
k
        bSizeb :: Integer
bSizeb = Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Integer) -> Int -> Integer
forall a b. (a -> b) -> a -> b
$ Tagged k Int
forall k. BlockCipher k => Tagged k Int
blockSize Tagged k Int -> k -> Int
forall a b. Tagged a b -> a -> b
`for` k
k
        lcmac :: ByteString -> ByteString
lcmac = k -> (IV k, IV k) -> ByteString -> ByteString
forall k.
BlockCipher k =>
k -> (IV k, IV k) -> ByteString -> ByteString
cMacWithSubK k
k (k -> (IV k, IV k)
forall k. BlockCipher k => k -> (IV k, IV k)
cMacSubk k
k)
        go :: ByteString -> [ByteString] -> ByteString
go ByteString
s [] = ByteString
s
        go ByteString
s [ByteString
x] | (ByteString -> Int64
L.length ByteString
x) Int64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
>= Int64
bSize = ByteString -> ByteString
lcmac (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString -> ByteString
zwp ByteString
x (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ ((Int, [Word8]) -> Maybe (Word8, (Int, [Word8])))
-> (Int, [Word8]) -> ByteString
forall a. (a -> Maybe (Word8, a)) -> a -> ByteString
L.unfoldr (Int -> (Int, [Word8]) -> Maybe (Word8, (Int, [Word8]))
xorend (Int -> (Int, [Word8]) -> Maybe (Word8, (Int, [Word8])))
-> Int -> (Int, [Word8]) -> Maybe (Word8, (Int, [Word8]))
forall a b. (a -> b) -> a -> b
$ Int64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int64
bSize) (Int64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int64 -> Int) -> Int64 -> Int
forall a b. (a -> b) -> a -> b
$ ByteString -> Int64
L.length ByteString
x,ByteString -> [Word8]
L.unpack ByteString
s)
                 | Bool
otherwise = ByteString -> ByteString
lcmac (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString -> ByteString
zwp (ByteString -> ByteString
dblL ByteString
s) ((([Word8], Bool, Int) -> Maybe (Word8, ([Word8], Bool, Int)))
-> ([Word8], Bool, Int) -> ByteString
forall a. (a -> Maybe (Word8, a)) -> a -> ByteString
L.unfoldr ([Word8], Bool, Int) -> Maybe (Word8, ([Word8], Bool, Int))
cMacPad (ByteString -> [Word8]
L.unpack ByteString
x,Bool
True,Int64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int64
bSize))
        go ByteString
s (ByteString
x:[ByteString]
xs) = ByteString -> [ByteString] -> ByteString
go (ByteString -> ByteString -> ByteString
zwp (ByteString -> ByteString
dblL ByteString
s) (ByteString -> ByteString
lcmac ByteString
x)) [ByteString]
xs

-- |Obtain the CMAC* on strict bytestrings
cMacStar' :: BlockCipher k => k -> [B.ByteString] -> B.ByteString
cMacStar' :: forall k. BlockCipher k => k -> [ByteString] -> ByteString
cMacStar' k
k [ByteString]
s = ByteString -> [ByteString] -> ByteString
go (ByteString -> ByteString
lcmac (Int -> Word8 -> ByteString
B.replicate Int
bSize Word8
0)) [ByteString]
s
  where
       bSize :: Int
bSize = Int -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
$ Tagged k Int
forall k. BlockCipher k => Tagged k Int
blockSizeBytes Tagged k Int -> k -> Int
forall a b. Tagged a b -> a -> b
`for` k
k
       bSizeb :: Integer
bSizeb = Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Integer) -> Int -> Integer
forall a b. (a -> b) -> a -> b
$ Tagged k Int
forall k. BlockCipher k => Tagged k Int
blockSize Tagged k Int -> k -> Int
forall a b. Tagged a b -> a -> b
`for` k
k
       lcmac :: ByteString -> ByteString
lcmac = k -> (IV k, IV k) -> ByteString -> ByteString
forall k.
BlockCipher k =>
k -> (IV k, IV k) -> ByteString -> ByteString
cMacWithSubK' k
k (k -> (IV k, IV k)
forall k. BlockCipher k => k -> (IV k, IV k)
cMacSubk k
k)
       go :: ByteString -> [ByteString] -> ByteString
go ByteString
s [] = ByteString
s
       go ByteString
s [ByteString
x] | (ByteString -> Int
B.length ByteString
x) Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
bSize = ByteString -> ByteString
lcmac (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString -> ByteString
zwp' ByteString
x (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ (ByteString, Maybe (Int, [Word8])) -> ByteString
forall a b. (a, b) -> a
fst ((ByteString, Maybe (Int, [Word8])) -> ByteString)
-> (ByteString, Maybe (Int, [Word8])) -> ByteString
forall a b. (a -> b) -> a -> b
$ Int
-> ((Int, [Word8]) -> Maybe (Word8, (Int, [Word8])))
-> (Int, [Word8])
-> (ByteString, Maybe (Int, [Word8]))
forall a.
Int -> (a -> Maybe (Word8, a)) -> a -> (ByteString, Maybe a)
B.unfoldrN (ByteString -> Int
B.length ByteString
x) (Int -> (Int, [Word8]) -> Maybe (Word8, (Int, [Word8]))
xorend Int
bSize) (Int -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
$ ByteString -> Int
B.length ByteString
x,ByteString -> [Word8]
B.unpack ByteString
s)
                | Bool
otherwise = ByteString -> ByteString
lcmac (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString -> ByteString
zwp' (ByteString -> ByteString
dblB ByteString
s) ((ByteString, Maybe ([Word8], Bool, Int)) -> ByteString
forall a b. (a, b) -> a
fst ((ByteString, Maybe ([Word8], Bool, Int)) -> ByteString)
-> (ByteString, Maybe ([Word8], Bool, Int)) -> ByteString
forall a b. (a -> b) -> a -> b
$ Int
-> (([Word8], Bool, Int) -> Maybe (Word8, ([Word8], Bool, Int)))
-> ([Word8], Bool, Int)
-> (ByteString, Maybe ([Word8], Bool, Int))
forall a.
Int -> (a -> Maybe (Word8, a)) -> a -> (ByteString, Maybe a)
B.unfoldrN Int
bSize ([Word8], Bool, Int) -> Maybe (Word8, ([Word8], Bool, Int))
cMacPad (ByteString -> [Word8]
B.unpack ByteString
x,Bool
True,Int
bSize))
       go ByteString
s (ByteString
x:[ByteString]
xs) = ByteString -> [ByteString] -> ByteString
go (ByteString -> ByteString -> ByteString
zwp' (ByteString -> ByteString
dblB ByteString
s) (ByteString -> ByteString
lcmac ByteString
x)) [ByteString]
xs 

-- |Generate the xor stream for the last step of the CMAC* algorithm
xorend  :: Int -> (Int,[Word8]) -> Maybe (Word8,(Int,[Word8]))
xorend :: Int -> (Int, [Word8]) -> Maybe (Word8, (Int, [Word8]))
xorend Int
bsize (Int
0, []) = Maybe (Word8, (Int, [Word8]))
forall a. Maybe a
Nothing
xorend Int
bsize (Int
n, Word8
x:[Word8]
xs) | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
bsize = (Word8, (Int, [Word8])) -> Maybe (Word8, (Int, [Word8]))
forall a. a -> Maybe a
Just (Word8
x,((Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1),[Word8]
xs))
                       | Bool
otherwise = (Word8, (Int, [Word8])) -> Maybe (Word8, (Int, [Word8]))
forall a. a -> Maybe a
Just (Word8
0,((Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1),(Word8
xWord8 -> [Word8] -> [Word8]
forall a. a -> [a] -> [a]
:[Word8]
xs)))

-- |Accumulator based double operation
dblw :: Bool -> (Int,[Int],Bool) -> Word8 -> ((Int,[Int],Bool), Word8)
dblw :: Bool -> (Int, [Int], Bool) -> Word8 -> ((Int, [Int], Bool), Word8)
dblw Bool
hb (Int
i,[Int]
xs,Bool
b) Word8
w = Bool -> ((Int, [Int], Bool), Word8)
dblw' Bool
hb
  where
       slw :: Bool -> a -> a
slw Bool
True a
w = (a -> Int -> a
forall a. Bits a => a -> Int -> a
setBit (a -> Int -> a
forall a. Bits a => a -> Int -> a
shift a
w Int
1) Int
0)
       slw Bool
False a
w = (a -> Int -> a
forall a. Bits a => a -> Int -> a
clearBit (a -> Int -> a
forall a. Bits a => a -> Int -> a
shift a
w Int
1) Int
0)
       cpolyw :: Int -> [Int] -> t -> ((Int, [Int]), t)
cpolyw Int
i [] t
w = ((Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
8,[]),t
w)
       cpolyw Int
i (Int
x:[Int]
xs) t
w
         | Int
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
8 = (\((Int, [Int])
a,t
b) -> ((Int, [Int])
a,t -> Int -> t
forall a. Bits a => a -> Int -> a
complementBit t
b (Int
xInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
i))) (((Int, [Int]), t) -> ((Int, [Int]), t))
-> ((Int, [Int]), t) -> ((Int, [Int]), t)
forall a b. (a -> b) -> a -> b
$ Int -> [Int] -> t -> ((Int, [Int]), t)
cpolyw Int
i [Int]
xs t
w
         |Bool
otherwise = ((Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
8,(Int
xInt -> [Int] -> [Int]
forall a. a -> [a] -> [a]
:[Int]
xs)),t
w)
       b' :: Bool
b' = Word8 -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
testBit Word8
w Int
7
       w' :: Word8
w' = Bool -> Word8 -> Word8
forall {a}. Bits a => Bool -> a -> a
slw Bool
b Word8
w
       ((Int
i',[Int]
xs'),Word8
w'') = Int -> [Int] -> Word8 -> ((Int, [Int]), Word8)
forall {t}. Bits t => Int -> [Int] -> t -> ((Int, [Int]), t)
cpolyw Int
i [Int]
xs Word8
w'
       dblw' :: Bool -> ((Int, [Int], Bool), Word8)
dblw' Bool
False = Int
i'Int -> ((Int, [Int], Bool), Word8) -> ((Int, [Int], Bool), Word8)
forall a b. a -> b -> b
`seq`[Int]
xs'[Int] -> ((Int, [Int], Bool), Word8) -> ((Int, [Int], Bool), Word8)
forall a b. a -> b -> b
`seq`Word8
w''Word8 -> ((Int, [Int], Bool), Word8) -> ((Int, [Int], Bool), Word8)
forall a b. a -> b -> b
`seq`((Int
i,[Int]
xs,Bool
b'),Word8
w')
       dblw' Bool
True  = ((Int
i',[Int]
xs',Bool
b'),Word8
w'')

-- |Perform doubling as defined by the CMAC and SIV papers
dblIV :: BlockCipher k => IV k -> IV k
dblIV :: forall k. BlockCipher k => IV k -> IV k
dblIV (IV ByteString
b) = ByteString -> IV k
forall k. ByteString -> IV k
IV (ByteString -> IV k) -> ByteString -> IV k
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
dblB ByteString
b

-- |Perform doubling as defined by the CMAC and SIV papers
dblB :: B.ByteString -> B.ByteString
dblB :: ByteString -> ByteString
dblB ByteString
b | ByteString -> Bool
B.null ByteString
b = ByteString
b
       | Bool
otherwise = ((Int, [Int], Bool), ByteString) -> ByteString
forall a b. (a, b) -> b
snd (((Int, [Int], Bool), ByteString) -> ByteString)
-> ((Int, [Int], Bool), ByteString) -> ByteString
forall a b. (a -> b) -> a -> b
$ ((Int, [Int], Bool) -> Word8 -> ((Int, [Int], Bool), Word8))
-> (Int, [Int], Bool)
-> ByteString
-> ((Int, [Int], Bool), ByteString)
forall acc.
(acc -> Word8 -> (acc, Word8))
-> acc -> ByteString -> (acc, ByteString)
B.mapAccumR (Bool -> (Int, [Int], Bool) -> Word8 -> ((Int, [Int], Bool), Word8)
dblw (Word8 -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
testBit (HasCallStack => ByteString -> Word8
ByteString -> Word8
B.head ByteString
b) Int
7)) (Int
0,Int -> [Int]
forall a b. (Integral a, Integral b) => a -> [b]
cpoly2revlist (ByteString -> Int
B.length ByteString
b Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
8),Bool
False) ByteString
b

-- |Perform doubling as defined by the CMAC and SIV papers
dblL :: L.ByteString -> L.ByteString
dblL :: ByteString -> ByteString
dblL ByteString
b | ByteString -> Bool
L.null ByteString
b = ByteString
b
       | Bool
otherwise = ((Int, [Int], Bool), ByteString) -> ByteString
forall a b. (a, b) -> b
snd (((Int, [Int], Bool), ByteString) -> ByteString)
-> ((Int, [Int], Bool), ByteString) -> ByteString
forall a b. (a -> b) -> a -> b
$ ((Int, [Int], Bool) -> Word8 -> ((Int, [Int], Bool), Word8))
-> (Int, [Int], Bool)
-> ByteString
-> ((Int, [Int], Bool), ByteString)
forall acc.
(acc -> Word8 -> (acc, Word8))
-> acc -> ByteString -> (acc, ByteString)
L.mapAccumR (Bool -> (Int, [Int], Bool) -> Word8 -> ((Int, [Int], Bool), Word8)
dblw (Word8 -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
testBit (HasCallStack => ByteString -> Word8
ByteString -> Word8
L.head ByteString
b) Int
7)) (Int
0,Int64 -> [Int]
forall a b. (Integral a, Integral b) => a -> [b]
cpoly2revlist (ByteString -> Int64
L.length ByteString
b Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
* Int64
8),Bool
False) ByteString
b
 
-- |Cast a bigEndian ByteString into an Integer
decodeB :: B.ByteString -> Integer
decodeB :: ByteString -> Integer
decodeB = (Integer -> Word8 -> Integer) -> Integer -> ByteString -> Integer
forall a. (a -> Word8 -> a) -> a -> ByteString -> a
B.foldl' (\Integer
acc Word8
w -> (Integer -> Int -> Integer
forall a. Bits a => a -> Int -> a
shift Integer
acc Int
8) Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Word8 -> Integer
forall a. Integral a => a -> Integer
toInteger(Word8
w)) Integer
0

-- |Cast an Integer into a bigEndian ByteString of size k.  It will
-- drop the MSBs in case the number is bigger than k and add 00s if it
-- is smaller.
encodeB :: (Ord a,Num a) => a -> Integer -> B.ByteString
encodeB :: forall a. (Ord a, Num a) => a -> Integer -> ByteString
encodeB a
k Integer
n = [Word8] -> ByteString
B.pack ([Word8] -> ByteString) -> [Word8] -> ByteString
forall a b. (a -> b) -> a -> b
$ if a
lr a -> a -> Bool
forall a. Ord a => a -> a -> Bool
> a
k then a -> [Word8] -> [Word8]
forall {t} {a}. (Eq t, Num t) => t -> [a] -> [a]
takel (a
lr a -> a -> a
forall a. Num a => a -> a -> a
- a
k) [Word8]
r else a -> [Word8] -> [Word8]
forall {t} {a}. (Eq t, Num t, Num a) => t -> [a] -> [a]
pad (a
k a -> a -> a
forall a. Num a => a -> a -> a
- a
lr) [Word8]
r
  where
       go :: Integer -> [a] -> [a]
go Integer
0 [a]
xs = [a]
xs 
       go Integer
n [a]
xs = Integer -> [a] -> [a]
go (Integer -> Int -> Integer
forall a. Bits a => a -> Int -> a
shift Integer
n (-Int
8)) (Integer -> a
forall a. Num a => Integer -> a
fromInteger (Integer
n Integer -> Integer -> Integer
forall a. Bits a => a -> a -> a
.&. Integer
255) a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
xs)
       pad :: t -> [a] -> [a]
pad t
0 [a]
xs = [a]
xs
       pad t
n [a]
xs = a
0 a -> [a] -> [a]
forall a. a -> [a] -> [a]
: t -> [a] -> [a]
pad (t
nt -> t -> t
forall a. Num a => a -> a -> a
-t
1) [a]
xs
       takel :: t -> [a] -> [a]
takel t
0 [a]
xs = [a]
xs
       takel t
n (a
_:[a]
xs) = t -> [a] -> [a]
takel (t
nt -> t -> t
forall a. Num a => a -> a -> a
-t
1) [a]
xs
       r :: [Word8]
r = Integer -> [Word8] -> [Word8]
forall {a}. Num a => Integer -> [a] -> [a]
go Integer
n []
       lr :: a
lr = [Word8] -> a
forall i a. Num i => [a] -> i
genericLength [Word8]
r

-- |Cast a bigEndian ByteString into an Integer
decodeL :: L.ByteString -> Integer
decodeL :: ByteString -> Integer
decodeL = (Integer -> Word8 -> Integer) -> Integer -> ByteString -> Integer
forall a. (a -> Word8 -> a) -> a -> ByteString -> a
L.foldl' (\Integer
acc Word8
w -> (Integer -> Int -> Integer
forall a. Bits a => a -> Int -> a
shift Integer
acc Int
8) Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Word8 -> Integer
forall a. Integral a => a -> Integer
toInteger(Word8
w)) Integer
0

-- |Cast an Integer into a bigEndian ByteString of size k.  It will
-- drop the MSBs in case the number is bigger than k and add 00s if it
-- is smaller.
encodeL :: (Ord a,Num a) => a -> Integer -> L.ByteString
encodeL :: forall a. (Ord a, Num a) => a -> Integer -> ByteString
encodeL a
k Integer
n = [Word8] -> ByteString
L.pack ([Word8] -> ByteString) -> [Word8] -> ByteString
forall a b. (a -> b) -> a -> b
$ if a
lr a -> a -> Bool
forall a. Ord a => a -> a -> Bool
> a
k then a -> [Word8] -> [Word8]
forall {t} {a}. (Eq t, Num t) => t -> [a] -> [a]
takel (a
lr a -> a -> a
forall a. Num a => a -> a -> a
- a
k) [Word8]
r else a -> [Word8] -> [Word8]
forall {t} {a}. (Eq t, Num t, Num a) => t -> [a] -> [a]
pad (a
k a -> a -> a
forall a. Num a => a -> a -> a
- a
lr) [Word8]
r
  where go :: Integer -> [a] -> [a]
go Integer
0 [a]
xs = [a]
xs 
        go Integer
n [a]
xs = Integer -> [a] -> [a]
go (Integer -> Int -> Integer
forall a. Bits a => a -> Int -> a
shift Integer
n (-Int
8)) (Integer -> a
forall a. Num a => Integer -> a
fromInteger (Integer
n Integer -> Integer -> Integer
forall a. Bits a => a -> a -> a
.&. Integer
255) a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
xs)
        pad :: t -> [a] -> [a]
pad t
0 [a]
xs = [a]
xs
        pad t
n [a]
xs = a
0 a -> [a] -> [a]
forall a. a -> [a] -> [a]
: t -> [a] -> [a]
pad (t
nt -> t -> t
forall a. Num a => a -> a -> a
-t
1) [a]
xs
        takel :: t -> [a] -> [a]
takel t
0 [a]
xs = [a]
xs
        takel t
n (a
_:[a]
xs) = t -> [a] -> [a]
takel (t
nt -> t -> t
forall a. Num a => a -> a -> a
-t
1) [a]
xs
        r :: [Word8]
r = Integer -> [Word8] -> [Word8]
forall {a}. Num a => Integer -> [a] -> [a]
go Integer
n []
        lr :: a
lr = [Word8] -> a
forall i a. Num i => [a] -> i
genericLength [Word8]
r

-- TODO: GCM, GMAC
-- Consider the AES-only modes of XTS, CCM