-- |
-- Module      : PostgresWebsockets.Config
-- Description : Manages PostgresWebsockets configuration options.
--
-- This module provides a helper function to read the command line
-- arguments using  the AppConfig type to store
-- them.  It also can be used to define other middleware configuration that
-- may be delegated to some sort of external configuration.
module PostgresWebsockets.Config
  ( prettyVersion,
    loadConfig,
    warpSettings,
    AppConfig (..),
  )
where

import qualified Data.ByteString as BS
import qualified Data.ByteString.Base64 as B64
import Data.String (IsString (..))
import Data.Text (intercalate, pack, replace, strip, stripPrefix)
import Data.Version (versionBranch)
import Env
import Network.Wai.Handler.Warp
import Paths_postgres_websockets (version)
import Protolude hiding (intercalate, optional, replace, toS, (<>))
import Protolude.Conv

-- | Config file settings for the server
data AppConfig = AppConfig
  { AppConfig -> Text
configDatabase :: Text,
    AppConfig -> Maybe Text
configPath :: Maybe Text,
    AppConfig -> Text
configHost :: Text,
    AppConfig -> Int
configPort :: Int,
    AppConfig -> Text
configListenChannel :: Text,
    AppConfig -> Maybe Text
configMetaChannel :: Maybe Text,
    AppConfig -> ByteString
configJwtSecret :: ByteString,
    AppConfig -> Bool
configJwtSecretIsBase64 :: Bool,
    AppConfig -> Int
configPool :: Int,
    AppConfig -> Int
configRetries :: Int,
    AppConfig -> Maybe Int
configReconnectInterval :: Maybe Int,
    AppConfig -> Maybe Text
configCertificateFile :: Maybe Text,
    AppConfig -> Maybe Text
configKeyFile :: Maybe Text
  }
  deriving (Int -> AppConfig -> ShowS
[AppConfig] -> ShowS
AppConfig -> String
(Int -> AppConfig -> ShowS)
-> (AppConfig -> String)
-> ([AppConfig] -> ShowS)
-> Show AppConfig
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AppConfig] -> ShowS
$cshowList :: [AppConfig] -> ShowS
show :: AppConfig -> String
$cshow :: AppConfig -> String
showsPrec :: Int -> AppConfig -> ShowS
$cshowsPrec :: Int -> AppConfig -> ShowS
Show)

-- | User friendly version number
prettyVersion :: Text
prettyVersion :: Text
prettyVersion = Text -> [Text] -> Text
intercalate Text
"." ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ (Int -> Text) -> [Int] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map Int -> Text
forall a b. (Show a, ConvertText String b) => a -> b
show ([Int] -> [Text]) -> [Int] -> [Text]
forall a b. (a -> b) -> a -> b
$ Version -> [Int]
versionBranch Version
version

-- | Load all postgres-websockets config from Environment variables. This can be used to use just the middleware or to feed into warpSettings
loadConfig :: IO AppConfig
loadConfig :: IO AppConfig
loadConfig =
  IO AppConfig
readOptions
    IO AppConfig -> (AppConfig -> IO AppConfig) -> IO AppConfig
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= AppConfig -> IO AppConfig
verifyTLSConfig
    IO AppConfig -> (AppConfig -> IO AppConfig) -> IO AppConfig
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= AppConfig -> IO AppConfig
loadSecretFile
    IO AppConfig -> (AppConfig -> IO AppConfig) -> IO AppConfig
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= AppConfig -> IO AppConfig
loadDatabaseURIFile

-- | Given a shutdown handler and an AppConfig builds a Warp Settings to start a stand-alone server
warpSettings :: (IO () -> IO ()) -> AppConfig -> Settings
warpSettings :: (IO () -> IO ()) -> AppConfig -> Settings
warpSettings IO () -> IO ()
waitForShutdown AppConfig {Bool
Int
Maybe Int
Maybe Text
ByteString
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
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
..} =
  HostPreference -> Settings -> Settings
setHost (String -> HostPreference
forall a. IsString a => String -> a
fromString (String -> HostPreference) -> String -> HostPreference
forall a b. (a -> b) -> a -> b
$ Text -> String
forall a b. StringConv a b => a -> b
toS Text
configHost)
    (Settings -> Settings)
-> (Settings -> Settings) -> Settings -> Settings
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Settings -> Settings
setPort Int
configPort
    (Settings -> Settings)
-> (Settings -> Settings) -> Settings -> Settings
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Settings -> Settings
setServerName (Text -> ByteString
forall a b. StringConv a b => a -> b
toS (Text -> ByteString) -> Text -> ByteString
forall a b. (a -> b) -> a -> b
$ Text
"postgres-websockets/" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
prettyVersion)
    (Settings -> Settings)
-> (Settings -> Settings) -> Settings -> Settings
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Settings -> Settings
setTimeout Int
3600
    (Settings -> Settings)
-> (Settings -> Settings) -> Settings -> Settings
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (IO () -> IO ()) -> Settings -> Settings
setInstallShutdownHandler IO () -> IO ()
waitForShutdown
    (Settings -> Settings)
-> (Settings -> Settings) -> Settings -> Settings
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe Int -> Settings -> Settings
setGracefulShutdownTimeout (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
5)
    (Settings -> Settings) -> Settings -> Settings
forall a b. (a -> b) -> a -> b
$ Settings
defaultSettings

-- private

-- | Function to read and parse options from the environment
readOptions :: IO AppConfig
readOptions :: IO AppConfig
readOptions =
  (Info Error -> Info Error)
-> Parser Error AppConfig -> IO AppConfig
forall e a. (Info Error -> Info e) -> Parser e a -> IO a
Env.parse (String -> Info Error -> Info Error
forall e. String -> Info e -> Info e
header String
"You need to configure some environment variables to start the service.") (Parser Error AppConfig -> IO AppConfig)
-> Parser Error AppConfig -> IO AppConfig
forall a b. (a -> b) -> a -> b
$
    Text
-> Maybe Text
-> Text
-> Int
-> Text
-> Maybe Text
-> ByteString
-> Bool
-> Int
-> Int
-> Maybe Int
-> Maybe Text
-> Maybe Text
-> AppConfig
AppConfig (Text
 -> Maybe Text
 -> Text
 -> Int
 -> Text
 -> Maybe Text
 -> ByteString
 -> Bool
 -> Int
 -> Int
 -> Maybe Int
 -> Maybe Text
 -> Maybe Text
 -> AppConfig)
-> Parser Error Text
-> Parser
     Error
     (Maybe Text
      -> Text
      -> Int
      -> Text
      -> Maybe Text
      -> ByteString
      -> Bool
      -> Int
      -> Int
      -> Maybe Int
      -> Maybe Text
      -> Maybe Text
      -> AppConfig)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Reader Error Text -> String -> Mod Var Text -> Parser Error Text
forall e a.
AsUnset e =>
Reader e a -> String -> Mod Var a -> Parser e a
var (Reader Error Text
forall s e. IsString s => Reader e s
str Reader Error Text
-> (String -> Either Error String) -> Reader Error Text
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< String -> Either Error String
forall e s. (AsEmpty e, IsString s) => Reader e s
nonempty) String
"PGWS_DB_URI" (String -> Mod Var Text
forall (t :: * -> *) a. HasHelp t => String -> Mod t a
help String
"String to connect to PostgreSQL")
      Parser
  Error
  (Maybe Text
   -> Text
   -> Int
   -> Text
   -> Maybe Text
   -> ByteString
   -> Bool
   -> Int
   -> Int
   -> Maybe Int
   -> Maybe Text
   -> Maybe Text
   -> AppConfig)
-> Parser Error (Maybe Text)
-> Parser
     Error
     (Text
      -> Int
      -> Text
      -> Maybe Text
      -> ByteString
      -> Bool
      -> Int
      -> Int
      -> Maybe Int
      -> Maybe Text
      -> Maybe Text
      -> AppConfig)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Error Text -> Parser Error (Maybe Text)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Reader Error Text -> String -> Mod Var Text -> Parser Error Text
forall e a.
AsUnset e =>
Reader e a -> String -> Mod Var a -> Parser e a
var Reader Error Text
forall s e. IsString s => Reader e s
str String
"PGWS_ROOT_PATH" (String -> Mod Var Text
forall (t :: * -> *) a. HasHelp t => String -> Mod t a
help String
"Root path to serve static files, unset to disable."))
      Parser
  Error
  (Text
   -> Int
   -> Text
   -> Maybe Text
   -> ByteString
   -> Bool
   -> Int
   -> Int
   -> Maybe Int
   -> Maybe Text
   -> Maybe Text
   -> AppConfig)
-> Parser Error Text
-> Parser
     Error
     (Int
      -> Text
      -> Maybe Text
      -> ByteString
      -> Bool
      -> Int
      -> Int
      -> Maybe Int
      -> Maybe Text
      -> Maybe Text
      -> AppConfig)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Reader Error Text -> String -> Mod Var Text -> Parser Error Text
forall e a.
AsUnset e =>
Reader e a -> String -> Mod Var a -> Parser e a
var Reader Error Text
forall s e. IsString s => Reader e s
str String
"PGWS_HOST" (Text -> Mod Var Text
forall a. a -> Mod Var a
def Text
"*4" Mod Var Text -> Mod Var Text -> Mod Var Text
forall a. Semigroup a => a -> a -> a
<> (Text -> String) -> Mod Var Text
forall a. (a -> String) -> Mod Var a
helpDef Text -> String
forall a b. (Show a, ConvertText String b) => a -> b
show Mod Var Text -> Mod Var Text -> Mod Var Text
forall a. Semigroup a => a -> a -> a
<> String -> Mod Var Text
forall (t :: * -> *) a. HasHelp t => String -> Mod t a
help String
"Address the server will listen for websocket connections")
      Parser
  Error
  (Int
   -> Text
   -> Maybe Text
   -> ByteString
   -> Bool
   -> Int
   -> Int
   -> Maybe Int
   -> Maybe Text
   -> Maybe Text
   -> AppConfig)
-> Parser Error Int
-> Parser
     Error
     (Text
      -> Maybe Text
      -> ByteString
      -> Bool
      -> Int
      -> Int
      -> Maybe Int
      -> Maybe Text
      -> Maybe Text
      -> AppConfig)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Reader Error Int -> String -> Mod Var Int -> Parser Error Int
forall e a.
AsUnset e =>
Reader e a -> String -> Mod Var a -> Parser e a
var Reader Error Int
forall e a. (AsUnread e, Read a) => Reader e a
auto String
"PGWS_PORT" (Int -> Mod Var Int
forall a. a -> Mod Var a
def Int
3000 Mod Var Int -> Mod Var Int -> Mod Var Int
forall a. Semigroup a => a -> a -> a
<> (Int -> String) -> Mod Var Int
forall a. (a -> String) -> Mod Var a
helpDef Int -> String
forall a b. (Show a, ConvertText String b) => a -> b
show Mod Var Int -> Mod Var Int -> Mod Var Int
forall a. Semigroup a => a -> a -> a
<> String -> Mod Var Int
forall (t :: * -> *) a. HasHelp t => String -> Mod t a
help String
"Port the server will listen for websocket connections")
      Parser
  Error
  (Text
   -> Maybe Text
   -> ByteString
   -> Bool
   -> Int
   -> Int
   -> Maybe Int
   -> Maybe Text
   -> Maybe Text
   -> AppConfig)
-> Parser Error Text
-> Parser
     Error
     (Maybe Text
      -> ByteString
      -> Bool
      -> Int
      -> Int
      -> Maybe Int
      -> Maybe Text
      -> Maybe Text
      -> AppConfig)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Reader Error Text -> String -> Mod Var Text -> Parser Error Text
forall e a.
AsUnset e =>
Reader e a -> String -> Mod Var a -> Parser e a
var Reader Error Text
forall s e. IsString s => Reader e s
str String
"PGWS_LISTEN_CHANNEL" (Text -> Mod Var Text
forall a. a -> Mod Var a
def Text
"postgres-websockets-listener" Mod Var Text -> Mod Var Text -> Mod Var Text
forall a. Semigroup a => a -> a -> a
<> (Text -> String) -> Mod Var Text
forall a. (a -> String) -> Mod Var a
helpDef Text -> String
forall a b. (Show a, ConvertText String b) => a -> b
show Mod Var Text -> Mod Var Text -> Mod Var Text
forall a. Semigroup a => a -> a -> a
<> String -> Mod Var Text
forall (t :: * -> *) a. HasHelp t => String -> Mod t a
help String
"Master channel used in the database to send or read messages in any notification channel")
      Parser
  Error
  (Maybe Text
   -> ByteString
   -> Bool
   -> Int
   -> Int
   -> Maybe Int
   -> Maybe Text
   -> Maybe Text
   -> AppConfig)
-> Parser Error (Maybe Text)
-> Parser
     Error
     (ByteString
      -> Bool
      -> Int
      -> Int
      -> Maybe Int
      -> Maybe Text
      -> Maybe Text
      -> AppConfig)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Error Text -> Parser Error (Maybe Text)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Reader Error Text -> String -> Mod Var Text -> Parser Error Text
forall e a.
AsUnset e =>
Reader e a -> String -> Mod Var a -> Parser e a
var Reader Error Text
forall s e. IsString s => Reader e s
str String
"PGWS_META_CHANNEL" (String -> Mod Var Text
forall (t :: * -> *) a. HasHelp t => String -> Mod t a
help String
"Websockets channel used to send events about the server state changes."))
      Parser
  Error
  (ByteString
   -> Bool
   -> Int
   -> Int
   -> Maybe Int
   -> Maybe Text
   -> Maybe Text
   -> AppConfig)
-> Parser Error ByteString
-> Parser
     Error
     (Bool
      -> Int
      -> Int
      -> Maybe Int
      -> Maybe Text
      -> Maybe Text
      -> AppConfig)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Reader Error ByteString
-> String -> Mod Var ByteString -> Parser Error ByteString
forall e a.
AsUnset e =>
Reader e a -> String -> Mod Var a -> Parser e a
var Reader Error ByteString
forall s e. IsString s => Reader e s
str String
"PGWS_JWT_SECRET" (String -> Mod Var ByteString
forall (t :: * -> *) a. HasHelp t => String -> Mod t a
help String
"Secret used to sign JWT tokens used to open communications channels")
      Parser
  Error
  (Bool
   -> Int
   -> Int
   -> Maybe Int
   -> Maybe Text
   -> Maybe Text
   -> AppConfig)
-> Parser Error Bool
-> Parser
     Error
     (Int -> Int -> Maybe Int -> Maybe Text -> Maybe Text -> AppConfig)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Reader Error Bool -> String -> Mod Var Bool -> Parser Error Bool
forall e a.
AsUnset e =>
Reader e a -> String -> Mod Var a -> Parser e a
var Reader Error Bool
forall e a. (AsUnread e, Read a) => Reader e a
auto String
"PGWS_JWT_SECRET_BASE64" (Bool -> Mod Var Bool
forall a. a -> Mod Var a
def Bool
False Mod Var Bool -> Mod Var Bool -> Mod Var Bool
forall a. Semigroup a => a -> a -> a
<> (Bool -> String) -> Mod Var Bool
forall a. (a -> String) -> Mod Var a
helpDef Bool -> String
forall a b. (Show a, ConvertText String b) => a -> b
show Mod Var Bool -> Mod Var Bool -> Mod Var Bool
forall a. Semigroup a => a -> a -> a
<> String -> Mod Var Bool
forall (t :: * -> *) a. HasHelp t => String -> Mod t a
help String
"Indicate whether the JWT secret should be decoded from a base64 encoded string")
      Parser
  Error
  (Int -> Int -> Maybe Int -> Maybe Text -> Maybe Text -> AppConfig)
-> Parser Error Int
-> Parser
     Error (Int -> Maybe Int -> Maybe Text -> Maybe Text -> AppConfig)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Reader Error Int -> String -> Mod Var Int -> Parser Error Int
forall e a.
AsUnset e =>
Reader e a -> String -> Mod Var a -> Parser e a
var Reader Error Int
forall e a. (AsUnread e, Read a) => Reader e a
auto String
"PGWS_POOL_SIZE" (Int -> Mod Var Int
forall a. a -> Mod Var a
def Int
10 Mod Var Int -> Mod Var Int -> Mod Var Int
forall a. Semigroup a => a -> a -> a
<> (Int -> String) -> Mod Var Int
forall a. (a -> String) -> Mod Var a
helpDef Int -> String
forall a b. (Show a, ConvertText String b) => a -> b
show Mod Var Int -> Mod Var Int -> Mod Var Int
forall a. Semigroup a => a -> a -> a
<> String -> Mod Var Int
forall (t :: * -> *) a. HasHelp t => String -> Mod t a
help String
"How many connection to the database should be used by the connection pool")
      Parser
  Error (Int -> Maybe Int -> Maybe Text -> Maybe Text -> AppConfig)
-> Parser Error Int
-> Parser
     Error (Maybe Int -> Maybe Text -> Maybe Text -> AppConfig)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Reader Error Int -> String -> Mod Var Int -> Parser Error Int
forall e a.
AsUnset e =>
Reader e a -> String -> Mod Var a -> Parser e a
var Reader Error Int
forall e a. (AsUnread e, Read a) => Reader e a
auto String
"PGWS_RETRIES" (Int -> Mod Var Int
forall a. a -> Mod Var a
def Int
5 Mod Var Int -> Mod Var Int -> Mod Var Int
forall a. Semigroup a => a -> a -> a
<> (Int -> String) -> Mod Var Int
forall a. (a -> String) -> Mod Var a
helpDef Int -> String
forall a b. (Show a, ConvertText String b) => a -> b
show Mod Var Int -> Mod Var Int -> Mod Var Int
forall a. Semigroup a => a -> a -> a
<> String -> Mod Var Int
forall (t :: * -> *) a. HasHelp t => String -> Mod t a
help String
"How many times it should try to connect to the database on startup before exiting with an error")
      Parser Error (Maybe Int -> Maybe Text -> Maybe Text -> AppConfig)
-> Parser Error (Maybe Int)
-> Parser Error (Maybe Text -> Maybe Text -> AppConfig)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Error Int -> Parser Error (Maybe Int)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Reader Error Int -> String -> Mod Var Int -> Parser Error Int
forall e a.
AsUnset e =>
Reader e a -> String -> Mod Var a -> Parser e a
var Reader Error Int
forall e a. (AsUnread e, Read a) => Reader e a
auto String
"PGWS_CHECK_LISTENER_INTERVAL" ((Int -> String) -> Mod Var Int
forall a. (a -> String) -> Mod Var a
helpDef Int -> String
forall a b. (Show a, ConvertText String b) => a -> b
show Mod Var Int -> Mod Var Int -> Mod Var Int
forall a. Semigroup a => a -> a -> a
<> String -> Mod Var Int
forall (t :: * -> *) a. HasHelp t => String -> Mod t a
help String
"Interval for supervisor thread to check if listener connection is alive. 0 to disable it."))
      Parser Error (Maybe Text -> Maybe Text -> AppConfig)
-> Parser Error (Maybe Text)
-> Parser Error (Maybe Text -> AppConfig)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Error Text -> Parser Error (Maybe Text)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Reader Error Text -> String -> Mod Var Text -> Parser Error Text
forall e a.
AsUnset e =>
Reader e a -> String -> Mod Var a -> Parser e a
var Reader Error Text
forall s e. IsString s => Reader e s
str String
"PGWS_CERTIFICATE_FILE" ((Text -> String) -> Mod Var Text
forall a. (a -> String) -> Mod Var a
helpDef Text -> String
forall a b. (Show a, ConvertText String b) => a -> b
show Mod Var Text -> Mod Var Text -> Mod Var Text
forall a. Semigroup a => a -> a -> a
<> String -> Mod Var Text
forall (t :: * -> *) a. HasHelp t => String -> Mod t a
help String
"Certificate file to serve secure websockets connection (wss)."))
      Parser Error (Maybe Text -> AppConfig)
-> Parser Error (Maybe Text) -> Parser Error AppConfig
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Error Text -> Parser Error (Maybe Text)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Reader Error Text -> String -> Mod Var Text -> Parser Error Text
forall e a.
AsUnset e =>
Reader e a -> String -> Mod Var a -> Parser e a
var Reader Error Text
forall s e. IsString s => Reader e s
str String
"PGWS_KEY_FILE" ((Text -> String) -> Mod Var Text
forall a. (a -> String) -> Mod Var a
helpDef Text -> String
forall a b. (Show a, ConvertText String b) => a -> b
show Mod Var Text -> Mod Var Text -> Mod Var Text
forall a. Semigroup a => a -> a -> a
<> String -> Mod Var Text
forall (t :: * -> *) a. HasHelp t => String -> Mod t a
help String
"Key file to serve secure websockets connection (wss)."))

verifyTLSConfig :: AppConfig -> IO AppConfig
verifyTLSConfig :: AppConfig -> IO AppConfig
verifyTLSConfig conf :: AppConfig
conf@AppConfig {Bool
Int
Maybe Int
Maybe Text
ByteString
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
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
..} = do
  Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Maybe Text -> Bool
forall a. Maybe a -> Bool
isJust Maybe Text
configCertificateFile Bool -> Bool -> Bool
forall a. Eq a => a -> a -> Bool
/= Maybe Text -> Bool
forall a. Maybe a -> Bool
isJust Maybe Text
configKeyFile) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
    Text -> IO ()
forall a. HasCallStack => Text -> a
panic Text
"PGWS_TLS_CERTIFICATE and PGWS_TLS_KEY must be set in tandem"
  AppConfig -> IO AppConfig
forall (f :: * -> *) a. Applicative f => a -> f a
pure AppConfig
conf

loadDatabaseURIFile :: AppConfig -> IO AppConfig
loadDatabaseURIFile :: AppConfig -> IO AppConfig
loadDatabaseURIFile conf :: AppConfig
conf@AppConfig {Bool
Int
Maybe Int
Maybe Text
ByteString
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
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
..} =
  case Text -> Text -> Maybe Text
stripPrefix Text
"@" Text
configDatabase of
    Maybe Text
Nothing -> AppConfig -> IO AppConfig
forall (f :: * -> *) a. Applicative f => a -> f a
pure AppConfig
conf
    Just Text
filename -> Text -> AppConfig
setDatabase (Text -> AppConfig) -> (Text -> Text) -> Text -> AppConfig
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
strip (Text -> AppConfig) -> IO Text -> IO AppConfig
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> IO Text
readFile (Text -> String
forall a b. StringConv a b => a -> b
toS Text
filename)
  where
    setDatabase :: Text -> AppConfig
setDatabase Text
uri = AppConfig
conf {configDatabase :: Text
configDatabase = Text
uri}

loadSecretFile :: AppConfig -> IO AppConfig
loadSecretFile :: AppConfig -> IO AppConfig
loadSecretFile AppConfig
conf = Text -> IO AppConfig
extractAndTransform Text
secret
  where
    secret :: Text
secret = ByteString -> Text
decodeUtf8 (ByteString -> Text) -> ByteString -> Text
forall a b. (a -> b) -> a -> b
$ AppConfig -> ByteString
configJwtSecret AppConfig
conf
    isB64 :: Bool
isB64 = AppConfig -> Bool
configJwtSecretIsBase64 AppConfig
conf

    extractAndTransform :: Text -> IO AppConfig
    extractAndTransform :: Text -> IO AppConfig
extractAndTransform Text
s =
      (ByteString -> AppConfig) -> IO ByteString -> IO AppConfig
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ByteString -> AppConfig
setSecret (IO ByteString -> IO AppConfig) -> IO ByteString -> IO AppConfig
forall a b. (a -> b) -> a -> b
$
        Bool -> ByteString -> IO ByteString
transformString Bool
isB64
          (ByteString -> IO ByteString) -> IO ByteString -> IO ByteString
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< case Text -> Text -> Maybe Text
stripPrefix Text
"@" Text
s of
            Maybe Text
Nothing -> ByteString -> IO ByteString
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString -> IO ByteString)
-> (Text -> ByteString) -> Text -> IO ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
encodeUtf8 (Text -> IO ByteString) -> Text -> IO ByteString
forall a b. (a -> b) -> a -> b
$ Text
s
            Just Text
filename -> ByteString -> ByteString
chomp (ByteString -> ByteString) -> IO ByteString -> IO ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> IO ByteString
BS.readFile (Text -> String
forall a b. StringConv a b => a -> b
toS Text
filename)
      where
        chomp :: ByteString -> ByteString
chomp ByteString
bs = ByteString -> Maybe ByteString -> ByteString
forall a. a -> Maybe a -> a
fromMaybe ByteString
bs (ByteString -> ByteString -> Maybe ByteString
BS.stripSuffix ByteString
"\n" ByteString
bs)

    -- Turns the Base64url encoded JWT into Base64
    transformString :: Bool -> ByteString -> IO ByteString
    transformString :: Bool -> ByteString -> IO ByteString
transformString Bool
False ByteString
t = ByteString -> IO ByteString
forall (m :: * -> *) a. Monad m => a -> m a
return ByteString
t
    transformString Bool
True ByteString
t =
      case ByteString -> Either String ByteString
B64.decode (ByteString -> Either String ByteString)
-> ByteString -> Either String ByteString
forall a b. (a -> b) -> a -> b
$ Text -> ByteString
encodeUtf8 (Text -> ByteString) -> Text -> ByteString
forall a b. (a -> b) -> a -> b
$ Text -> Text
strip (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ Text -> Text
replaceUrlChars (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ ByteString -> Text
decodeUtf8 ByteString
t of
        Left String
errMsg -> Text -> IO ByteString
forall a. HasCallStack => Text -> a
panic (Text -> IO ByteString) -> Text -> IO ByteString
forall a b. (a -> b) -> a -> b
$ String -> Text
pack String
errMsg
        Right ByteString
bs -> ByteString -> IO ByteString
forall (m :: * -> *) a. Monad m => a -> m a
return ByteString
bs

    setSecret :: ByteString -> AppConfig
setSecret ByteString
bs = AppConfig
conf {configJwtSecret :: ByteString
configJwtSecret = ByteString
bs}

    -- replace: Replace every occurrence of one substring with another
    replaceUrlChars :: Text -> Text
replaceUrlChars =
      Text -> Text -> Text -> Text
replace Text
"_" Text
"/" (Text -> Text) -> (Text -> Text) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text -> Text -> Text
replace Text
"-" Text
"+" (Text -> Text) -> (Text -> Text) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text -> Text -> Text
replace Text
"." Text
"="