{-# OPTIONS_GHC -fno-warn-orphans #-}
{-# LANGUAGE RecordWildCards #-}
module Crypto.Cipher.AES128
(
AESKey128, AESKey192, AESKey256
, BlockCipher(..), buildKeyIO, zeroIV
, makeGCMCtx, aesKeyToGCM, GCMCtx, AuthTag(..), AES_GCM
, Crypto.Cipher.AES128.encryptGCM
, Crypto.Cipher.AES128.decryptGCM
) where
import Crypto.Cipher.AES128.Internal as I
import Crypto.Classes
import Data.Function (on)
import Control.Monad (when)
import Data.Serialize
import Data.Tagged
import Data.Word (Word8)
import Foreign.Ptr
import Foreign.ForeignPtr
import Foreign.Marshal.Alloc as F
import System.IO.Unsafe
import Data.ByteString (ByteString)
import qualified Data.ByteString as B
import qualified Data.ByteString.Internal as B
import qualified Data.ByteString.Unsafe as B
instance Serialize AESKey128 where
put :: Putter AESKey128
put AESKey128
k = do
let RKey128 Word64
l Word64
h = (AESKey128 -> RawKey128
rawKey128 AESKey128
k)
Putter Word64
putWord64be Word64
h
Putter Word64
putWord64be Word64
l
get :: Get AESKey128
get = do
ByteString
b <- Int -> Get ByteString
getByteString Int
16
case ByteString -> Maybe AESKey128
forall k. BlockCipher k => ByteString -> Maybe k
buildKey ByteString
b of
Maybe AESKey128
Nothing -> String -> Get AESKey128
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Invalid key on 'get'"
Just AESKey128
k -> AESKey128 -> Get AESKey128
forall (m :: * -> *) a. Monad m => a -> m a
return AESKey128
k
instance Serialize AESKey192 where
put :: Putter AESKey192
put AESKey192
k = do
let RKey192 Word64
a Word64
b Word64
c = (AESKey192 -> RawKey192
rawKey192 AESKey192
k)
Putter Word64
putWord64be Word64
c
Putter Word64
putWord64be Word64
b
Putter Word64
putWord64be Word64
a
get :: Get AESKey192
get = do
ByteString
b <- Int -> Get ByteString
getByteString Int
24
case ByteString -> Maybe AESKey192
forall k. BlockCipher k => ByteString -> Maybe k
buildKey ByteString
b of
Maybe AESKey192
Nothing -> String -> Get AESKey192
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Invalid key on 'get'"
Just AESKey192
k -> AESKey192 -> Get AESKey192
forall (m :: * -> *) a. Monad m => a -> m a
return AESKey192
k
instance Serialize AESKey256 where
put :: Putter AESKey256
put AESKey256
k = do
let RKey256 Word64
a Word64
b Word64
c Word64
d = (AESKey256 -> RawKey256
rawKey256 AESKey256
k)
Putter Word64
putWord64be Word64
d
Putter Word64
putWord64be Word64
c
Putter Word64
putWord64be Word64
b
Putter Word64
putWord64be Word64
a
get :: Get AESKey256
get = do
ByteString
b <- Int -> Get ByteString
getByteString Int
32
case ByteString -> Maybe AESKey256
forall k. BlockCipher k => ByteString -> Maybe k
buildKey ByteString
b of
Maybe AESKey256
Nothing -> String -> Get AESKey256
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Invalid key on 'get'"
Just AESKey256
k -> AESKey256 -> Get AESKey256
forall (m :: * -> *) a. Monad m => a -> m a
return AESKey256
k
instance BlockCipher AESKey128 where
blockSize :: Tagged AESKey128 Int
blockSize = Int -> Tagged AESKey128 Int
forall k (s :: k) b. b -> Tagged s b
Tagged Int
128
keyLength :: Tagged AESKey128 Int
keyLength = Int -> Tagged AESKey128 Int
forall k (s :: k) b. b -> Tagged s b
Tagged Int
128
buildKey :: ByteString -> Maybe AESKey128
buildKey ByteString
bs
| ByteString -> Int
B.length ByteString
bs Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
16 = IO (Maybe AESKey128) -> Maybe AESKey128
forall a. IO a -> a
unsafePerformIO (IO (Maybe AESKey128) -> Maybe AESKey128)
-> IO (Maybe AESKey128) -> Maybe AESKey128
forall a b. (a -> b) -> a -> b
$
ByteString
-> (CString -> IO (Maybe AESKey128)) -> IO (Maybe AESKey128)
forall a. ByteString -> (CString -> IO a) -> IO a
B.unsafeUseAsCString ByteString
bs (\CString
p -> Ptr Word64 -> IO (Maybe AESKey128)
generateKey128 (CString -> Ptr Word64
forall a b. Ptr a -> Ptr b
castPtr CString
p))
| Bool
otherwise = Maybe AESKey128
forall a. Maybe a
Nothing
encryptBlock :: AESKey128 -> ByteString -> ByteString
encryptBlock AESKey128
k ByteString
b = IO ByteString -> ByteString
forall a. IO a -> a
unsafePerformIO (IO ByteString -> ByteString) -> IO ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ do
ByteString -> (CStringLen -> IO ByteString) -> IO ByteString
forall a. ByteString -> (CStringLen -> IO a) -> IO a
B.unsafeUseAsCStringLen ByteString
b ((CStringLen -> IO ByteString) -> IO ByteString)
-> (CStringLen -> IO ByteString) -> IO ByteString
forall a b. (a -> b) -> a -> b
$ \(CString
inP,Int
len) -> do
Int -> (Ptr Word8 -> IO ()) -> IO ByteString
B.create (ByteString -> Int
B.length ByteString
b) ((Ptr Word8 -> IO ()) -> IO ByteString)
-> (Ptr Word8 -> IO ()) -> IO ByteString
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
outP -> do
AESKey128 -> Ptr Word8 -> Ptr Word8 -> Int -> IO ()
forall k.
GetExpanded k =>
k -> Ptr Word8 -> Ptr Word8 -> Int -> IO ()
encryptECB AESKey128
k (Ptr Word8 -> Ptr Word8
forall a b. Ptr a -> Ptr b
castPtr Ptr Word8
outP) (CString -> Ptr Word8
forall a b. Ptr a -> Ptr b
castPtr CString
inP) (Int
lenInt -> Int -> Int
forall a. Integral a => a -> a -> a
`div`Int
blkSize)
decryptBlock :: AESKey128 -> ByteString -> ByteString
decryptBlock AESKey128
k ByteString
b = IO ByteString -> ByteString
forall a. IO a -> a
unsafePerformIO (IO ByteString -> ByteString) -> IO ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ do
ByteString -> (CStringLen -> IO ByteString) -> IO ByteString
forall a. ByteString -> (CStringLen -> IO a) -> IO a
B.unsafeUseAsCStringLen ByteString
b ((CStringLen -> IO ByteString) -> IO ByteString)
-> (CStringLen -> IO ByteString) -> IO ByteString
forall a b. (a -> b) -> a -> b
$ \(CString
inP,Int
len) -> do
Int -> (Ptr Word8 -> IO ()) -> IO ByteString
B.create (ByteString -> Int
B.length ByteString
b) ((Ptr Word8 -> IO ()) -> IO ByteString)
-> (Ptr Word8 -> IO ()) -> IO ByteString
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
outP -> do
AESKey128 -> Ptr Word8 -> Ptr Word8 -> Int -> IO ()
forall k.
GetExpanded k =>
k -> Ptr Word8 -> Ptr Word8 -> Int -> IO ()
decryptECB AESKey128
k (Ptr Word8 -> Ptr Word8
forall a b. Ptr a -> Ptr b
castPtr Ptr Word8
outP) (CString -> Ptr Word8
forall a b. Ptr a -> Ptr b
castPtr CString
inP) (Int
lenInt -> Int -> Int
forall a. Integral a => a -> a -> a
`div`Int
blkSize)
ecb :: AESKey128 -> ByteString -> ByteString
ecb = AESKey128 -> ByteString -> ByteString
forall k. BlockCipher k => k -> ByteString -> ByteString
encryptBlock
unEcb :: AESKey128 -> ByteString -> ByteString
unEcb = AESKey128 -> ByteString -> ByteString
forall k. BlockCipher k => k -> ByteString -> ByteString
decryptBlock
ctr :: AESKey128
-> IV AESKey128 -> ByteString -> (ByteString, IV AESKey128)
ctr AESKey128
k (IV ByteString
bs) ByteString
pt = IO (ByteString, IV AESKey128) -> (ByteString, IV AESKey128)
forall a. IO a -> a
unsafePerformIO (IO (ByteString, IV AESKey128) -> (ByteString, IV AESKey128))
-> IO (ByteString, IV AESKey128) -> (ByteString, IV AESKey128)
forall a b. (a -> b) -> a -> b
$ do
ByteString
-> (CStringLen -> IO (ByteString, IV AESKey128))
-> IO (ByteString, IV AESKey128)
forall a. ByteString -> (CStringLen -> IO a) -> IO a
B.unsafeUseAsCStringLen ByteString
pt ((CStringLen -> IO (ByteString, IV AESKey128))
-> IO (ByteString, IV AESKey128))
-> (CStringLen -> IO (ByteString, IV AESKey128))
-> IO (ByteString, IV AESKey128)
forall a b. (a -> b) -> a -> b
$ \(CString
inP, Int
len) -> do
ByteString
-> (CStringLen -> IO (ByteString, IV AESKey128))
-> IO (ByteString, IV AESKey128)
forall a. ByteString -> (CStringLen -> IO a) -> IO a
B.unsafeUseAsCStringLen ByteString
bs ((CStringLen -> IO (ByteString, IV AESKey128))
-> IO (ByteString, IV AESKey128))
-> (CStringLen -> IO (ByteString, IV AESKey128))
-> IO (ByteString, IV AESKey128)
forall a b. (a -> b) -> a -> b
$ \(CString
ivP, Int
ivLen) -> do
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
ivLen Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= (Tagged AESKey128 Int
forall k. BlockCipher k => Tagged k Int
blockSizeBytes Tagged AESKey128 Int -> AESKey128 -> Int
forall a b. Tagged a b -> a -> b
.::. AESKey128
k))
(String -> IO ()
forall a. HasCallStack => String -> a
error String
"Cipher-AES128: IV wrong length! They type system would have/should have caught this if you didn't use the IV constructor...")
ForeignPtr Word8
newIVFP <- Int -> IO (ForeignPtr Word8)
forall a. Int -> IO (ForeignPtr a)
B.mallocByteString Int
ivLen
ByteString
ct <- Int -> (Ptr Word8 -> IO ()) -> IO ByteString
B.create Int
len ((Ptr Word8 -> IO ()) -> IO ByteString)
-> (Ptr Word8 -> IO ()) -> IO ByteString
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
outP -> ForeignPtr Word8 -> (Ptr Word8 -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Word8
newIVFP ((Ptr Word8 -> IO ()) -> IO ()) -> (Ptr Word8 -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
newIVP -> do
AESKey128
-> Ptr Word8 -> Ptr Word8 -> Ptr Word8 -> Ptr Word8 -> Int -> IO ()
forall k.
GetExpanded k =>
k
-> Ptr Word8 -> Ptr Word8 -> Ptr Word8 -> Ptr Word8 -> Int -> IO ()
encryptCTR AESKey128
k (CString -> Ptr Word8
forall a b. Ptr a -> Ptr b
castPtr CString
ivP) (Ptr Word8 -> Ptr Word8
forall a b. Ptr a -> Ptr b
castPtr Ptr Word8
newIVP) (Ptr Word8 -> Ptr Word8
forall a b. Ptr a -> Ptr b
castPtr Ptr Word8
outP) (CString -> Ptr Word8
forall a b. Ptr a -> Ptr b
castPtr CString
inP) Int
len
let newIV :: ByteString
newIV = ForeignPtr Word8 -> Int -> Int -> ByteString
B.fromForeignPtr ForeignPtr Word8
newIVFP Int
0 Int
ivLen
(ByteString, IV AESKey128) -> IO (ByteString, IV AESKey128)
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString
ct,ByteString -> IV AESKey128
forall k. ByteString -> IV k
IV ByteString
newIV)
{-# INLINE ctr #-}
unCtr :: AESKey128
-> IV AESKey128 -> ByteString -> (ByteString, IV AESKey128)
unCtr = AESKey128
-> IV AESKey128 -> ByteString -> (ByteString, IV AESKey128)
forall k.
BlockCipher k =>
k -> IV k -> ByteString -> (ByteString, IV k)
ctr
blkSize :: Int
blkSize :: Int
blkSize = Int
16
instance BlockCipher AESKey192 where
blockSize :: Tagged AESKey192 Int
blockSize = Int -> Tagged AESKey192 Int
forall k (s :: k) b. b -> Tagged s b
Tagged Int
128
keyLength :: Tagged AESKey192 Int
keyLength = Int -> Tagged AESKey192 Int
forall k (s :: k) b. b -> Tagged s b
Tagged Int
192
buildKey :: ByteString -> Maybe AESKey192
buildKey ByteString
bs
| ByteString -> Int
B.length ByteString
bs Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
16 = IO (Maybe AESKey192) -> Maybe AESKey192
forall a. IO a -> a
unsafePerformIO (IO (Maybe AESKey192) -> Maybe AESKey192)
-> IO (Maybe AESKey192) -> Maybe AESKey192
forall a b. (a -> b) -> a -> b
$
ByteString
-> (CString -> IO (Maybe AESKey192)) -> IO (Maybe AESKey192)
forall a. ByteString -> (CString -> IO a) -> IO a
B.unsafeUseAsCString ByteString
bs (\CString
p -> Ptr Word64 -> IO (Maybe AESKey192)
generateKey192 (CString -> Ptr Word64
forall a b. Ptr a -> Ptr b
castPtr CString
p))
| Bool
otherwise = Maybe AESKey192
forall a. Maybe a
Nothing
encryptBlock :: AESKey192 -> ByteString -> ByteString
encryptBlock AESKey192
k ByteString
b = IO ByteString -> ByteString
forall a. IO a -> a
unsafePerformIO (IO ByteString -> ByteString) -> IO ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ do
ByteString -> (CStringLen -> IO ByteString) -> IO ByteString
forall a. ByteString -> (CStringLen -> IO a) -> IO a
B.unsafeUseAsCStringLen ByteString
b ((CStringLen -> IO ByteString) -> IO ByteString)
-> (CStringLen -> IO ByteString) -> IO ByteString
forall a b. (a -> b) -> a -> b
$ \(CString
inP,Int
len) -> do
Int -> (Ptr Word8 -> IO ()) -> IO ByteString
B.create (ByteString -> Int
B.length ByteString
b) ((Ptr Word8 -> IO ()) -> IO ByteString)
-> (Ptr Word8 -> IO ()) -> IO ByteString
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
outP -> do
AESKey192 -> Ptr Word8 -> Ptr Word8 -> Int -> IO ()
forall k.
GetExpanded k =>
k -> Ptr Word8 -> Ptr Word8 -> Int -> IO ()
encryptECB AESKey192
k (Ptr Word8 -> Ptr Word8
forall a b. Ptr a -> Ptr b
castPtr Ptr Word8
outP) (CString -> Ptr Word8
forall a b. Ptr a -> Ptr b
castPtr CString
inP) (Int
lenInt -> Int -> Int
forall a. Integral a => a -> a -> a
`div`Int
blkSize)
decryptBlock :: AESKey192 -> ByteString -> ByteString
decryptBlock AESKey192
k ByteString
b = IO ByteString -> ByteString
forall a. IO a -> a
unsafePerformIO (IO ByteString -> ByteString) -> IO ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ do
ByteString -> (CStringLen -> IO ByteString) -> IO ByteString
forall a. ByteString -> (CStringLen -> IO a) -> IO a
B.unsafeUseAsCStringLen ByteString
b ((CStringLen -> IO ByteString) -> IO ByteString)
-> (CStringLen -> IO ByteString) -> IO ByteString
forall a b. (a -> b) -> a -> b
$ \(CString
inP,Int
len) -> do
Int -> (Ptr Word8 -> IO ()) -> IO ByteString
B.create (ByteString -> Int
B.length ByteString
b) ((Ptr Word8 -> IO ()) -> IO ByteString)
-> (Ptr Word8 -> IO ()) -> IO ByteString
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
outP -> do
AESKey192 -> Ptr Word8 -> Ptr Word8 -> Int -> IO ()
forall k.
GetExpanded k =>
k -> Ptr Word8 -> Ptr Word8 -> Int -> IO ()
decryptECB AESKey192
k (Ptr Word8 -> Ptr Word8
forall a b. Ptr a -> Ptr b
castPtr Ptr Word8
outP) (CString -> Ptr Word8
forall a b. Ptr a -> Ptr b
castPtr CString
inP) (Int
lenInt -> Int -> Int
forall a. Integral a => a -> a -> a
`div`Int
blkSize)
ecb :: AESKey192 -> ByteString -> ByteString
ecb = AESKey192 -> ByteString -> ByteString
forall k. BlockCipher k => k -> ByteString -> ByteString
encryptBlock
unEcb :: AESKey192 -> ByteString -> ByteString
unEcb = AESKey192 -> ByteString -> ByteString
forall k. BlockCipher k => k -> ByteString -> ByteString
decryptBlock
ctr :: AESKey192
-> IV AESKey192 -> ByteString -> (ByteString, IV AESKey192)
ctr AESKey192
k (IV ByteString
bs) ByteString
pt = IO (ByteString, IV AESKey192) -> (ByteString, IV AESKey192)
forall a. IO a -> a
unsafePerformIO (IO (ByteString, IV AESKey192) -> (ByteString, IV AESKey192))
-> IO (ByteString, IV AESKey192) -> (ByteString, IV AESKey192)
forall a b. (a -> b) -> a -> b
$ do
ByteString
-> (CStringLen -> IO (ByteString, IV AESKey192))
-> IO (ByteString, IV AESKey192)
forall a. ByteString -> (CStringLen -> IO a) -> IO a
B.unsafeUseAsCStringLen ByteString
pt ((CStringLen -> IO (ByteString, IV AESKey192))
-> IO (ByteString, IV AESKey192))
-> (CStringLen -> IO (ByteString, IV AESKey192))
-> IO (ByteString, IV AESKey192)
forall a b. (a -> b) -> a -> b
$ \(CString
inP, Int
len) -> do
ByteString
-> (CStringLen -> IO (ByteString, IV AESKey192))
-> IO (ByteString, IV AESKey192)
forall a. ByteString -> (CStringLen -> IO a) -> IO a
B.unsafeUseAsCStringLen ByteString
bs ((CStringLen -> IO (ByteString, IV AESKey192))
-> IO (ByteString, IV AESKey192))
-> (CStringLen -> IO (ByteString, IV AESKey192))
-> IO (ByteString, IV AESKey192)
forall a b. (a -> b) -> a -> b
$ \(CString
ivP, Int
ivLen) -> do
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
ivLen Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= (Tagged AESKey192 Int
forall k. BlockCipher k => Tagged k Int
blockSizeBytes Tagged AESKey192 Int -> AESKey192 -> Int
forall a b. Tagged a b -> a -> b
.::. AESKey192
k))
(String -> IO ()
forall a. HasCallStack => String -> a
error String
"Cipher-AES128: IV wrong length! They type system would have/should have caught this if you didn't use the IV constructor...")
ForeignPtr Word8
newIVFP <- Int -> IO (ForeignPtr Word8)
forall a. Int -> IO (ForeignPtr a)
B.mallocByteString Int
ivLen
ByteString
ct <- Int -> (Ptr Word8 -> IO ()) -> IO ByteString
B.create Int
len ((Ptr Word8 -> IO ()) -> IO ByteString)
-> (Ptr Word8 -> IO ()) -> IO ByteString
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
outP -> ForeignPtr Word8 -> (Ptr Word8 -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Word8
newIVFP ((Ptr Word8 -> IO ()) -> IO ()) -> (Ptr Word8 -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
newIVP -> do
AESKey192
-> Ptr Word8 -> Ptr Word8 -> Ptr Word8 -> Ptr Word8 -> Int -> IO ()
forall k.
GetExpanded k =>
k
-> Ptr Word8 -> Ptr Word8 -> Ptr Word8 -> Ptr Word8 -> Int -> IO ()
encryptCTR AESKey192
k (CString -> Ptr Word8
forall a b. Ptr a -> Ptr b
castPtr CString
ivP) (Ptr Word8 -> Ptr Word8
forall a b. Ptr a -> Ptr b
castPtr Ptr Word8
newIVP) (Ptr Word8 -> Ptr Word8
forall a b. Ptr a -> Ptr b
castPtr Ptr Word8
outP) (CString -> Ptr Word8
forall a b. Ptr a -> Ptr b
castPtr CString
inP) Int
len
let newIV :: ByteString
newIV = ForeignPtr Word8 -> Int -> Int -> ByteString
B.fromForeignPtr ForeignPtr Word8
newIVFP Int
0 Int
ivLen
(ByteString, IV AESKey192) -> IO (ByteString, IV AESKey192)
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString
ct,ByteString -> IV AESKey192
forall k. ByteString -> IV k
IV ByteString
newIV)
{-# INLINE ctr #-}
unCtr :: AESKey192
-> IV AESKey192 -> ByteString -> (ByteString, IV AESKey192)
unCtr = AESKey192
-> IV AESKey192 -> ByteString -> (ByteString, IV AESKey192)
forall k.
BlockCipher k =>
k -> IV k -> ByteString -> (ByteString, IV k)
ctr
instance BlockCipher AESKey256 where
blockSize :: Tagged AESKey256 Int
blockSize = Int -> Tagged AESKey256 Int
forall k (s :: k) b. b -> Tagged s b
Tagged Int
128
keyLength :: Tagged AESKey256 Int
keyLength = Int -> Tagged AESKey256 Int
forall k (s :: k) b. b -> Tagged s b
Tagged Int
256
buildKey :: ByteString -> Maybe AESKey256
buildKey ByteString
bs
| ByteString -> Int
B.length ByteString
bs Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
16 = IO (Maybe AESKey256) -> Maybe AESKey256
forall a. IO a -> a
unsafePerformIO (IO (Maybe AESKey256) -> Maybe AESKey256)
-> IO (Maybe AESKey256) -> Maybe AESKey256
forall a b. (a -> b) -> a -> b
$
ByteString
-> (CString -> IO (Maybe AESKey256)) -> IO (Maybe AESKey256)
forall a. ByteString -> (CString -> IO a) -> IO a
B.unsafeUseAsCString ByteString
bs (\CString
p -> Ptr Word64 -> IO (Maybe AESKey256)
generateKey256 (CString -> Ptr Word64
forall a b. Ptr a -> Ptr b
castPtr CString
p))
| Bool
otherwise = Maybe AESKey256
forall a. Maybe a
Nothing
encryptBlock :: AESKey256 -> ByteString -> ByteString
encryptBlock AESKey256
k ByteString
b = IO ByteString -> ByteString
forall a. IO a -> a
unsafePerformIO (IO ByteString -> ByteString) -> IO ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ do
ByteString -> (CStringLen -> IO ByteString) -> IO ByteString
forall a. ByteString -> (CStringLen -> IO a) -> IO a
B.unsafeUseAsCStringLen ByteString
b ((CStringLen -> IO ByteString) -> IO ByteString)
-> (CStringLen -> IO ByteString) -> IO ByteString
forall a b. (a -> b) -> a -> b
$ \(CString
inP,Int
len) -> do
Int -> (Ptr Word8 -> IO ()) -> IO ByteString
B.create (ByteString -> Int
B.length ByteString
b) ((Ptr Word8 -> IO ()) -> IO ByteString)
-> (Ptr Word8 -> IO ()) -> IO ByteString
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
outP -> do
AESKey256 -> Ptr Word8 -> Ptr Word8 -> Int -> IO ()
forall k.
GetExpanded k =>
k -> Ptr Word8 -> Ptr Word8 -> Int -> IO ()
encryptECB AESKey256
k (Ptr Word8 -> Ptr Word8
forall a b. Ptr a -> Ptr b
castPtr Ptr Word8
outP) (CString -> Ptr Word8
forall a b. Ptr a -> Ptr b
castPtr CString
inP) (Int
lenInt -> Int -> Int
forall a. Integral a => a -> a -> a
`div`Int
blkSize)
decryptBlock :: AESKey256 -> ByteString -> ByteString
decryptBlock AESKey256
k ByteString
b = IO ByteString -> ByteString
forall a. IO a -> a
unsafePerformIO (IO ByteString -> ByteString) -> IO ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ do
ByteString -> (CStringLen -> IO ByteString) -> IO ByteString
forall a. ByteString -> (CStringLen -> IO a) -> IO a
B.unsafeUseAsCStringLen ByteString
b ((CStringLen -> IO ByteString) -> IO ByteString)
-> (CStringLen -> IO ByteString) -> IO ByteString
forall a b. (a -> b) -> a -> b
$ \(CString
inP,Int
len) -> do
Int -> (Ptr Word8 -> IO ()) -> IO ByteString
B.create (ByteString -> Int
B.length ByteString
b) ((Ptr Word8 -> IO ()) -> IO ByteString)
-> (Ptr Word8 -> IO ()) -> IO ByteString
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
outP -> do
AESKey256 -> Ptr Word8 -> Ptr Word8 -> Int -> IO ()
forall k.
GetExpanded k =>
k -> Ptr Word8 -> Ptr Word8 -> Int -> IO ()
decryptECB AESKey256
k (Ptr Word8 -> Ptr Word8
forall a b. Ptr a -> Ptr b
castPtr Ptr Word8
outP) (CString -> Ptr Word8
forall a b. Ptr a -> Ptr b
castPtr CString
inP) (Int
lenInt -> Int -> Int
forall a. Integral a => a -> a -> a
`div`Int
blkSize)
ecb :: AESKey256 -> ByteString -> ByteString
ecb = AESKey256 -> ByteString -> ByteString
forall k. BlockCipher k => k -> ByteString -> ByteString
encryptBlock
unEcb :: AESKey256 -> ByteString -> ByteString
unEcb = AESKey256 -> ByteString -> ByteString
forall k. BlockCipher k => k -> ByteString -> ByteString
decryptBlock
ctr :: AESKey256
-> IV AESKey256 -> ByteString -> (ByteString, IV AESKey256)
ctr AESKey256
k (IV ByteString
bs) ByteString
pt = IO (ByteString, IV AESKey256) -> (ByteString, IV AESKey256)
forall a. IO a -> a
unsafePerformIO (IO (ByteString, IV AESKey256) -> (ByteString, IV AESKey256))
-> IO (ByteString, IV AESKey256) -> (ByteString, IV AESKey256)
forall a b. (a -> b) -> a -> b
$ do
ByteString
-> (CStringLen -> IO (ByteString, IV AESKey256))
-> IO (ByteString, IV AESKey256)
forall a. ByteString -> (CStringLen -> IO a) -> IO a
B.unsafeUseAsCStringLen ByteString
pt ((CStringLen -> IO (ByteString, IV AESKey256))
-> IO (ByteString, IV AESKey256))
-> (CStringLen -> IO (ByteString, IV AESKey256))
-> IO (ByteString, IV AESKey256)
forall a b. (a -> b) -> a -> b
$ \(CString
inP, Int
len) -> do
ByteString
-> (CStringLen -> IO (ByteString, IV AESKey256))
-> IO (ByteString, IV AESKey256)
forall a. ByteString -> (CStringLen -> IO a) -> IO a
B.unsafeUseAsCStringLen ByteString
bs ((CStringLen -> IO (ByteString, IV AESKey256))
-> IO (ByteString, IV AESKey256))
-> (CStringLen -> IO (ByteString, IV AESKey256))
-> IO (ByteString, IV AESKey256)
forall a b. (a -> b) -> a -> b
$ \(CString
ivP, Int
ivLen) -> do
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
ivLen Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= (Tagged AESKey256 Int
forall k. BlockCipher k => Tagged k Int
blockSizeBytes Tagged AESKey256 Int -> AESKey256 -> Int
forall a b. Tagged a b -> a -> b
.::. AESKey256
k))
(String -> IO ()
forall a. HasCallStack => String -> a
error String
"Cipher-AES128: IV wrong length! They type system would have/should have caught this if you didn't use the IV constructor...")
ForeignPtr Word8
newIVFP <- Int -> IO (ForeignPtr Word8)
forall a. Int -> IO (ForeignPtr a)
B.mallocByteString Int
ivLen
ByteString
ct <- Int -> (Ptr Word8 -> IO ()) -> IO ByteString
B.create Int
len ((Ptr Word8 -> IO ()) -> IO ByteString)
-> (Ptr Word8 -> IO ()) -> IO ByteString
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
outP -> ForeignPtr Word8 -> (Ptr Word8 -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Word8
newIVFP ((Ptr Word8 -> IO ()) -> IO ()) -> (Ptr Word8 -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
newIVP -> do
AESKey256
-> Ptr Word8 -> Ptr Word8 -> Ptr Word8 -> Ptr Word8 -> Int -> IO ()
forall k.
GetExpanded k =>
k
-> Ptr Word8 -> Ptr Word8 -> Ptr Word8 -> Ptr Word8 -> Int -> IO ()
encryptCTR AESKey256
k (CString -> Ptr Word8
forall a b. Ptr a -> Ptr b
castPtr CString
ivP) (Ptr Word8 -> Ptr Word8
forall a b. Ptr a -> Ptr b
castPtr Ptr Word8
newIVP) (Ptr Word8 -> Ptr Word8
forall a b. Ptr a -> Ptr b
castPtr Ptr Word8
outP) (CString -> Ptr Word8
forall a b. Ptr a -> Ptr b
castPtr CString
inP) Int
len
let newIV :: ByteString
newIV = ForeignPtr Word8 -> Int -> Int -> ByteString
B.fromForeignPtr ForeignPtr Word8
newIVFP Int
0 Int
ivLen
(ByteString, IV AESKey256) -> IO (ByteString, IV AESKey256)
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString
ct,ByteString -> IV AESKey256
forall k. ByteString -> IV k
IV ByteString
newIV)
{-# INLINE ctr #-}
unCtr :: AESKey256
-> IV AESKey256 -> ByteString -> (ByteString, IV AESKey256)
unCtr = AESKey256
-> IV AESKey256 -> ByteString -> (ByteString, IV AESKey256)
forall k.
BlockCipher k =>
k -> IV k -> ByteString -> (ByteString, IV k)
ctr
maxTagLen :: Int
maxTagLen :: Int
maxTagLen = Int
16
data AuthTag = AuthTag { AuthTag -> ByteString
unAuthTag :: ByteString }
data GCMCtx k = GCMCtx { GCMCtx k -> k
gcmkey :: k
, GCMCtx k -> GCMpc
gcmpc :: GCMpc
}
instance Eq AuthTag where
== :: AuthTag -> AuthTag -> Bool
(==) = ByteString -> ByteString -> Bool
constTimeEq (ByteString -> ByteString -> Bool)
-> (AuthTag -> ByteString) -> AuthTag -> AuthTag -> Bool
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` AuthTag -> ByteString
unAuthTag
class (BlockCipher k, GetExpanded k) => AES_GCM k where
instance AES_GCM AESKey128
instance AES_GCM AESKey192
instance AES_GCM AESKey256
makeGCMCtx :: AES_GCM k => ByteString -> Maybe (GCMCtx k)
makeGCMCtx :: ByteString -> Maybe (GCMCtx k)
makeGCMCtx = (k -> GCMCtx k) -> Maybe k -> Maybe (GCMCtx k)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap k -> GCMCtx k
forall k. AES_GCM k => k -> GCMCtx k
aesKeyToGCM (Maybe k -> Maybe (GCMCtx k))
-> (ByteString -> Maybe k) -> ByteString -> Maybe (GCMCtx k)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Maybe k
forall k. BlockCipher k => ByteString -> Maybe k
buildKey
aesKeyToGCM :: AES_GCM k => k -> GCMCtx k
aesKeyToGCM :: k -> GCMCtx k
aesKeyToGCM k
k = k -> GCMpc -> GCMCtx k
forall k. k -> GCMpc -> GCMCtx k
GCMCtx k
k (k -> GCMpc
forall k. GetExpanded k => k -> GCMpc
I.precomputeGCMdata k
k)
encryptGCM :: AES_GCM k
=> GCMCtx k
-> ByteString
-> ByteString
-> ByteString
-> (ByteString, AuthTag)
encryptGCM :: GCMCtx k
-> ByteString -> ByteString -> ByteString -> (ByteString, AuthTag)
encryptGCM GCMCtx k
key ByteString
iv ByteString
pt ByteString
aad = IO (ByteString, AuthTag) -> (ByteString, AuthTag)
forall a. IO a -> a
unsafePerformIO (IO (ByteString, AuthTag) -> (ByteString, AuthTag))
-> IO (ByteString, AuthTag) -> (ByteString, AuthTag)
forall a b. (a -> b) -> a -> b
$ do
ByteString
-> (CString -> IO (ByteString, AuthTag))
-> IO (ByteString, AuthTag)
forall a. ByteString -> (CString -> IO a) -> IO a
B.unsafeUseAsCString ByteString
pt ((CString -> IO (ByteString, AuthTag)) -> IO (ByteString, AuthTag))
-> (CString -> IO (ByteString, AuthTag))
-> IO (ByteString, AuthTag)
forall a b. (a -> b) -> a -> b
$ \CString
ptPtr -> do
ByteString
-> (CString -> IO (ByteString, AuthTag))
-> IO (ByteString, AuthTag)
forall a. ByteString -> (CString -> IO a) -> IO a
B.unsafeUseAsCString ByteString
iv ((CString -> IO (ByteString, AuthTag)) -> IO (ByteString, AuthTag))
-> (CString -> IO (ByteString, AuthTag))
-> IO (ByteString, AuthTag)
forall a b. (a -> b) -> a -> b
$ \CString
ivPtr -> do
ByteString
-> (CString -> IO (ByteString, AuthTag))
-> IO (ByteString, AuthTag)
forall a. ByteString -> (CString -> IO a) -> IO a
B.unsafeUseAsCString ByteString
aad ((CString -> IO (ByteString, AuthTag)) -> IO (ByteString, AuthTag))
-> (CString -> IO (ByteString, AuthTag))
-> IO (ByteString, AuthTag)
forall a b. (a -> b) -> a -> b
$ \CString
aadPtr -> do
Ptr Any
ctPtr <- Int -> IO (Ptr Any)
forall a. Int -> IO (Ptr a)
F.mallocBytes (ByteString -> Int
B.length ByteString
pt)
Ptr Any
tagPtr <- Int -> IO (Ptr Any)
forall a. Int -> IO (Ptr a)
F.mallocBytes Int
maxTagLen
GCMCtx k
-> Ptr Word8
-> Int
-> Ptr Word8
-> Int
-> Ptr Word8
-> Int
-> Ptr Word8
-> Ptr Word8
-> IO ()
forall k.
AES_GCM k =>
GCMCtx k
-> Ptr Word8
-> Int
-> Ptr Word8
-> Int
-> Ptr Word8
-> Int
-> Ptr Word8
-> Ptr Word8
-> IO ()
encryptGCMPtr GCMCtx k
key
(CString -> Ptr Word8
forall a b. Ptr a -> Ptr b
castPtr CString
ivPtr) (ByteString -> Int
B.length ByteString
iv)
(CString -> Ptr Word8
forall a b. Ptr a -> Ptr b
castPtr CString
ptPtr) (ByteString -> Int
B.length ByteString
pt)
(CString -> Ptr Word8
forall a b. Ptr a -> Ptr b
castPtr CString
aadPtr) (ByteString -> Int
B.length ByteString
aad)
(Ptr Any -> Ptr Word8
forall a b. Ptr a -> Ptr b
castPtr Ptr Any
ctPtr)
(Ptr Any -> Ptr Word8
forall a b. Ptr a -> Ptr b
castPtr Ptr Any
tagPtr)
ByteString
ctBS <- CStringLen -> IO ByteString
B.unsafePackMallocCStringLen (Ptr Any -> CString
forall a b. Ptr a -> Ptr b
castPtr Ptr Any
ctPtr, ByteString -> Int
B.length ByteString
pt)
ByteString
tagBS <- CStringLen -> IO ByteString
B.unsafePackMallocCStringLen (Ptr Any -> CString
forall a b. Ptr a -> Ptr b
castPtr Ptr Any
tagPtr, Int
maxTagLen)
(ByteString, AuthTag) -> IO (ByteString, AuthTag)
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString
ctBS, ByteString -> AuthTag
AuthTag ByteString
tagBS)
encryptGCMPtr :: AES_GCM k
=> GCMCtx k
-> Ptr Word8
-> Int
-> Ptr Word8
-> Int
-> Ptr Word8
-> Int
-> Ptr Word8
-> Ptr Word8
-> IO ()
encryptGCMPtr :: GCMCtx k
-> Ptr Word8
-> Int
-> Ptr Word8
-> Int
-> Ptr Word8
-> Int
-> Ptr Word8
-> Ptr Word8
-> IO ()
encryptGCMPtr (GCMCtx {k
GCMpc
gcmpc :: GCMpc
gcmkey :: k
gcmpc :: forall k. GCMCtx k -> GCMpc
gcmkey :: forall k. GCMCtx k -> k
..}) Ptr Word8
ivPtr Int
ivLen
Ptr Word8
ptPtr Int
ptLen
Ptr Word8
aadPtr Int
aadLen
Ptr Word8
ctPtr
Ptr Word8
tagPtr =
do k
-> GCMpc
-> Ptr Word8
-> Word32
-> Ptr Word8
-> Word32
-> Ptr Word8
-> Word32
-> Ptr Word8
-> Ptr Word8
-> IO ()
forall k.
GetExpanded k =>
k
-> GCMpc
-> Ptr Word8
-> Word32
-> Ptr Word8
-> Word32
-> Ptr Word8
-> Word32
-> Ptr Word8
-> Ptr Word8
-> IO ()
I.encryptGCM k
gcmkey GCMpc
gcmpc
(Ptr Word8 -> Ptr Word8
forall a b. Ptr a -> Ptr b
castPtr Ptr Word8
ivPtr) (Int -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
ivLen)
(Ptr Word8 -> Ptr Word8
forall a b. Ptr a -> Ptr b
castPtr Ptr Word8
aadPtr) (Int -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
aadLen)
(Ptr Word8 -> Ptr Word8
forall a b. Ptr a -> Ptr b
castPtr Ptr Word8
ptPtr) (Int -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
ptLen)
(Ptr Word8 -> Ptr Word8
forall a b. Ptr a -> Ptr b
castPtr Ptr Word8
ctPtr)
(Ptr Word8 -> Ptr Word8
forall a b. Ptr a -> Ptr b
castPtr Ptr Word8
tagPtr)
decryptGCM :: AES_GCM k
=> GCMCtx k
-> ByteString
-> ByteString
-> ByteString
-> (ByteString, AuthTag)
decryptGCM :: GCMCtx k
-> ByteString -> ByteString -> ByteString -> (ByteString, AuthTag)
decryptGCM GCMCtx k
gcmdata ByteString
iv ByteString
ct ByteString
aad = IO (ByteString, AuthTag) -> (ByteString, AuthTag)
forall a. IO a -> a
unsafePerformIO (IO (ByteString, AuthTag) -> (ByteString, AuthTag))
-> IO (ByteString, AuthTag) -> (ByteString, AuthTag)
forall a b. (a -> b) -> a -> b
$ do
let ivLen :: Int
ivLen = ByteString -> Int
B.length ByteString
iv
tagLen :: Int
tagLen = Int
maxTagLen
ctLen :: Int
ctLen = ByteString -> Int
B.length ByteString
ct
ByteString
-> (CString -> IO (ByteString, AuthTag))
-> IO (ByteString, AuthTag)
forall a. ByteString -> (CString -> IO a) -> IO a
B.unsafeUseAsCString ByteString
iv ((CString -> IO (ByteString, AuthTag)) -> IO (ByteString, AuthTag))
-> (CString -> IO (ByteString, AuthTag))
-> IO (ByteString, AuthTag)
forall a b. (a -> b) -> a -> b
$ \CString
ivPtr -> do
ByteString
-> (CString -> IO (ByteString, AuthTag))
-> IO (ByteString, AuthTag)
forall a. ByteString -> (CString -> IO a) -> IO a
B.unsafeUseAsCString ByteString
ct ((CString -> IO (ByteString, AuthTag)) -> IO (ByteString, AuthTag))
-> (CString -> IO (ByteString, AuthTag))
-> IO (ByteString, AuthTag)
forall a b. (a -> b) -> a -> b
$ \CString
ctPtr -> do
ByteString
-> (CString -> IO (ByteString, AuthTag))
-> IO (ByteString, AuthTag)
forall a. ByteString -> (CString -> IO a) -> IO a
B.unsafeUseAsCString ByteString
aad ((CString -> IO (ByteString, AuthTag)) -> IO (ByteString, AuthTag))
-> (CString -> IO (ByteString, AuthTag))
-> IO (ByteString, AuthTag)
forall a b. (a -> b) -> a -> b
$ \CString
aadPtr -> do
Ptr Any
tagPtr <- Int -> IO (Ptr Any)
forall a. Int -> IO (Ptr a)
F.mallocBytes Int
tagLen
Ptr Any
ptPtr <- Int -> IO (Ptr Any)
forall a. Int -> IO (Ptr a)
F.mallocBytes Int
ctLen
GCMCtx k
-> Ptr Word8
-> Int
-> Ptr Word8
-> Int
-> Ptr Word8
-> Int
-> Ptr Word8
-> Ptr Word8
-> IO ()
forall k.
AES_GCM k =>
GCMCtx k
-> Ptr Word8
-> Int
-> Ptr Word8
-> Int
-> Ptr Word8
-> Int
-> Ptr Word8
-> Ptr Word8
-> IO ()
decryptGCM_ptr GCMCtx k
gcmdata
(CString -> Ptr Word8
forall a b. Ptr a -> Ptr b
castPtr CString
ivPtr) Int
ivLen
(CString -> Ptr Word8
forall a b. Ptr a -> Ptr b
castPtr CString
ctPtr) Int
ctLen
(CString -> Ptr Word8
forall a b. Ptr a -> Ptr b
castPtr CString
aadPtr) (ByteString -> Int
B.length ByteString
aad)
(Ptr Any -> Ptr Word8
forall a b. Ptr a -> Ptr b
castPtr Ptr Any
ptPtr)
(Ptr Any -> Ptr Word8
forall a b. Ptr a -> Ptr b
castPtr Ptr Any
tagPtr)
ByteString
tagBS <- CStringLen -> IO ByteString
B.unsafePackMallocCStringLen (Ptr Any -> CString
forall a b. Ptr a -> Ptr b
castPtr Ptr Any
tagPtr,Int
tagLen)
ByteString
ptBS <- CStringLen -> IO ByteString
B.unsafePackMallocCStringLen (Ptr Any -> CString
forall a b. Ptr a -> Ptr b
castPtr Ptr Any
ptPtr, Int
ctLen)
(ByteString, AuthTag) -> IO (ByteString, AuthTag)
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString
ptBS, ByteString -> AuthTag
AuthTag ByteString
tagBS)
decryptGCM_ptr :: AES_GCM k
=> GCMCtx k
-> Ptr Word8 -> Int
-> Ptr Word8 -> Int
-> Ptr Word8 -> Int
-> Ptr Word8
-> Ptr Word8
-> IO ()
decryptGCM_ptr :: GCMCtx k
-> Ptr Word8
-> Int
-> Ptr Word8
-> Int
-> Ptr Word8
-> Int
-> Ptr Word8
-> Ptr Word8
-> IO ()
decryptGCM_ptr (GCMCtx {k
GCMpc
gcmpc :: GCMpc
gcmkey :: k
gcmpc :: forall k. GCMCtx k -> GCMpc
gcmkey :: forall k. GCMCtx k -> k
..})
Ptr Word8
ivPtr Int
ivLen
Ptr Word8
ctPtr Int
ctLen
Ptr Word8
aadPtr Int
aadLen
Ptr Word8
ptPtr
Ptr Word8
tagPtr =
k
-> GCMpc
-> Ptr Word8
-> Word32
-> Ptr Word8
-> Word32
-> Ptr Word8
-> Word32
-> Ptr Word8
-> Ptr Word8
-> IO ()
forall k.
GetExpanded k =>
k
-> GCMpc
-> Ptr Word8
-> Word32
-> Ptr Word8
-> Word32
-> Ptr Word8
-> Word32
-> Ptr Word8
-> Ptr Word8
-> IO ()
I.decryptGCM k
gcmkey GCMpc
gcmpc
Ptr Word8
ivPtr (Int -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
ivLen)
Ptr Word8
aadPtr (Int -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
aadLen)
Ptr Word8
ctPtr (Int -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
ctLen)
Ptr Word8
ptPtr
Ptr Word8
tagPtr