45 lines
1.4 KiB
Haskell
45 lines
1.4 KiB
Haskell
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
|