module SecondTransfer.Sessions.Internal where
import SecondTransfer.Sessions.Config
import Control.Concurrent.MVar (MVar, newMVar,modifyMVar)
import qualified Control.Exception as E
import Control.Lens ((^.), makeLenses)
import System.Log.Logger
data SessionsContext = SessionsContext {
_sessionsConfig :: SessionsConfig
,_nextSessionId :: MVar Int
}
makeLenses ''SessionsContext
acquireNewSessionTag :: SessionsContext -> IO Int
acquireNewSessionTag sessions_context =
modifyMVar
(sessions_context ^. nextSessionId )
(\ next_id -> return (next_id+1, next_id))
makeSessionsContext :: SessionsConfig -> IO SessionsContext
makeSessionsContext sessions_config = do
next_session_id_mvar <- newMVar 1
return SessionsContext {
_sessionsConfig = sessions_config,
_nextSessionId = next_session_id_mvar
}
sessionExceptionHandler ::
E.Exception e => SessionComponent -> Int -> SessionsContext -> e -> IO ()
sessionExceptionHandler session_component session_id sessions_context e =
let
getit = ( sessionsConfig . sessionsCallbacks . reportErrorCallback_SC )
maybe_error_callback = sessions_context ^. getit
component_tag = "Session." ++ show session_component
error_tuple = (
session_component,
SessionCoordinates session_id,
E.toException e
)
in case maybe_error_callback of
Nothing ->
errorM component_tag (show e)
Just callback ->
callback error_tuple