Role.hs

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

module Network.QUIC.Connection.Role (
    setToken
  , getToken
  , getResumptionInfo
  , setRetried
  , getRetried
  , setIncompatibleVN
  , getIncompatibleVN
  , setResumptionSession
  , setNewToken
  , setRegister
  , getRegister
  , getUnregister
  , setTokenManager
  , getTokenManager
  , setBaseThreadId
  , getBaseThreadId
  , setCertificateChain
  , getCertificateChain
  ) where

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

import Network.QUIC.Connection.Misc
import Network.QUIC.Connection.Types
import Network.QUIC.Connector
import Network.QUIC.Imports
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 -> ci {
        resumptionInfo = (resumptionInfo ci) {
              resumptionVersion = ver
            , resumptionSession = Just (si,sd)
            }
      }

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

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

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

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

setBaseThreadId :: Connection -> ThreadId -> IO ()
setBaseThreadId Connection{..} tid = atomicModifyIORef'' roleInfo $
    \si -> si { baseThreadId = tid }

getBaseThreadId :: Connection -> IO ThreadId
getBaseThreadId Connection{..} = baseThreadId <$> 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