{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
module Crypto.Token (
Config(..)
, defaultConfig
, TokenManager
, spawnTokenManager
, killTokenManager
, encryptToken
, decryptToken
) where
import Control.Concurrent
import Crypto.Cipher.AES (AES256)
import Crypto.Cipher.Types (AuthTag(..), AEADMode(..))
import qualified Crypto.Cipher.Types as C
import Crypto.Error (maybeCryptoError, throwCryptoError)
import Crypto.Random (getRandomBytes)
import Data.Array.IO
import Data.Bits (xor)
import Data.ByteArray (ByteArray, Bytes)
import qualified Data.ByteArray as BA
import qualified Data.IORef as I
import Data.Int (Int64)
import Data.Word (Word16, Word64)
import Foreign.Ptr
import Foreign.Storable
data Config = Config {
Config -> Int
interval :: Int
, Config -> Int
maxEntries :: Int
}
defaultConfig :: Config
defaultConfig :: Config
defaultConfig = Config :: Int -> Int -> Config
Config {
interval :: Int
interval = Int
30
, maxEntries :: Int
maxEntries = Int
480
}
data TokenManager = TokenManager {
TokenManager -> IOArray Int Secret
secrets :: IOArray Int Secret
, TokenManager -> IORef Int
currentIndex :: I.IORef Int
, :: Header
, TokenManager -> ThreadId
threadId :: ThreadId
}
spawnTokenManager :: Config -> IO TokenManager
spawnTokenManager :: Config -> IO TokenManager
spawnTokenManager Config{Int
maxEntries :: Int
interval :: Int
maxEntries :: Config -> Int
interval :: Config -> Int
..} = do
Secret
emp <- IO Secret
emptySecret
let lim :: Int
lim = (Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
256 (Int -> Int -> Int
forall a. Ord a => a -> a -> a
min Int
maxEntries Int
32767)) Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1
IOArray Int Secret
arr <- (Int, Int) -> Secret -> IO (IOArray Int Secret)
forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
(i, i) -> e -> m (a i e)
newArray (Int
0, Int
lim) Secret
emp
IOArray Int Secret -> Int -> IO ()
update IOArray Int Secret
arr Int
0
IORef Int
ref <- Int -> IO (IORef Int)
forall a. a -> IO (IORef a)
I.newIORef Int
0
ThreadId
tid <- IO () -> IO ThreadId
forkIO (IO () -> IO ThreadId) -> IO () -> IO ThreadId
forall a b. (a -> b) -> a -> b
$ IOArray Int Secret -> IORef Int -> IO ()
forall b. IOArray Int Secret -> IORef Int -> IO b
loop IOArray Int Secret
arr IORef Int
ref
Header
msk <- IO Header
newHeaderMask
TokenManager -> IO TokenManager
forall (m :: * -> *) a. Monad m => a -> m a
return (TokenManager -> IO TokenManager)
-> TokenManager -> IO TokenManager
forall a b. (a -> b) -> a -> b
$ IOArray Int Secret
-> IORef Int -> Header -> ThreadId -> TokenManager
TokenManager IOArray Int Secret
arr IORef Int
ref Header
msk ThreadId
tid
where
update :: IOArray Int Secret -> Int -> IO ()
update :: IOArray Int Secret -> Int -> IO ()
update IOArray Int Secret
arr Int
idx = do
Secret
ent <- IO Secret
generateSecret
IOArray Int Secret -> Int -> Secret -> IO ()
forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> i -> e -> m ()
writeArray IOArray Int Secret
arr Int
idx Secret
ent
loop :: IOArray Int Secret -> IORef Int -> IO b
loop IOArray Int Secret
arr IORef Int
ref = do
Int -> IO ()
threadDelay (Int
interval Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
60 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
1000000)
Int
idx0 <- IORef Int -> IO Int
forall a. IORef a -> IO a
I.readIORef IORef Int
ref
(Int
_, Int
n) <- IOArray Int Secret -> IO (Int, Int)
forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> m (i, i)
getBounds IOArray Int Secret
arr
let idx :: Int
idx = (Int
idx0 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
IOArray Int Secret -> Int -> IO ()
update IOArray Int Secret
arr Int
idx
IORef Int -> Int -> IO ()
forall a. IORef a -> a -> IO ()
I.writeIORef IORef Int
ref Int
idx
IOArray Int Secret -> IORef Int -> IO b
loop IOArray Int Secret
arr IORef Int
ref
killTokenManager :: TokenManager -> IO ()
killTokenManager :: TokenManager -> IO ()
killTokenManager TokenManager{IOArray Int Secret
ThreadId
IORef Int
Header
threadId :: ThreadId
headerMask :: Header
currentIndex :: IORef Int
secrets :: IOArray Int Secret
threadId :: TokenManager -> ThreadId
headerMask :: TokenManager -> Header
currentIndex :: TokenManager -> IORef Int
secrets :: TokenManager -> IOArray Int Secret
..} = ThreadId -> IO ()
killThread ThreadId
threadId
getSecret :: TokenManager -> Int -> IO Secret
getSecret :: TokenManager -> Int -> IO Secret
getSecret TokenManager{IOArray Int Secret
ThreadId
IORef Int
Header
threadId :: ThreadId
headerMask :: Header
currentIndex :: IORef Int
secrets :: IOArray Int Secret
threadId :: TokenManager -> ThreadId
headerMask :: TokenManager -> Header
currentIndex :: TokenManager -> IORef Int
secrets :: TokenManager -> IOArray Int Secret
..} Int
idx0 = do
(Int
_, Int
n) <- IOArray Int Secret -> IO (Int, Int)
forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> m (i, i)
getBounds IOArray Int Secret
secrets
let idx :: Int
idx = Int
idx0 Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
IOArray Int Secret -> Int -> IO Secret
forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> i -> m e
readArray IOArray Int Secret
secrets Int
idx
data Secret = Secret {
Secret -> Bytes
secretIV :: Bytes
, Secret -> Bytes
secretKey :: Bytes
, Secret -> IORef Int64
secretCounter :: I.IORef Int64
}
emptySecret :: IO Secret
emptySecret :: IO Secret
emptySecret = Bytes -> Bytes -> IORef Int64 -> Secret
Secret Bytes
forall a. ByteArray a => a
BA.empty Bytes
forall a. ByteArray a => a
BA.empty (IORef Int64 -> Secret) -> IO (IORef Int64) -> IO Secret
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int64 -> IO (IORef Int64)
forall a. a -> IO (IORef a)
I.newIORef Int64
0
generateSecret :: IO Secret
generateSecret :: IO Secret
generateSecret = Bytes -> Bytes -> IORef Int64 -> Secret
Secret (Bytes -> Bytes -> IORef Int64 -> Secret)
-> IO Bytes -> IO (Bytes -> IORef Int64 -> Secret)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO Bytes
genIV
IO (Bytes -> IORef Int64 -> Secret)
-> IO Bytes -> IO (IORef Int64 -> Secret)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> IO Bytes
genKey
IO (IORef Int64 -> Secret) -> IO (IORef Int64) -> IO Secret
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Int64 -> IO (IORef Int64)
forall a. a -> IO (IORef a)
I.newIORef Int64
0
genKey :: IO Bytes
genKey :: IO Bytes
genKey = Int -> IO Bytes
forall (m :: * -> *) byteArray.
(MonadRandom m, ByteArray byteArray) =>
Int -> m byteArray
getRandomBytes Int
keyLength
genIV :: IO Bytes
genIV :: IO Bytes
genIV = Int -> IO Bytes
forall (m :: * -> *) byteArray.
(MonadRandom m, ByteArray byteArray) =>
Int -> m byteArray
getRandomBytes Int
ivLength
ivLength :: Int
ivLength :: Int
ivLength = Int
8
keyLength :: Int
keyLength :: Int
keyLength = Int
32
indexLength :: Int
indexLength :: Int
indexLength = Int
2
counterLength :: Int
counterLength :: Int
counterLength = Int
8
tagLength :: Int
tagLength :: Int
tagLength = Int
16
data = {
:: Word16
, :: Word64
}
instance Storable Header where
sizeOf :: Header -> Int
sizeOf Header
_ = Int
indexLength Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
counterLength
alignment :: Header -> Int
alignment Header
_ = Int
indexLength
peek :: Ptr Header -> IO Header
peek Ptr Header
p = do
Word16
i <- Ptr Word16 -> IO Word16
forall a. Storable a => Ptr a -> IO a
peek (Ptr Word16 -> IO Word16) -> Ptr Word16 -> IO Word16
forall a b. (a -> b) -> a -> b
$ Ptr Header -> Ptr Word16
forall a b. Ptr a -> Ptr b
castPtr Ptr Header
p
Word64
c <- Ptr Word64 -> IO Word64
forall a. Storable a => Ptr a -> IO a
peek (Ptr Header -> Ptr Any
forall a b. Ptr a -> Ptr b
castPtr Ptr Header
p Ptr Any -> Int -> Ptr Word64
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
indexLength)
Header -> IO Header
forall (m :: * -> *) a. Monad m => a -> m a
return (Header -> IO Header) -> Header -> IO Header
forall a b. (a -> b) -> a -> b
$ Word16 -> Word64 -> Header
Header Word16
i Word64
c
poke :: Ptr Header -> Header -> IO ()
poke Ptr Header
p (Header Word16
i Word64
c) = do
Ptr Word16 -> Word16 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr Header -> Ptr Word16
forall a b. Ptr a -> Ptr b
castPtr Ptr Header
p) Word16
i
Ptr Word64 -> Word64 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr Header -> Ptr Any
forall a b. Ptr a -> Ptr b
castPtr Ptr Header
p Ptr Any -> Int -> Ptr Word64
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
indexLength) Word64
c
newHeaderMask :: IO Header
= do
Bytes
bin <- Int -> IO Bytes
forall (m :: * -> *) byteArray.
(MonadRandom m, ByteArray byteArray) =>
Int -> m byteArray
getRandomBytes (Int
indexLength Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
counterLength) :: IO Bytes
Bytes -> (Ptr Header -> IO Header) -> IO Header
forall ba p a. ByteArrayAccess ba => ba -> (Ptr p -> IO a) -> IO a
BA.withByteArray Bytes
bin Ptr Header -> IO Header
forall a. Storable a => Ptr a -> IO a
peek
xorHeader :: Header -> Header -> Header
Header
x Header
y = Header :: Word16 -> Word64 -> Header
Header {
headerIndex :: Word16
headerIndex = Header -> Word16
headerIndex Header
x Word16 -> Word16 -> Word16
forall a. Bits a => a -> a -> a
`xor` Header -> Word16
headerIndex Header
y
, headerCounter :: Word64
headerCounter = Header -> Word64
headerCounter Header
x Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
`xor` Header -> Word64
headerCounter Header
y
}
addHeader :: ByteArray ba => TokenManager -> Int -> Int64 -> ba -> IO ba
TokenManager{IOArray Int Secret
ThreadId
IORef Int
Header
threadId :: ThreadId
headerMask :: Header
currentIndex :: IORef Int
secrets :: IOArray Int Secret
threadId :: TokenManager -> ThreadId
headerMask :: TokenManager -> Header
currentIndex :: TokenManager -> IORef Int
secrets :: TokenManager -> IOArray Int Secret
..} Int
idx Int64
counter ba
cipher = do
let hdr :: Header
hdr = Word16 -> Word64 -> Header
Header (Int -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
idx) (Int64 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int64
counter)
mskhdr :: Header
mskhdr = Header
headerMask Header -> Header -> Header
`xorHeader` Header
hdr
ba
hdrbin <- Int -> (Ptr Header -> IO ()) -> IO ba
forall ba p. ByteArray ba => Int -> (Ptr p -> IO ()) -> IO ba
BA.create (Header -> Int
forall a. Storable a => a -> Int
sizeOf Header
mskhdr) ((Ptr Header -> IO ()) -> IO ba) -> (Ptr Header -> IO ()) -> IO ba
forall a b. (a -> b) -> a -> b
$ \Ptr Header
ptr -> Ptr Header -> Header -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr Header
ptr Header
mskhdr
ba -> IO ba
forall (m :: * -> *) a. Monad m => a -> m a
return (ba
hdrbin ba -> ba -> ba
forall bs. ByteArray bs => bs -> bs -> bs
`BA.append` ba
cipher)
delHeader :: ByteArray ba => TokenManager -> ba -> IO (Maybe (Int, Int64, ba))
TokenManager{IOArray Int Secret
ThreadId
IORef Int
Header
threadId :: ThreadId
headerMask :: Header
currentIndex :: IORef Int
secrets :: IOArray Int Secret
threadId :: TokenManager -> ThreadId
headerMask :: TokenManager -> Header
currentIndex :: TokenManager -> IORef Int
secrets :: TokenManager -> IOArray Int Secret
..} ba
token
| ba -> Int
forall ba. ByteArrayAccess ba => ba -> Int
BA.length ba
token Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
minlen = Maybe (Int, Int64, ba) -> IO (Maybe (Int, Int64, ba))
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (Int, Int64, ba)
forall a. Maybe a
Nothing
| Bool
otherwise = do
let (ba
hdrbin, ba
cipher) = Int -> ba -> (ba, ba)
forall bs. ByteArray bs => Int -> bs -> (bs, bs)
BA.splitAt Int
minlen ba
token
Header
mskhdr <- ba -> (Ptr Header -> IO Header) -> IO Header
forall ba p a. ByteArrayAccess ba => ba -> (Ptr p -> IO a) -> IO a
BA.withByteArray ba
hdrbin Ptr Header -> IO Header
forall a. Storable a => Ptr a -> IO a
peek
let hdr :: Header
hdr = Header
headerMask Header -> Header -> Header
`xorHeader` Header
mskhdr
idx :: Int
idx = Word16 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word16 -> Int) -> Word16 -> Int
forall a b. (a -> b) -> a -> b
$ Header -> Word16
headerIndex Header
hdr
counter :: Int64
counter = Word64 -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64 -> Int64) -> Word64 -> Int64
forall a b. (a -> b) -> a -> b
$ Header -> Word64
headerCounter Header
hdr
Maybe (Int, Int64, ba) -> IO (Maybe (Int, Int64, ba))
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (Int, Int64, ba) -> IO (Maybe (Int, Int64, ba)))
-> Maybe (Int, Int64, ba) -> IO (Maybe (Int, Int64, ba))
forall a b. (a -> b) -> a -> b
$ (Int, Int64, ba) -> Maybe (Int, Int64, ba)
forall a. a -> Maybe a
Just (Int
idx, Int64
counter, ba
cipher)
where
minlen :: Int
minlen = Int
indexLength Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
counterLength
encryptToken :: (Storable a, ByteArray ba)
=> TokenManager -> a -> IO ba
encryptToken :: TokenManager -> a -> IO ba
encryptToken TokenManager
mgr a
x = do
Int
idx <- IORef Int -> IO Int
forall a. IORef a -> IO a
I.readIORef (IORef Int -> IO Int) -> IORef Int -> IO Int
forall a b. (a -> b) -> a -> b
$ TokenManager -> IORef Int
currentIndex TokenManager
mgr
Secret
secret <- TokenManager -> Int -> IO Secret
getSecret TokenManager
mgr Int
idx
(Int64
counter, ba
cipher) <- Secret -> a -> IO (Int64, ba)
forall a ba.
(Storable a, ByteArray ba) =>
Secret -> a -> IO (Int64, ba)
encrypt Secret
secret a
x
TokenManager -> Int -> Int64 -> ba -> IO ba
forall ba.
ByteArray ba =>
TokenManager -> Int -> Int64 -> ba -> IO ba
addHeader TokenManager
mgr Int
idx Int64
counter ba
cipher
encrypt :: (Storable a, ByteArray ba)
=> Secret -> a -> IO (Int64, ba)
encrypt :: Secret -> a -> IO (Int64, ba)
encrypt Secret
secret a
x = do
Int64
counter <- IORef Int64 -> (Int64 -> (Int64, Int64)) -> IO Int64
forall a b. IORef a -> (a -> (a, b)) -> IO b
I.atomicModifyIORef' (Secret -> IORef Int64
secretCounter Secret
secret) (\Int64
i -> (Int64
iInt64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
+Int64
1, Int64
i))
ba
plain <- Int -> (Ptr a -> IO ()) -> IO ba
forall ba p. ByteArray ba => Int -> (Ptr p -> IO ()) -> IO ba
BA.create (a -> Int
forall a. Storable a => a -> Int
sizeOf a
x) ((Ptr a -> IO ()) -> IO ba) -> (Ptr a -> IO ()) -> IO ba
forall a b. (a -> b) -> a -> b
$ \Ptr a
ptr -> Ptr a -> a -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr a
ptr a
x
Bytes
nonce <- Int64 -> Bytes -> IO Bytes
forall ba. ByteArray ba => Int64 -> ba -> IO ba
makeNonce Int64
counter (Bytes -> IO Bytes) -> Bytes -> IO Bytes
forall a b. (a -> b) -> a -> b
$ Secret -> Bytes
secretIV Secret
secret
let cipher :: ba
cipher = ba -> Bytes -> Bytes -> ba
forall ba. ByteArray ba => ba -> Bytes -> Bytes -> ba
aes256gcmEncrypt ba
plain (Secret -> Bytes
secretKey Secret
secret) Bytes
nonce
(Int64, ba) -> IO (Int64, ba)
forall (m :: * -> *) a. Monad m => a -> m a
return (Int64
counter, ba
cipher)
decryptToken :: (Storable a, ByteArray ba)
=> TokenManager -> ba -> IO (Maybe a)
decryptToken :: TokenManager -> ba -> IO (Maybe a)
decryptToken TokenManager
mgr ba
token = do
Maybe (Int, Int64, ba)
mx <- TokenManager -> ba -> IO (Maybe (Int, Int64, ba))
forall ba.
ByteArray ba =>
TokenManager -> ba -> IO (Maybe (Int, Int64, ba))
delHeader TokenManager
mgr ba
token
case Maybe (Int, Int64, ba)
mx of
Maybe (Int, Int64, ba)
Nothing -> Maybe a -> IO (Maybe a)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe a
forall a. Maybe a
Nothing
Just (Int
idx, Int64
counter, ba
cipher) -> do
Secret
secret <- TokenManager -> Int -> IO Secret
getSecret TokenManager
mgr Int
idx
Secret -> Int64 -> ba -> IO (Maybe a)
forall a ba.
(Storable a, ByteArray ba) =>
Secret -> Int64 -> ba -> IO (Maybe a)
decrypt Secret
secret Int64
counter ba
cipher
decrypt :: forall a ba . (Storable a, ByteArray ba)
=> Secret -> Int64 -> ba -> IO (Maybe a)
decrypt :: Secret -> Int64 -> ba -> IO (Maybe a)
decrypt Secret
secret Int64
counter ba
cipher = do
Bytes
nonce <- Int64 -> Bytes -> IO Bytes
forall ba. ByteArray ba => Int64 -> ba -> IO ba
makeNonce Int64
counter (Bytes -> IO Bytes) -> Bytes -> IO Bytes
forall a b. (a -> b) -> a -> b
$ Secret -> Bytes
secretIV Secret
secret
let mplain :: Maybe ba
mplain = ba -> Bytes -> Bytes -> Maybe ba
forall ba. ByteArray ba => ba -> Bytes -> Bytes -> Maybe ba
aes256gcmDecrypt ba
cipher (Secret -> Bytes
secretKey Secret
secret) Bytes
nonce
expect :: Int
expect = a -> Int
forall a. Storable a => a -> Int
sizeOf (a
forall a. HasCallStack => a
undefined :: a)
case Maybe ba
mplain of
Just ba
plain
| ba -> Int
forall ba. ByteArrayAccess ba => ba -> Int
BA.length ba
plain Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
expect -> a -> Maybe a
forall a. a -> Maybe a
Just (a -> Maybe a) -> IO a -> IO (Maybe a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ba -> (Ptr a -> IO a) -> IO a
forall ba p a. ByteArrayAccess ba => ba -> (Ptr p -> IO a) -> IO a
BA.withByteArray ba
plain Ptr a -> IO a
forall a. Storable a => Ptr a -> IO a
peek
Maybe ba
_ -> Maybe a -> IO (Maybe a)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe a
forall a. Maybe a
Nothing
makeNonce :: forall ba . ByteArray ba => Int64 -> ba -> IO ba
makeNonce :: Int64 -> ba -> IO ba
makeNonce Int64
counter ba
iv = do
ba
cv <- Int -> (Ptr Int64 -> IO ()) -> IO ba
forall ba p. ByteArray ba => Int -> (Ptr p -> IO ()) -> IO ba
BA.create Int
ivLength ((Ptr Int64 -> IO ()) -> IO ba) -> (Ptr Int64 -> IO ()) -> IO ba
forall a b. (a -> b) -> a -> b
$ \Ptr Int64
ptr -> Ptr Int64 -> Int64 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr Int64
ptr Int64
counter
ba -> IO ba
forall (m :: * -> *) a. Monad m => a -> m a
return (ba -> IO ba) -> ba -> IO ba
forall a b. (a -> b) -> a -> b
$ ba
iv ba -> ba -> ba
forall a b c.
(ByteArrayAccess a, ByteArrayAccess b, ByteArray c) =>
a -> b -> c
`BA.xor` (ba
cv :: ba)
constantAdditionalData :: Bytes
constantAdditionalData :: Bytes
constantAdditionalData = Bytes
forall a. ByteArray a => a
BA.empty
aes256gcmEncrypt :: ByteArray ba
=> ba -> Bytes -> Bytes -> ba
aes256gcmEncrypt :: ba -> Bytes -> Bytes -> ba
aes256gcmEncrypt ba
plain Bytes
key Bytes
nonce = ba
cipher ba -> ba -> ba
forall bs. ByteArray bs => bs -> bs -> bs
`BA.append` Bytes -> ba
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
BA.convert Bytes
tag
where
conn :: AES256
conn = CryptoFailable AES256 -> AES256
forall a. CryptoFailable a -> a
throwCryptoError (Bytes -> CryptoFailable AES256
forall cipher key.
(Cipher cipher, ByteArray key) =>
key -> CryptoFailable cipher
C.cipherInit Bytes
key) :: AES256
aeadIni :: AEAD AES256
aeadIni = CryptoFailable (AEAD AES256) -> AEAD AES256
forall a. CryptoFailable a -> a
throwCryptoError (CryptoFailable (AEAD AES256) -> AEAD AES256)
-> CryptoFailable (AEAD AES256) -> AEAD AES256
forall a b. (a -> b) -> a -> b
$ AEADMode -> AES256 -> Bytes -> CryptoFailable (AEAD AES256)
forall cipher iv.
(BlockCipher cipher, ByteArrayAccess iv) =>
AEADMode -> cipher -> iv -> CryptoFailable (AEAD cipher)
C.aeadInit AEADMode
AEAD_GCM AES256
conn Bytes
nonce
(AuthTag Bytes
tag, ba
cipher) = AEAD AES256 -> Bytes -> ba -> Int -> (AuthTag, ba)
forall aad ba a.
(ByteArrayAccess aad, ByteArray ba) =>
AEAD a -> aad -> ba -> Int -> (AuthTag, ba)
C.aeadSimpleEncrypt AEAD AES256
aeadIni Bytes
constantAdditionalData ba
plain Int
tagLength
aes256gcmDecrypt :: ByteArray ba
=> ba -> Bytes -> Bytes -> Maybe ba
aes256gcmDecrypt :: ba -> Bytes -> Bytes -> Maybe ba
aes256gcmDecrypt ba
ctexttag Bytes
key Bytes
nonce = do
AES256
aes <- CryptoFailable AES256 -> Maybe AES256
forall a. CryptoFailable a -> Maybe a
maybeCryptoError (CryptoFailable AES256 -> Maybe AES256)
-> CryptoFailable AES256 -> Maybe AES256
forall a b. (a -> b) -> a -> b
$ Bytes -> CryptoFailable AES256
forall cipher key.
(Cipher cipher, ByteArray key) =>
key -> CryptoFailable cipher
C.cipherInit Bytes
key :: Maybe AES256
AEAD AES256
aead <- CryptoFailable (AEAD AES256) -> Maybe (AEAD AES256)
forall a. CryptoFailable a -> Maybe a
maybeCryptoError (CryptoFailable (AEAD AES256) -> Maybe (AEAD AES256))
-> CryptoFailable (AEAD AES256) -> Maybe (AEAD AES256)
forall a b. (a -> b) -> a -> b
$ AEADMode -> AES256 -> Bytes -> CryptoFailable (AEAD AES256)
forall cipher iv.
(BlockCipher cipher, ByteArrayAccess iv) =>
AEADMode -> cipher -> iv -> CryptoFailable (AEAD cipher)
C.aeadInit AEADMode
AEAD_GCM AES256
aes Bytes
nonce
let (ba
ctext, ba
tag) = Int -> ba -> (ba, ba)
forall bs. ByteArray bs => Int -> bs -> (bs, bs)
BA.splitAt (ba -> Int
forall ba. ByteArrayAccess ba => ba -> Int
BA.length ba
ctexttag Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
tagLength) ba
ctexttag
authtag :: AuthTag
authtag = Bytes -> AuthTag
AuthTag (Bytes -> AuthTag) -> Bytes -> AuthTag
forall a b. (a -> b) -> a -> b
$ ba -> Bytes
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
BA.convert ba
tag
AEAD AES256 -> Bytes -> ba -> AuthTag -> Maybe ba
forall aad ba a.
(ByteArrayAccess aad, ByteArray ba) =>
AEAD a -> aad -> ba -> AuthTag -> Maybe ba
C.aeadSimpleDecrypt AEAD AES256
aead Bytes
constantAdditionalData ba
ctext AuthTag
authtag