{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE ScopedTypeVariables #-}

module Simplex.Messaging.Agent.RetryInterval where

import Control.Concurrent (threadDelay)
import Control.Monad.IO.Class (MonadIO, liftIO)

data RetryInterval = RetryInterval
  { RetryInterval -> Int
initialInterval :: Int,
    RetryInterval -> Int
increaseAfter :: Int,
    RetryInterval -> Int
maxInterval :: Int
  }

withRetryInterval :: forall m. MonadIO m => RetryInterval -> (m () -> m ()) -> m ()
withRetryInterval :: RetryInterval -> (m () -> m ()) -> m ()
withRetryInterval RetryInterval {Int
initialInterval :: Int
initialInterval :: RetryInterval -> Int
initialInterval, Int
increaseAfter :: Int
increaseAfter :: RetryInterval -> Int
increaseAfter, Int
maxInterval :: Int
maxInterval :: RetryInterval -> Int
maxInterval} m () -> m ()
action =
  Int -> Int -> m ()
callAction Int
0 Int
initialInterval
  where
    callAction :: Int -> Int -> m ()
    callAction :: Int -> Int -> m ()
callAction Int
elapsedTime Int
delay = m () -> m ()
action m ()
loop
      where
        loop :: m ()
loop = do
          let newDelay :: Int
newDelay =
                if Int
elapsedTime Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
increaseAfter Bool -> Bool -> Bool
|| Int
delay Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
maxInterval
                  then Int
delay
                  else Int -> Int -> Int
forall a. Ord a => a -> a -> a
min (Int
delay Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
3 Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
2) Int
maxInterval
          IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ Int -> IO ()
threadDelay Int
delay
          Int -> Int -> m ()
callAction (Int
elapsedTime Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
delay) Int
newDelay