{-# 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)
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
-> Ptr Word8
-> Ptr Word8
-> IO CInt
foreign import ccall unsafe "aes256gcm_setup"
c_aes256gcm_setup :: Ptr FusionContextOpaque
-> CInt
-> Ptr Word8
-> Ptr Word8
-> IO CInt
foreign import ccall unsafe "aead_do_encrypt"
c_aead_do_encrypt :: Ptr FusionContextOpaque
-> Ptr Word8
-> Ptr Word8
-> CSize
-> CULong
-> Ptr Word8
-> CSize
-> Ptr SupplementOpaque
-> IO ()
foreign import ccall unsafe "aead_do_decrypt"
c_aead_do_decrypt :: Ptr FusionContextOpaque
-> Ptr Word8
-> Ptr Word8
-> CSize
-> CULong
-> Ptr Word8
-> CSize
-> 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