-- |
-- Module      : PostgresWebsockets.Context
-- Description : Produce a context capable of running postgres-websockets sessions
module PostgresWebsockets.Context
  ( Context (..),
    mkContext,
  )
where

import Control.AutoUpdate
  ( defaultUpdateSettings,
    mkAutoUpdate,
    updateAction,
  )
import Data.Time.Clock (UTCTime, getCurrentTime)
import qualified Hasql.Pool as P
import PostgresWebsockets.Broadcast (Multiplexer)
import PostgresWebsockets.Config (AppConfig (..))
import PostgresWebsockets.HasqlBroadcast (newHasqlBroadcaster)
import Protolude hiding (toS)
import Protolude.Conv

data Context = Context
  { Context -> AppConfig
ctxConfig :: AppConfig,
    Context -> Pool
ctxPool :: P.Pool,
    Context -> Multiplexer
ctxMulti :: Multiplexer,
    Context -> IO UTCTime
ctxGetTime :: IO UTCTime
  }

-- | Given a configuration and a shutdown action (performed when the Multiplexer's listen connection dies) produces the context necessary to run sessions
mkContext :: AppConfig -> IO () -> IO Context
mkContext :: AppConfig -> IO () -> IO Context
mkContext conf :: AppConfig
conf@AppConfig {Bool
Int
Maybe Int
Maybe Text
ByteString
Text
configKeyFile :: AppConfig -> Maybe Text
configCertificateFile :: AppConfig -> Maybe Text
configReconnectInterval :: AppConfig -> Maybe Int
configRetries :: AppConfig -> Int
configPool :: AppConfig -> Int
configJwtSecretIsBase64 :: AppConfig -> Bool
configJwtSecret :: AppConfig -> ByteString
configMetaChannel :: AppConfig -> Maybe Text
configListenChannel :: AppConfig -> Text
configPort :: AppConfig -> Int
configHost :: AppConfig -> Text
configPath :: AppConfig -> Maybe Text
configDatabase :: AppConfig -> Text
configKeyFile :: Maybe Text
configCertificateFile :: Maybe Text
configReconnectInterval :: Maybe Int
configRetries :: Int
configPool :: Int
configJwtSecretIsBase64 :: Bool
configJwtSecret :: ByteString
configMetaChannel :: Maybe Text
configListenChannel :: Text
configPort :: Int
configHost :: Text
configPath :: Maybe Text
configDatabase :: Text
..} IO ()
shutdownServer = do
  AppConfig -> Pool -> Multiplexer -> IO UTCTime -> Context
Context AppConfig
conf
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> DiffTime -> DiffTime -> ByteString -> IO Pool
P.acquire Int
configPool DiffTime
10000 DiffTime
10000 ByteString
pgSettings
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> IO () -> Text -> Int -> Maybe Int -> ByteString -> IO Multiplexer
newHasqlBroadcaster IO ()
shutdown (forall a b. StringConv a b => a -> b
toS Text
configListenChannel) Int
configRetries Maybe Int
configReconnectInterval ByteString
pgSettings
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> IO (IO UTCTime)
mkGetTime
  where
    shutdown :: IO ()
shutdown =
      forall b a. b -> (a -> b) -> Maybe a -> b
maybe
        IO ()
shutdownServer
        (forall a b. a -> b -> a
const forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *). MonadIO m => Text -> m ()
putText Text
"Producer thread is dead")
        Maybe Int
configReconnectInterval
    mkGetTime :: IO (IO UTCTime)
    mkGetTime :: IO (IO UTCTime)
mkGetTime = forall a. UpdateSettings a -> IO (IO a)
mkAutoUpdate UpdateSettings ()
defaultUpdateSettings {updateAction :: IO UTCTime
updateAction = IO UTCTime
getCurrentTime}
    pgSettings :: ByteString
pgSettings = forall a b. StringConv a b => a -> b
toS Text
configDatabase