Complete runtime resilience and audit controls

app/Main.hs

@@ -1,7 +1,5 @@
 module Main (main) where
 
-import           Control.Concurrent (threadDelay)
-import           Control.Exception (SomeException, try)
 import           Data.String (fromString)
 import           Database.PostgreSQL.Simple (Only (..))
 import           Network.Wai.Handler.Warp
@@ -15,6 +13,7 @@ import           Nuthatch
 import           Nuthatch.Db (migrate, query_, withDb)
 import           Nuthatch.Redis (withRedis)
 import           Nuthatch.Recovery (withLinkedWorker)
+import           Nuthatch.Runtime (retryStartup)
 import           Nuthatch.S3 (newS3)
 import           System.Directory (doesDirectoryExist)
 import           System.FilePath ((</>))
@@ -24,10 +23,20 @@ main :: IO ()
 main = do
   hSetBuffering stdout LineBuffering
   cfg <- loadConfig
-  waitForPostgres cfg
+  retryStartup
+    (cfgStartupAttempts cfg)
+    (cfgStartupDelayMs cfg)
+    "postgresql"
+    (withDb cfg $ \db -> do
+      _ <- query_ db "SELECT 1" :: IO [Only Int]
+      pure ())
   withDb cfg $ \db -> do
     schemaPath <- findSchema
-    migrate db schemaPath cfg
+    retryStartup
+      (cfgStartupAttempts cfg)
+      (cfgStartupDelayMs cfg)
+      "migration"
+      (migrate db schemaPath cfg)
     withRedis cfg $ \redis -> do
       s3 <- newS3 cfg
       let env = newEnv cfg db redis s3
@@ -45,21 +54,6 @@ main = do
           settings
           (application env)
 
-waitForPostgres :: Config -> IO ()
-waitForPostgres cfg = go (60 :: Int)
-  where
-    go 0 = fail "postgres did not become ready"
-    go n = do
-      result <- try $ withDb cfg $ \db -> do
-        _ <- query_ db "SELECT 1" :: IO [Only Int]
-        pure ()
-      case result of
-        Right () -> pure ()
-        Left (e :: SomeException) -> do
-          putStrLn $ "waiting for postgres (" <> show n <> "): " <> show e
-          threadDelay 1000000
-          go (n - 1)
-
 findSchema :: IO FilePath
 findSchema = do
   let candidates =