{-# LANGUAGE ExistentialQuantification #-}
{-# LANGUAGE Rank2Types #-}
module Crypto.Cipher.Types.AEAD where
import Crypto.Cipher.Types.Base
import Crypto.Internal.ByteArray (ByteArrayAccess, ByteArray)
import qualified Crypto.Internal.ByteArray as B
import Crypto.Internal.Imports
data AEADModeImpl st = AEADModeImpl
{ :: forall ba . ByteArrayAccess ba => st -> ba -> st
, forall st.
AEADModeImpl st -> forall ba. ByteArray ba => st -> ba -> (ba, st)
aeadImplEncrypt :: forall ba . ByteArray ba => st -> ba -> (ba, st)
, forall st.
AEADModeImpl st -> forall ba. ByteArray ba => st -> ba -> (ba, st)
aeadImplDecrypt :: forall ba . ByteArray ba => st -> ba -> (ba, st)
, forall st. AEADModeImpl st -> st -> Int -> AuthTag
aeadImplFinalize :: st -> Int -> AuthTag
}
data AEAD cipher = forall st . AEAD
{ ()
aeadModeImpl :: AEADModeImpl st
, ()
aeadState :: !st
}
aeadAppendHeader :: ByteArrayAccess aad => AEAD cipher -> aad -> AEAD cipher
(AEAD AEADModeImpl st
impl st
st) aad
aad = AEADModeImpl st -> st -> AEAD cipher
forall cipher st. AEADModeImpl st -> st -> AEAD cipher
AEAD AEADModeImpl st
impl (st -> AEAD cipher) -> st -> AEAD cipher
forall a b. (a -> b) -> a -> b
$ AEADModeImpl st -> forall ba. ByteArrayAccess ba => st -> ba -> st
forall st.
AEADModeImpl st -> forall ba. ByteArrayAccess ba => st -> ba -> st
aeadImplAppendHeader AEADModeImpl st
impl st
st aad
aad
aeadEncrypt :: ByteArray ba => AEAD cipher -> ba -> (ba, AEAD cipher)
aeadEncrypt :: forall ba cipher.
ByteArray ba =>
AEAD cipher -> ba -> (ba, AEAD cipher)
aeadEncrypt (AEAD AEADModeImpl st
impl st
st) ba
ba = (st -> AEAD cipher) -> (ba, st) -> (ba, AEAD cipher)
forall b c d. (b -> c) -> (d, b) -> (d, c)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second (AEADModeImpl st -> st -> AEAD cipher
forall cipher st. AEADModeImpl st -> st -> AEAD cipher
AEAD AEADModeImpl st
impl) ((ba, st) -> (ba, AEAD cipher)) -> (ba, st) -> (ba, AEAD cipher)
forall a b. (a -> b) -> a -> b
$ AEADModeImpl st -> forall ba. ByteArray ba => st -> ba -> (ba, st)
forall st.
AEADModeImpl st -> forall ba. ByteArray ba => st -> ba -> (ba, st)
aeadImplEncrypt AEADModeImpl st
impl st
st ba
ba
aeadDecrypt :: ByteArray ba => AEAD cipher -> ba -> (ba, AEAD cipher)
aeadDecrypt :: forall ba cipher.
ByteArray ba =>
AEAD cipher -> ba -> (ba, AEAD cipher)
aeadDecrypt (AEAD AEADModeImpl st
impl st
st) ba
ba = (st -> AEAD cipher) -> (ba, st) -> (ba, AEAD cipher)
forall b c d. (b -> c) -> (d, b) -> (d, c)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second (AEADModeImpl st -> st -> AEAD cipher
forall cipher st. AEADModeImpl st -> st -> AEAD cipher
AEAD AEADModeImpl st
impl) ((ba, st) -> (ba, AEAD cipher)) -> (ba, st) -> (ba, AEAD cipher)
forall a b. (a -> b) -> a -> b
$ AEADModeImpl st -> forall ba. ByteArray ba => st -> ba -> (ba, st)
forall st.
AEADModeImpl st -> forall ba. ByteArray ba => st -> ba -> (ba, st)
aeadImplDecrypt AEADModeImpl st
impl st
st ba
ba
aeadFinalize :: AEAD cipher -> Int -> AuthTag
aeadFinalize :: forall cipher. AEAD cipher -> Int -> AuthTag
aeadFinalize (AEAD AEADModeImpl st
impl st
st) = AEADModeImpl st -> st -> Int -> AuthTag
forall st. AEADModeImpl st -> st -> Int -> AuthTag
aeadImplFinalize AEADModeImpl st
impl st
st
aeadSimpleEncrypt :: (ByteArrayAccess aad, ByteArray ba)
=> AEAD a
-> aad
-> ba
-> Int
-> (AuthTag, ba)
aeadSimpleEncrypt :: forall aad ba a.
(ByteArrayAccess aad, ByteArray ba) =>
AEAD a -> aad -> ba -> Int -> (AuthTag, ba)
aeadSimpleEncrypt AEAD a
aeadIni aad
header ba
input Int
taglen = (AuthTag
tag, ba
output)
where aead :: AEAD a
aead = AEAD a -> aad -> AEAD a
forall aad cipher.
ByteArrayAccess aad =>
AEAD cipher -> aad -> AEAD cipher
aeadAppendHeader AEAD a
aeadIni aad
header
(ba
output, AEAD a
aeadFinal) = AEAD a -> ba -> (ba, AEAD a)
forall ba cipher.
ByteArray ba =>
AEAD cipher -> ba -> (ba, AEAD cipher)
aeadEncrypt AEAD a
aead ba
input
tag :: AuthTag
tag = AEAD a -> Int -> AuthTag
forall cipher. AEAD cipher -> Int -> AuthTag
aeadFinalize AEAD a
aeadFinal Int
taglen
aeadSimpleDecrypt :: (ByteArrayAccess aad, ByteArray ba)
=> AEAD a
-> aad
-> ba
-> AuthTag
-> Maybe ba
aeadSimpleDecrypt :: forall aad ba a.
(ByteArrayAccess aad, ByteArray ba) =>
AEAD a -> aad -> ba -> AuthTag -> Maybe ba
aeadSimpleDecrypt AEAD a
aeadIni aad
header ba
input AuthTag
authTag
| AuthTag
tag AuthTag -> AuthTag -> Bool
forall a. Eq a => a -> a -> Bool
== AuthTag
authTag = ba -> Maybe ba
forall a. a -> Maybe a
Just ba
output
| Bool
otherwise = Maybe ba
forall a. Maybe a
Nothing
where aead :: AEAD a
aead = AEAD a -> aad -> AEAD a
forall aad cipher.
ByteArrayAccess aad =>
AEAD cipher -> aad -> AEAD cipher
aeadAppendHeader AEAD a
aeadIni aad
header
(ba
output, AEAD a
aeadFinal) = AEAD a -> ba -> (ba, AEAD a)
forall ba cipher.
ByteArray ba =>
AEAD cipher -> ba -> (ba, AEAD cipher)
aeadDecrypt AEAD a
aead ba
input
tag :: AuthTag
tag = AEAD a -> Int -> AuthTag
forall cipher. AEAD cipher -> Int -> AuthTag
aeadFinalize AEAD a
aeadFinal (AuthTag -> Int
forall ba. ByteArrayAccess ba => ba -> Int
B.length AuthTag
authTag)