{-# LANGUAGE CPP #-}

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

#ifdef USE_FUSION
import qualified Data.ByteString as BS
import Foreign.C.Types
import Foreign.ForeignPtr
import Foreign.Ptr
import Network.TLS.Extra.Cipher

import Network.QUIC.Crypto.Types
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 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (IO (Ptr FusionContextOpaque)
c_aead_context_new forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a. FinalizerPtr a -> Ptr a -> IO (ForeignPtr a)
newForeignPtr FunPtr (Ptr FusionContextOpaque -> IO ())
p_aead_context_free)

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

fusionSetup :: Cipher -> FusionContext -> Key -> IV -> IO ()
fusionSetup :: Cipher -> FusionContext -> Key -> IV -> IO ()
fusionSetup Cipher
cipher
  | Cipher
cipher forall a. Eq a => a -> a -> Bool
== Cipher
cipher_TLS13_AES128GCM_SHA256        = FusionContext -> Key -> IV -> IO ()
fusionSetupAES128
  | Cipher
cipher forall a. Eq a => a -> a -> Bool
== Cipher
cipher_TLS13_AES256GCM_SHA384        = FusionContext -> Key -> IV -> IO ()
fusionSetupAES256
  | Bool
otherwise                                      = 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) = forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr FusionContextOpaque
fctx forall a b. (a -> b) -> a -> b
$ \Ptr FusionContextOpaque
pctx ->
    forall a. ByteString -> (Ptr Word8 -> IO a) -> IO a
withByteString ByteString
key forall a b. (a -> b) -> a -> b
$ \Ptr Word8
keyp ->
        forall a. ByteString -> (Ptr Word8 -> IO a) -> IO a
withByteString ByteString
iv forall a b. (a -> b) -> a -> b
$ \Ptr Word8
ivp -> forall (f :: * -> *) a. Functor f => f a -> f ()
void 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) = forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr FusionContextOpaque
fctx forall a b. (a -> b) -> a -> b
$ \Ptr FusionContextOpaque
pctx ->
    forall a. ByteString -> (Ptr Word8 -> IO a) -> IO a
withByteString ByteString
key forall a b. (a -> b) -> a -> b
$ \Ptr Word8
keyp ->
        forall a. ByteString -> (Ptr Word8 -> IO a) -> IO a
withByteString ByteString
iv forall a b. (a -> b) -> a -> b
$ \Ptr Word8
ivp -> forall (f :: * -> *) a. Functor f => f a -> f ()
void 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 -> PlainText -> AssDat -> PacketNumber -> IO Int
fusionEncrypt :: FusionContext
-> Supplement -> Ptr Word8 -> ByteString -> AssDat -> Int -> IO Int
fusionEncrypt (FC ForeignPtr FusionContextOpaque
fctx) (SP ForeignPtr SupplementOpaque
fsupp) Ptr Word8
obuf ByteString
plaintext (AssDat ByteString
header) Int
pn =
    forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr FusionContextOpaque
fctx forall a b. (a -> b) -> a -> b
$ \Ptr FusionContextOpaque
pctx -> forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr SupplementOpaque
fsupp forall a b. (a -> b) -> a -> b
$ \Ptr SupplementOpaque
psupp -> do
      forall a. ByteString -> (Ptr Word8 -> IO a) -> IO a
withByteString ByteString
plaintext forall a b. (a -> b) -> a -> b
$ \Ptr Word8
ibuf ->
        forall a. ByteString -> (Ptr Word8 -> IO a) -> IO a
withByteString ByteString
header forall a b. (a -> b) -> a -> b
$ \Ptr Word8
abuf -> 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
          forall (m :: * -> *) a. Monad m => a -> m a
return (Int
ilen forall a. Num a => a -> a -> a
+ Int
16) -- fixme
  where
    pn' :: CULong
pn'   = forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
pn
    ilen :: Int
ilen  = ByteString -> Int
BS.length ByteString
plaintext
    ilen' :: CSize
ilen' = forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
ilen
    alen :: CSize
alen  = forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ ByteString -> Int
BS.length ByteString
header

fusionDecrypt :: FusionContext
              -> Buffer -> CipherText -> AssDat -> PacketNumber -> IO Int
fusionDecrypt :: FusionContext -> Ptr Word8 -> ByteString -> AssDat -> Int -> IO Int
fusionDecrypt (FC ForeignPtr FusionContextOpaque
fctx) Ptr Word8
obuf ByteString
ciphertext (AssDat ByteString
header) Int
pn =
    forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr FusionContextOpaque
fctx forall a b. (a -> b) -> a -> b
$ \Ptr FusionContextOpaque
pctx ->
      forall a. ByteString -> (Ptr Word8 -> IO a) -> IO a
withByteString ByteString
ciphertext forall a b. (a -> b) -> a -> b
$ \Ptr Word8
ibuf ->
        forall a. ByteString -> (Ptr Word8 -> IO a) -> IO a
withByteString ByteString
header forall a b. (a -> b) -> a -> b
$ \Ptr Word8
abuf ->
            forall a b. (Integral a, Num b) => a -> b
fromIntegral 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
obuf Ptr Word8
ibuf CSize
ilen CULong
pn' Ptr Word8
abuf CSize
alen
  where
    pn' :: CULong
pn'  = forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
pn
    ilen :: CSize
ilen = forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ ByteString -> Int
BS.length ByteString
ciphertext
    alen :: CSize
alen = forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ ByteString -> Int
BS.length ByteString
header

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

data SupplementOpaque
newtype Supplement = SP (ForeignPtr SupplementOpaque)

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

fusionSetSample :: Supplement -> Buffer -> IO ()
fusionSetSample :: Supplement -> Ptr Word8 -> IO ()
fusionSetSample (SP ForeignPtr SupplementOpaque
fsupp) Ptr Word8
p = forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr SupplementOpaque
fsupp 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 Buffer
fusionGetMask :: Supplement -> IO (Ptr Word8)
fusionGetMask (SP ForeignPtr SupplementOpaque
fsupp) = forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr SupplementOpaque
fsupp Ptr SupplementOpaque -> IO (Ptr Word8)
c_supplement_get_mask

isFusionAvailable :: IO Bool
isFusionAvailable :: IO Bool
isFusionAvailable = do
    Int
n <- IO Int
c_ptls_fusion_is_supported_by_cpu
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Bool -> Bool
not (Int
n forall a. Eq a => a -> a -> Bool
== Int
0)

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

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)

foreign import ccall unsafe "ptls_fusion_is_supported_by_cpu"
    c_ptls_fusion_is_supported_by_cpu :: IO Int

#else
import Network.QUIC.Crypto.Types
import Network.QUIC.Imports
import Network.QUIC.Types

data FusionContext

fusionNewContext :: IO FusionContext
fusionNewContext = undefined

fusionSetup :: Cipher -> FusionContext -> Key -> IV -> IO ()
fusionSetup = undefined

fusionEncrypt :: FusionContext -> Supplement
              -> Buffer -> PlainText -> AssDat -> PacketNumber -> IO Int
fusionEncrypt = undefined

fusionDecrypt :: FusionContext
              -> Buffer -> CipherText -> AssDat -> PacketNumber -> IO Int
fusionDecrypt = undefined

data Supplement

fusionSetupSupplement :: Cipher -> Key -> IO Supplement
fusionSetupSupplement = undefined

fusionSetSample :: Supplement -> Buffer -> IO ()
fusionSetSample = undefined

fusionGetMask :: Supplement -> IO Buffer
fusionGetMask = undefined

isFusionAvailable :: IO Bool
isFusionAvailable = return False
#endif