postgres-websockets 0.8.0.1 → 0.9.0.0

raw patch · 5 files changed

+30/−19 lines, 5 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• postgres-websockets.cabal +1/−1
• src/PostgresWebsockets.hs +1/−1
• src/PostgresWebsockets/Config.hs +11/−1
• src/PostgresWebsockets/HasqlBroadcast.hs +7/−7
• src/PostgresWebsockets/Server.hs +10/−9

@@ -1,5 +1,5 @@ name:                postgres-websockets-version:             0.8.0.1+version:             0.9.0.0 synopsis:            Middleware to map LISTEN/NOTIFY messages to Websockets description:         Please see README.md homepage:            https://github.com/diogob/postgres-websockets#readme

@@ -2,7 +2,7 @@ Module      : PostgresWebsockets Description : PostgresWebsockets main library interface. -These are all function necessary to start a fully functionaing service.+These are all function necessary to configure and start the server. -} module PostgresWebsockets   ( prettyVersion

@@ -34,6 +34,7 @@   , configJwtSecret         :: ByteString   , configJwtSecretIsBase64 :: Bool   , configPool              :: Int+  , configRetries           :: Int   }  -- | User friendly version number@@ -42,7 +43,7 @@  -- | 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 = readOptions >>= loadSecretFile+loadConfig = readOptions >>= loadSecretFile >>= loadDatabaseURIFile  -- | Given a shutdown handler and an AppConfig builds a Warp Settings to start a stand-alone server warpSettings :: (IO () -> IO ()) -> AppConfig -> Settings@@ -70,6 +71,15 @@                 <*> var str "PGWS_JWT_SECRET" (help "Secret used to sign JWT tokens used to open communications channels")                 <*> var auto "PGWS_JWT_SECRET_BASE64" (def False <> helpDef show <> help "Indicate whether the JWT secret should be decoded from a base64 encoded string")                 <*> var auto "PGWS_POOL_SIZE" (def 10 <> helpDef show <> help "How many connection to the database should be used by the connection pool")+                <*> var auto "PGWS_RETRIES" (def 5 <> helpDef show <> help "How many times it should try to connect to the database on startup before exiting with an error")++loadDatabaseURIFile :: AppConfig -> IO AppConfig+loadDatabaseURIFile conf@AppConfig{..} =+  case stripPrefix "@" configDatabase of+    Nothing       -> pure conf+    Just filename -> setDatabase . strip <$> readFile (toS filename)+  where+    setDatabase uri = conf {configDatabase = uri}  loadSecretFile :: AppConfig -> IO AppConfig loadSecretFile conf = extractAndTransform secret

@@ -23,15 +23,15 @@ import Data.HashMap.Lazy       (lookupDefault) import Data.Either.Combinators (mapBoth) import Data.Function           (id)-import Control.Retry           (RetryStatus, retrying, capDelay, exponentialBackoff)+import Control.Retry           (RetryStatus(..), retrying, capDelay, exponentialBackoff)  import PostgresWebsockets.Broadcast  {- | Returns a multiplexer from a connection URI, keeps trying to connect in case there is any error.    This function also spawns a thread that keeps relaying the messages from the database to the multiplexer's listeners -}-newHasqlBroadcaster :: IO () -> Text -> ByteString -> IO Multiplexer-newHasqlBroadcaster onConnectionFailure ch = newHasqlBroadcasterForConnection . tryUntilConnected+newHasqlBroadcaster :: IO () -> Text -> Int -> ByteString -> IO Multiplexer+newHasqlBroadcaster onConnectionFailure ch maxRetries = newHasqlBroadcasterForConnection . tryUntilConnected maxRetries   where     newHasqlBroadcasterForConnection = newHasqlBroadcasterForChannel onConnectionFailure ch @@ -44,8 +44,8 @@   where     newHasqlBroadcasterForConnection = newHasqlBroadcasterForChannel onConnectionFailure ch -tryUntilConnected :: ByteString -> IO Connection-tryUntilConnected =+tryUntilConnected :: Int -> ByteString -> IO Connection+tryUntilConnected maxRetries =   fmap (either (panic "Failure on connection retry") id) . retryConnection   where     retryConnection conStr = retrying retryPolicy shouldRetry (const $ acquire conStr)@@ -53,11 +53,11 @@     firstDelayInMicroseconds = 1000000     retryPolicy = capDelay maxDelayInMicroseconds $ exponentialBackoff firstDelayInMicroseconds     shouldRetry :: RetryStatus -> Either ConnectionError Connection -> IO Bool-    shouldRetry _ con =+    shouldRetry RetryStatus{..} con =       case con of         Left err -> do           putErrLn $ "Error connecting notification listener to database: " <> show err-          return True+          pure $ rsIterNumber < maxRetries - 1         _ -> return False  {- | Returns a multiplexer from a channel and an IO Connection, listen for different database notifications on the provided channel using the connection produced.

@@ -25,23 +25,24 @@  -- | Start a stand-alone warp server using the parameters from AppConfig and a opening a database connection pool. serve :: AppConfig -> IO ()-serve conf = do+serve conf@AppConfig{..} = do   shutdownSignal <- newEmptyMVar-  let listenChannel = toS $ configListenChannel conf-      pgSettings = toS (configDatabase conf)-      waitForShutdown cl = void $ forkIO (takeMVar shutdownSignal >> cl >> die "Shutting server down...")+  let listenChannel = toS configListenChannel+      pgSettings = toS configDatabase+      waitForShutdown cl = void $ forkIO (takeMVar shutdownSignal >> cl)       appSettings = warpSettings waitForShutdown conf -  putStrLn $ ("Listening on port " :: Text) <> show (configPort conf)+  putStrLn $ ("Listening on port " :: Text) <> show configPort    let shutdown = putErrLn ("Broadcaster connection is dead" :: Text) >> putMVar shutdownSignal ()-  pool <- P.acquire (configPool conf, 10, pgSettings)-  multi <- newHasqlBroadcaster shutdown listenChannel pgSettings+  pool <- P.acquire (configPool, 10, pgSettings)+  multi <- newHasqlBroadcaster shutdown listenChannel configRetries pgSettings   getTime <- mkGetTime    runSettings appSettings $-    postgresWsMiddleware getTime listenChannel (configJwtSecret conf) pool multi $-    logStdout $ maybe dummyApp staticApp' (configPath conf)+    postgresWsMiddleware getTime listenChannel configJwtSecret pool multi $+    logStdout $ maybe dummyApp staticApp' configPath+  die "Shutting down server..."    where     mkGetTime :: IO (IO UTCTime)