Complete runtime resilience and audit controls

src/Nuthatch/Runtime.hs

@@ -0,0 +1,45 @@
+module Nuthatch.Runtime
+  ( retryStartup
+  ) where
+
+import           Control.Exception (SomeException)
+import           Control.Retry
+  ( RetryStatus (..)
+  , constantDelay
+  , limitRetries
+  , retrying
+  )
+import           Data.Aeson (Value (String), toJSON)
+import           Data.Either (isLeft)
+import           Data.Text (Text)
+import qualified Data.Text as T
+import           Nuthatch.Audit (audit)
+import           Nuthatch.Recovery (trySynchronous)
+
+retryStartup :: Int -> Int -> Text -> IO value -> IO value
+retryStartup attempts delayMs dependency action = do
+  result <- retrying policy shouldRetry $ \_ ->
+    tryStartup action
+  case result of
+    Right value -> pure value
+    Left _ -> do
+      audit "dependency_startup" "exhausted" Nothing
+        [ ("dependency", String dependency)
+        , ("attempts", toJSON attempts)
+        ]
+      fail ("startup dependency unavailable: " <> T.unpack dependency)
+  where
+    policy =
+      limitRetries (max 0 (attempts - 1))
+        <> constantDelay (max 1 delayMs * 1000)
+    shouldRetry status outcome = do
+      if isLeft outcome
+        then audit "dependency_startup" "retry" Nothing
+          [ ("dependency", String dependency)
+          , ("attempt", toJSON (rsIterNumber status + 1))
+          ]
+        else pure ()
+      pure (isLeft outcome)
+
+tryStartup :: IO value -> IO (Either SomeException value)
+tryStartup = trySynchronous