module Network.QUIC.CryptoFusion (
    FusionContext
  , fusionNewContext
  , fusionSetup
  , fusionEncrypt
  , fusionDecrypt
  , Supplement
  , fusionSetupSupplement
  , fusionSetSample
  , fusionGetMask
  ) where

import Foreign.C.Types
import Foreign.Ptr
import Foreign.ForeignPtr
import Network.TLS.Extra.Cipher

import Network.QUIC.Crypto
import Network.QUIC.Imports
import Network.QUIC.Types

----------------------------------------------------------------

data FusionContextOpaque
newtype FusionContext = FC (ForeignPtr FusionContextOpaque)

fusionNewContext :: IO FusionContext
fusionNewContext :: IO FusionContext
fusionNewContext = ForeignPtr FusionContextOpaque -> FusionContext
FC (ForeignPtr FusionContextOpaque -> FusionContext)
-> IO (ForeignPtr FusionContextOpaque) -> IO FusionContext
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (IO (Ptr FusionContextOpaque)
c_aead_context_new IO (Ptr FusionContextOpaque)
-> (Ptr FusionContextOpaque -> IO (ForeignPtr FusionContextOpaque))
-> IO (ForeignPtr FusionContextOpaque)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= FinalizerPtr FusionContextOpaque
-> Ptr FusionContextOpaque -> IO (ForeignPtr FusionContextOpaque)
forall a. FinalizerPtr a -> Ptr a -> IO (ForeignPtr a)
newForeignPtr FinalizerPtr FusionContextOpaque
p_aead_context_free)

----------------------------------------------------------------

fusionSetup :: Cipher -> FusionContext -> Key -> IV -> IO ()
fusionSetup :: Cipher -> FusionContext -> Key -> IV -> IO ()
fusionSetup Cipher
cipher
  | Cipher
cipher Cipher -> Cipher -> Bool
forall a. Eq a => a -> a -> Bool
== Cipher
cipher_TLS13_AES128GCM_SHA256        = FusionContext -> Key -> IV -> IO ()
fusionSetupAES128
  | Cipher
cipher Cipher -> Cipher -> Bool
forall a. Eq a => a -> a -> Bool
== Cipher
cipher_TLS13_AES256GCM_SHA384        = FusionContext -> Key -> IV -> IO ()
fusionSetupAES256
  | Bool
otherwise                                      = [Char] -> FusionContext -> Key -> IV -> IO ()
forall a. HasCallStack => [Char] -> a
error [Char]
"fusionSetup"

fusionSetupAES128 :: FusionContext -> Key -> IV -> IO ()
fusionSetupAES128 :: FusionContext -> Key -> IV -> IO ()
fusionSetupAES128 (FC ForeignPtr FusionContextOpaque
fctx) (Key ByteString
key) (IV ByteString
iv) = ForeignPtr FusionContextOpaque
-> (Ptr FusionContextOpaque -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr FusionContextOpaque
fctx ((Ptr FusionContextOpaque -> IO ()) -> IO ())
-> (Ptr FusionContextOpaque -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr FusionContextOpaque
pctx ->
    ByteString -> (Ptr Word8 -> IO ()) -> IO ()
forall a. ByteString -> (Ptr Word8 -> IO a) -> IO a
withByteString ByteString
key ((Ptr Word8 -> IO ()) -> IO ()) -> (Ptr Word8 -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
keyp ->
        ByteString -> (Ptr Word8 -> IO ()) -> IO ()
forall a. ByteString -> (Ptr Word8 -> IO a) -> IO a
withByteString ByteString
iv ((Ptr Word8 -> IO ()) -> IO ()) -> (Ptr Word8 -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
ivp -> IO CInt -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO CInt -> IO ()) -> IO CInt -> IO ()
forall a b. (a -> b) -> a -> b
$ Ptr FusionContextOpaque
-> CInt -> Ptr Word8 -> Ptr Word8 -> IO CInt
c_aes128gcm_setup Ptr FusionContextOpaque
pctx CInt
0 Ptr Word8
keyp Ptr Word8
ivp

fusionSetupAES256 :: FusionContext -> Key -> IV -> IO ()
fusionSetupAES256 :: FusionContext -> Key -> IV -> IO ()
fusionSetupAES256 (FC ForeignPtr FusionContextOpaque
fctx) (Key ByteString
key) (IV ByteString
iv) = ForeignPtr FusionContextOpaque
-> (Ptr FusionContextOpaque -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr FusionContextOpaque
fctx ((Ptr FusionContextOpaque -> IO ()) -> IO ())
-> (Ptr FusionContextOpaque -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr FusionContextOpaque
pctx ->
    ByteString -> (Ptr Word8 -> IO ()) -> IO ()
forall a. ByteString -> (Ptr Word8 -> IO a) -> IO a
withByteString ByteString
key ((Ptr Word8 -> IO ()) -> IO ()) -> (Ptr Word8 -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
keyp ->
        ByteString -> (Ptr Word8 -> IO ()) -> IO ()
forall a. ByteString -> (Ptr Word8 -> IO a) -> IO a
withByteString ByteString
iv ((Ptr Word8 -> IO ()) -> IO ()) -> (Ptr Word8 -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
ivp -> IO CInt -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO CInt -> IO ()) -> IO CInt -> IO ()
forall a b. (a -> b) -> a -> b
$ Ptr FusionContextOpaque
-> CInt -> Ptr Word8 -> Ptr Word8 -> IO CInt
c_aes256gcm_setup Ptr FusionContextOpaque
pctx CInt
0 Ptr Word8
keyp Ptr Word8
ivp

----------------------------------------------------------------

fusionEncrypt :: FusionContext -> Supplement -> Buffer -> Int -> Buffer -> Int -> PacketNumber -> Buffer -> IO Int
fusionEncrypt :: FusionContext
-> Supplement
-> Ptr Word8
-> Int
-> Ptr Word8
-> Int
-> Int
-> Ptr Word8
-> IO Int
fusionEncrypt (FC ForeignPtr FusionContextOpaque
fctx) (SP ForeignPtr SupplementOpaque
fsupp) Ptr Word8
ibuf Int
ilen Ptr Word8
abuf Int
alen Int
pn Ptr Word8
obuf =
    ForeignPtr FusionContextOpaque
-> (Ptr FusionContextOpaque -> IO Int) -> IO Int
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr FusionContextOpaque
fctx ((Ptr FusionContextOpaque -> IO Int) -> IO Int)
-> (Ptr FusionContextOpaque -> IO Int) -> IO Int
forall a b. (a -> b) -> a -> b
$ \Ptr FusionContextOpaque
pctx -> ForeignPtr SupplementOpaque
-> (Ptr SupplementOpaque -> IO Int) -> IO Int
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr SupplementOpaque
fsupp ((Ptr SupplementOpaque -> IO Int) -> IO Int)
-> (Ptr SupplementOpaque -> IO Int) -> IO Int
forall a b. (a -> b) -> a -> b
$ \Ptr SupplementOpaque
psupp -> do
        Ptr FusionContextOpaque
-> Ptr Word8
-> Ptr Word8
-> CSize
-> CULong
-> Ptr Word8
-> CSize
-> Ptr SupplementOpaque
-> IO ()
c_aead_do_encrypt Ptr FusionContextOpaque
pctx Ptr Word8
obuf Ptr Word8
ibuf CSize
ilen' CULong
pn' Ptr Word8
abuf CSize
alen' Ptr SupplementOpaque
psupp
        Int -> IO Int
forall (m :: * -> *) a. Monad m => a -> m a
return (Int
ilen Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
16) -- fixme
  where
    pn' :: CULong
pn' = Int -> CULong
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
pn
    ilen' :: CSize
ilen' = Int -> CSize
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
ilen
    alen' :: CSize
alen' = Int -> CSize
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
alen

fusionDecrypt :: FusionContext -> Buffer -> Int -> Buffer -> Int -> PacketNumber -> Buffer -> IO Int
fusionDecrypt :: FusionContext
-> Ptr Word8
-> Int
-> Ptr Word8
-> Int
-> Int
-> Ptr Word8
-> IO Int
fusionDecrypt (FC ForeignPtr FusionContextOpaque
fctx) Ptr Word8
ibuf Int
ilen Ptr Word8
abuf Int
alen Int
pn Ptr Word8
buf =
    ForeignPtr FusionContextOpaque
-> (Ptr FusionContextOpaque -> IO Int) -> IO Int
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr FusionContextOpaque
fctx ((Ptr FusionContextOpaque -> IO Int) -> IO Int)
-> (Ptr FusionContextOpaque -> IO Int) -> IO Int
forall a b. (a -> b) -> a -> b
$ \Ptr FusionContextOpaque
pctx ->
        CSize -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (CSize -> Int) -> IO CSize -> IO Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr FusionContextOpaque
-> Ptr Word8
-> Ptr Word8
-> CSize
-> CULong
-> Ptr Word8
-> CSize
-> IO CSize
c_aead_do_decrypt Ptr FusionContextOpaque
pctx Ptr Word8
buf Ptr Word8
ibuf CSize
ilen' CULong
pn' Ptr Word8
abuf CSize
alen'
  where
    pn' :: CULong
pn' = Int -> CULong
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
pn
    ilen' :: CSize
ilen' = Int -> CSize
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
ilen
    alen' :: CSize
alen' = Int -> CSize
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
alen

----------------------------------------------------------------

data SupplementOpaque
newtype Supplement = SP (ForeignPtr SupplementOpaque)

fusionSetupSupplement :: Cipher -> Key -> IO Supplement
fusionSetupSupplement :: Cipher -> Key -> IO Supplement
fusionSetupSupplement Cipher
cipher (Key ByteString
hpkey) = ByteString -> (Ptr Word8 -> IO Supplement) -> IO Supplement
forall a. ByteString -> (Ptr Word8 -> IO a) -> IO a
withByteString ByteString
hpkey ((Ptr Word8 -> IO Supplement) -> IO Supplement)
-> (Ptr Word8 -> IO Supplement) -> IO Supplement
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
hpkeyp ->
  ForeignPtr SupplementOpaque -> Supplement
SP (ForeignPtr SupplementOpaque -> Supplement)
-> IO (ForeignPtr SupplementOpaque) -> IO Supplement
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Ptr Word8 -> CInt -> IO (Ptr SupplementOpaque)
c_supplement_new Ptr Word8
hpkeyp CInt
keylen IO (Ptr SupplementOpaque)
-> (Ptr SupplementOpaque -> IO (ForeignPtr SupplementOpaque))
-> IO (ForeignPtr SupplementOpaque)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= FinalizerPtr SupplementOpaque
-> Ptr SupplementOpaque -> IO (ForeignPtr SupplementOpaque)
forall a. FinalizerPtr a -> Ptr a -> IO (ForeignPtr a)
newForeignPtr FinalizerPtr SupplementOpaque
p_supplement_free)
 where
  keylen :: CInt
keylen
    | Cipher
cipher Cipher -> Cipher -> Bool
forall a. Eq a => a -> a -> Bool
== Cipher
cipher_TLS13_AES128GCM_SHA256 = CInt
16
    | Bool
otherwise                               = CInt
32

fusionSetSample :: Supplement -> Ptr Word8 -> IO ()
fusionSetSample :: Supplement -> Ptr Word8 -> IO ()
fusionSetSample (SP ForeignPtr SupplementOpaque
fsupp) Ptr Word8
p = ForeignPtr SupplementOpaque
-> (Ptr SupplementOpaque -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr SupplementOpaque
fsupp ((Ptr SupplementOpaque -> IO ()) -> IO ())
-> (Ptr SupplementOpaque -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr SupplementOpaque
psupp ->
  Ptr SupplementOpaque -> Ptr Word8 -> IO ()
c_supplement_set_sample Ptr SupplementOpaque
psupp Ptr Word8
p

fusionGetMask :: Supplement -> IO (Ptr Word8)
fusionGetMask :: Supplement -> IO (Ptr Word8)
fusionGetMask (SP ForeignPtr SupplementOpaque
fsupp) = ForeignPtr SupplementOpaque
-> (Ptr SupplementOpaque -> IO (Ptr Word8)) -> IO (Ptr Word8)
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr SupplementOpaque
fsupp Ptr SupplementOpaque -> IO (Ptr Word8)
c_supplement_get_mask

----------------------------------------------------------------

foreign import ccall unsafe "aead_context_new"
    c_aead_context_new :: IO (Ptr FusionContextOpaque)

foreign import ccall unsafe "&aead_context_free"
    p_aead_context_free :: FunPtr (Ptr FusionContextOpaque -> IO ())

foreign import ccall unsafe "aes128gcm_setup"
    c_aes128gcm_setup :: Ptr FusionContextOpaque
                      -> CInt       -- dummy
                      -> Ptr Word8  -- key
                      -> Ptr Word8  -- iv
                      -> IO CInt

foreign import ccall unsafe "aes256gcm_setup"
    c_aes256gcm_setup :: Ptr FusionContextOpaque
                      -> CInt       -- dummy
                      -> Ptr Word8  -- key
                      -> Ptr Word8  -- iv
                      -> IO CInt
{-
foreign import ccall unsafe "aesgcm_dispose_crypto"
    c_aesgcm_dispose_crypto :: FusionContext -> IO ()
-}

foreign import ccall unsafe "aead_do_encrypt"
    c_aead_do_encrypt :: Ptr FusionContextOpaque
                      -> Ptr Word8 -- output
                      -> Ptr Word8 -- input
                      -> CSize     -- input length
                      -> CULong    -- sequence
                      -> Ptr Word8 -- AAD
                      -> CSize     -- AAD length
                      -> Ptr SupplementOpaque
                      -> IO ()

foreign import ccall unsafe "aead_do_decrypt"
    c_aead_do_decrypt :: Ptr FusionContextOpaque
                      -> Ptr Word8 -- output
                      -> Ptr Word8 -- input
                      -> CSize     -- input length
                      -> CULong    -- sequence
                      -> Ptr Word8 -- AAD
                      -> CSize     -- AAD length
                      -> IO CSize

foreign import ccall unsafe "supplement_new"
    c_supplement_new :: Ptr Word8 -> CInt -> IO (Ptr SupplementOpaque)

foreign import ccall unsafe "&supplement_free"
    p_supplement_free :: FunPtr (Ptr SupplementOpaque -> IO ())

foreign import ccall unsafe "supplement_set_sample"
    c_supplement_set_sample :: Ptr SupplementOpaque -> Ptr Word8 -> IO ()

foreign import ccall unsafe "supplement_get_mask"
    c_supplement_get_mask :: Ptr SupplementOpaque -> IO (Ptr Word8)