quic-0.2.13: Network/QUIC/Connection/Role.hs

{-# LANGUAGE RecordWildCards #-}
{-# OPTIONS_GHC -Wno-incomplete-record-updates #-}

module Network.QUIC.Connection.Role (
    setToken,
    getToken,
    getResumptionInfo,
    setRetried,
    getRetried,
    setIncompatibleVN,
    getIncompatibleVN,
    setResumptionSession,
    setNewToken,
    setResumptionParameters,
    setRegister,
    getRegister,
    getUnregister,
    setTokenManager,
    getTokenManager,
    setStopServer,
    getStopServer,
    setCertificateChain,
    getCertificateChain,
    setSockConnected,
    getSockConnected,
) where

import qualified Crypto.Token as CT
import Data.X509 (CertificateChain)

import Network.QUIC.Connection.Misc
import Network.QUIC.Connection.Types
import Network.QUIC.Connector
import Network.QUIC.Imports
import Network.QUIC.Parameters
import Network.QUIC.Types

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

setToken :: Connection -> Token -> IO ()
setToken Connection{..} token = atomicModifyIORef'' roleInfo $
    \ci -> ci{clientInitialToken = token}

getToken :: Connection -> IO Token
getToken conn@Connection{..}
    | isClient conn = clientInitialToken <$> readIORef roleInfo
    | otherwise = return emptyToken

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

-- | Getting information about resumption.
getResumptionInfo :: Connection -> IO ResumptionInfo
getResumptionInfo Connection{..} = resumptionInfo <$> readIORef roleInfo

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

setRetried :: Connection -> Bool -> IO ()
setRetried conn@Connection{..} r
    | isClient conn = atomicModifyIORef'' roleInfo $ \ci ->
        ci
            { resumptionInfo = (resumptionInfo ci){resumptionRetry = r}
            }
    | otherwise = atomicModifyIORef'' roleInfo $ \si -> si{askRetry = r}

getRetried :: Connection -> IO Bool
getRetried conn@Connection{..}
    | isClient conn = resumptionRetry . resumptionInfo <$> readIORef roleInfo
    | otherwise = askRetry <$> readIORef roleInfo

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

setIncompatibleVN :: Connection -> Bool -> IO ()
setIncompatibleVN conn@Connection{..} icvn
    | isClient conn = atomicModifyIORef'' roleInfo $ \ci ->
        ci
            { incompatibleVN = icvn
            }
    | otherwise = return ()

getIncompatibleVN :: Connection -> IO Bool
getIncompatibleVN conn@Connection{..}
    | isClient conn = incompatibleVN <$> readIORef roleInfo
    | otherwise = return False

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

setResumptionSession :: Connection -> SessionEstablish
setResumptionSession conn@Connection{..} si sd = do
    ver <- getVersion conn
    atomicModifyIORef'' roleInfo $ \ci ->
        let resumInfo = resumptionInfo ci
         in ci
                { resumptionInfo =
                    resumInfo
                        { resumptionVersion = ver
                        , resumptionSession = (si, sd) : resumptionSession resumInfo
                        }
                }
    return Nothing

setNewToken :: Connection -> Token -> IO ()
setNewToken conn@Connection{..} token = do
    ver <- getVersion conn
    atomicModifyIORef'' roleInfo $ \ci ->
        ci
            { resumptionInfo =
                (resumptionInfo ci)
                    { resumptionVersion = ver
                    , resumptionToken = token
                    }
            }

setResumptionParameters :: Connection -> Parameters -> IO ()
setResumptionParameters Connection{..} params = do
    atomicModifyIORef'' roleInfo $ \ci ->
        ci
            { resumptionInfo = parametersToResumption (resumptionInfo ci) params
            }

parametersToResumption :: ResumptionInfo -> Parameters -> ResumptionInfo
parametersToResumption ri Parameters{..} =
    ri
        { resumptionActiveConnectionIdLimit = activeConnectionIdLimit
        , resumptionInitialMaxData = initialMaxData
        , resumptionInitialMaxStreamDataBidiLocal = initialMaxStreamDataBidiLocal
        , resumptionInitialMaxStreamDataBidiRemote = initialMaxStreamDataBidiRemote
        , resumptionInitialMaxStreamDataUni = initialMaxStreamDataUni
        , resumptionInitialMaxStreamsBidi = initialMaxStreamsBidi
        , resumptionInitialMaxStreamsUni = initialMaxStreamsUni
        }

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

setRegister
    :: Connection -> (CID -> Connection -> IO ()) -> (CID -> IO ()) -> IO ()
setRegister Connection{..} regisrer unregister = atomicModifyIORef'' roleInfo $ \si ->
    si
        { registerCID = regisrer
        , unregisterCID = unregister
        }

getRegister :: Connection -> IO (CID -> Connection -> IO ())
getRegister Connection{..} = registerCID <$> readIORef roleInfo

getUnregister :: Connection -> IO (CID -> IO ())
getUnregister Connection{..} = unregisterCID <$> readIORef roleInfo

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

setTokenManager :: Connection -> CT.TokenManager -> IO ()
setTokenManager Connection{..} mgr = atomicModifyIORef'' roleInfo $
    \si -> si{tokenManager = mgr}

getTokenManager :: Connection -> IO CT.TokenManager
getTokenManager Connection{..} = tokenManager <$> readIORef roleInfo

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

setStopServer :: Connection -> IO () -> IO ()
setStopServer Connection{..} action = atomicModifyIORef'' roleInfo $
    \si -> si{stopServer = action}

getStopServer :: Connection -> IO (IO ())
getStopServer Connection{..} = stopServer <$> readIORef roleInfo

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

setCertificateChain :: Connection -> Maybe CertificateChain -> IO ()
setCertificateChain Connection{..} mcc = atomicModifyIORef'' roleInfo $
    \si -> si{certChain = mcc}

getCertificateChain :: Connection -> IO (Maybe CertificateChain)
getCertificateChain Connection{..} = certChain <$> readIORef roleInfo

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

setSockConnected :: Connection -> Bool -> IO ()
setSockConnected Connection{..} b = atomicModifyIORef'' roleInfo $
    \ci -> ci{sockConnected = b}

getSockConnected :: Connection -> IO Bool
getSockConnected Connection{..} = do
    ri <- readIORef roleInfo
    case ri of
        ClientInfo{..} -> return sockConnected
        _ -> return False