diff --git a/postgrest.cabal b/postgrest.cabal index deb81cc33..59666863c 100644 --- a/postgrest.cabal +++ b/postgrest.cabal @@ -46,6 +46,7 @@ library exposed-modules: PostgREST.Admin PostgREST.App PostgREST.AppState + PostgREST.AppState.Types PostgREST.Auth PostgREST.Auth.Jwt PostgREST.Auth.JwtCache diff --git a/src/library/PostgREST/AppState.hs b/src/library/PostgREST/AppState.hs index d7210eb49..9946bb6ac 100644 --- a/src/library/PostgREST/AppState.hs +++ b/src/library/PostgREST/AppState.hs @@ -47,12 +47,12 @@ import PostgREST.Version (prettyVersion) import Control.AutoUpdate (defaultUpdateSettings, mkAutoUpdate, updateAction) import Control.Retry (RetryPolicy, RetryStatus (..), capDelay, exponentialBackoff, retrying, rsPreviousDelay) -import Data.IORef (IORef, atomicWriteIORef, newIORef, readIORef) -import Data.Time.Clock (UTCTime, getCurrentTime) +import Data.IORef (newIORef, readIORef) +import Data.Time.Clock (getCurrentTime) -import Control.Concurrent.STM (TMVar, newEmptyTMVarIO, putTMVar, - readTMVar, tryReadTMVar, tryTakeTMVar) -import PostgREST.Auth.JwtCache (JwtCacheState, update) +import Control.Concurrent.STM (newEmptyTMVarIO, putTMVar, readTMVar, + tryReadTMVar, tryTakeTMVar) +import PostgREST.Auth.JwtCache (update) import PostgREST.Config (AppConfig (..), readAppConfig, toConnectionSettings) import PostgREST.Config.Database (queryDbSettings, queryPgVersion, @@ -63,45 +63,10 @@ import PostgREST.SchemaCache (SchemaCache (..), querySchemaCache, showSummary) import PostgREST.SchemaCache.Identifiers (quoteQi) +import PostgREST.AppState.Types + import Protolude -data AppState = AppState - -- | Database connection pool - { statePool :: SQL.Pool - -- | Database server version - , statePgVersion :: IORef PgVersion - -- | Schema cache - , stateSchemaCache :: IORef (Maybe SchemaCache) - -- | The schema cache status - , stateSCacheStatus :: SchemaCacheStatus - -- | State of the LISTEN channel - , stateIsListenerOn :: IORef Bool - -- | starts the connection worker with a debounce - , debouncedSCacheLoader :: IO () - -- | Config that can change at runtime - , stateConf :: IORef AppConfig - -- | Time used for verifying JWT expiration - , stateGetTime :: IO UTCTime - -- | Used for killing the main thread in case a subthread fails - , stateKillApp :: IO () - -- | Keeps track of the next delay for db connection retry - , stateNextDelay :: IORef Int - -- | Observation handler - , stateObserver :: ObservationHandler - -- | JWT Cache - , stateJwtCache :: JwtCache.JwtCacheState - , stateLogger :: Logger.LoggerState - , stateMetrics :: Metrics.MetricsState - } - --- | Schema cache status. --- Empty means initial loading on startup, False means pending and True means loaded. --- "Initial" state is needed so that we can wait with application socket listening --- until after initial schema cache querying. -newtype SchemaCacheStatus = SchemaCacheStatus - { getSCStatusTMVar :: TMVar Bool - } - init :: AppConfig -> IO () -> IO AppState init conf@AppConfig{configLogLevel, configDbPoolSize} appKiller = do loggerState <- Logger.init @@ -221,39 +186,6 @@ flushPool AppState{..} = do SQL.release statePool stateObserver PoolFlushed -getPgVersion :: AppState -> IO PgVersion -getPgVersion = readIORef . statePgVersion - -putPgVersion :: AppState -> PgVersion -> IO () -putPgVersion = atomicWriteIORef . statePgVersion - -getSchemaCache :: AppState -> IO (Maybe SchemaCache) -getSchemaCache = readIORef . stateSchemaCache - -putSchemaCache :: AppState -> Maybe SchemaCache -> IO () -putSchemaCache appState = atomicWriteIORef (stateSchemaCache appState) - -schemaCacheLoader :: AppState -> IO () -schemaCacheLoader = debouncedSCacheLoader - -getNextDelay :: AppState -> IO Int -getNextDelay = readIORef . stateNextDelay - -getConfig :: AppState -> IO AppConfig -getConfig = readIORef . stateConf - -putConfig :: AppState -> AppConfig -> IO () -putConfig = atomicWriteIORef . stateConf - -getTime :: AppState -> IO UTCTime -getTime = stateGetTime - -getJwtCacheState :: AppState -> JwtCacheState -getJwtCacheState = stateJwtCache - -killApp :: AppState -> IO () -killApp = stateKillApp - isConnEstablished :: AppState -> IO Bool isConnEstablished appState = do AppConfig{..} <- getConfig appState @@ -262,9 +194,6 @@ isConnEstablished appState = do else -- otherwise the only way to check the connection is to make a query isRight <$> usePool appState (SQL.sql "SELECT 1") -putIsListenerOn :: AppState -> Bool -> IO () -putIsListenerOn = atomicWriteIORef . stateIsListenerOn - isLoaded :: AppState -> IO Bool isLoaded x = do scacheLoaded <- isSchemaCacheLoaded x @@ -277,9 +206,6 @@ isPending x = do connEstablished <- isConnEstablished x return $ not scacheLoaded || not connEstablished -getObserver :: AppState -> ObservationHandler -getObserver = stateObserver - -- | Try to load the schema cache and retry if it fails. -- -- This is done by repeatedly: 1) flushing the pool, 2) querying the version and validating that the postgres version is supported by us, and 3) loading the schema cache. diff --git a/src/library/PostgREST/AppState/Types.hs b/src/library/PostgREST/AppState/Types.hs new file mode 100644 index 000000000..180c4461f --- /dev/null +++ b/src/library/PostgREST/AppState/Types.hs @@ -0,0 +1,98 @@ +{-| +Module : PostgREST.AppState.Types +Description : AppState data type and stateful functions +-} +module PostgREST.AppState.Types where + +import qualified Hasql.Pool as SQL +import qualified PostgREST.Auth.JwtCache as JwtCache +import qualified PostgREST.Logger as Logger +import qualified PostgREST.Metrics as Metrics +import PostgREST.Observation + +import Data.IORef (IORef, atomicWriteIORef, readIORef) +import Data.Time.Clock (UTCTime) + +import Control.Concurrent.STM (TMVar) +import PostgREST.Auth.JwtCache (JwtCacheState) +import PostgREST.Config (AppConfig (..)) +import PostgREST.Config.PgVersion (PgVersion (..)) +import PostgREST.SchemaCache (SchemaCache (..)) + +import Protolude + +data AppState = AppState + -- | Database connection pool + { statePool :: SQL.Pool + -- | Database server version + , statePgVersion :: IORef PgVersion + -- | Schema cache + , stateSchemaCache :: IORef (Maybe SchemaCache) + -- | The schema cache status + , stateSCacheStatus :: SchemaCacheStatus + -- | State of the LISTEN channel + , stateIsListenerOn :: IORef Bool + -- | starts the connection worker with a debounce + , debouncedSCacheLoader :: IO () + -- | Config that can change at runtime + , stateConf :: IORef AppConfig + -- | Time used for verifying JWT expiration + , stateGetTime :: IO UTCTime + -- | Used for killing the main thread in case a subthread fails + , stateKillApp :: IO () + -- | Keeps track of the next delay for db connection retry + , stateNextDelay :: IORef Int + -- | Observation handler + , stateObserver :: ObservationHandler + -- | JWT Cache + , stateJwtCache :: JwtCache.JwtCacheState + , stateLogger :: Logger.LoggerState + , stateMetrics :: Metrics.MetricsState + } + +-- | Schema cache status. +-- Empty means initial loading on startup, False means pending and True means loaded. +-- "Initial" state is needed so that we can wait with application socket listening +-- until after initial schema cache querying. +newtype SchemaCacheStatus = SchemaCacheStatus + { getSCStatusTMVar :: TMVar Bool + } + +getPgVersion :: AppState -> IO PgVersion +getPgVersion = readIORef . statePgVersion + +putPgVersion :: AppState -> PgVersion -> IO () +putPgVersion = atomicWriteIORef . statePgVersion + +getSchemaCache :: AppState -> IO (Maybe SchemaCache) +getSchemaCache = readIORef . stateSchemaCache + +putSchemaCache :: AppState -> Maybe SchemaCache -> IO () +putSchemaCache appState = atomicWriteIORef (stateSchemaCache appState) + +schemaCacheLoader :: AppState -> IO () +schemaCacheLoader = debouncedSCacheLoader + +getNextDelay :: AppState -> IO Int +getNextDelay = readIORef . stateNextDelay + +getConfig :: AppState -> IO AppConfig +getConfig = readIORef . stateConf + +putConfig :: AppState -> AppConfig -> IO () +putConfig = atomicWriteIORef . stateConf + +getTime :: AppState -> IO UTCTime +getTime = stateGetTime + +getJwtCacheState :: AppState -> JwtCacheState +getJwtCacheState = stateJwtCache + +killApp :: AppState -> IO () +killApp = stateKillApp + +putIsListenerOn :: AppState -> Bool -> IO () +putIsListenerOn = atomicWriteIORef . stateIsListenerOn + +getObserver :: AppState -> ObservationHandler +getObserver = stateObserver