{-# LANGUAGE DerivingStrategies         #-}
{-# LANGUAGE GeneralisedNewtypeDeriving #-}
{-# LANGUAGE NamedFieldPuns             #-}

module Ouroboros.Network.ExitPolicy
  ( ReconnectDelay (..)
  , ExitPolicy (..)
  , stdExitPolicy
  , ReturnPolicy
  , alwaysCleanReturnPolicy
  ) where

import           Control.Monad.Class.MonadTime

newtype ReconnectDelay = ReconnectDelay { ReconnectDelay -> DiffTime
reconnectDelay :: DiffTime }
  deriving ReconnectDelay -> ReconnectDelay -> Bool
(ReconnectDelay -> ReconnectDelay -> Bool)
-> (ReconnectDelay -> ReconnectDelay -> Bool) -> Eq ReconnectDelay
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ReconnectDelay -> ReconnectDelay -> Bool
$c/= :: ReconnectDelay -> ReconnectDelay -> Bool
== :: ReconnectDelay -> ReconnectDelay -> Bool
$c== :: ReconnectDelay -> ReconnectDelay -> Bool
Eq
  deriving newtype Integer -> ReconnectDelay
ReconnectDelay -> ReconnectDelay
ReconnectDelay -> ReconnectDelay -> ReconnectDelay
(ReconnectDelay -> ReconnectDelay -> ReconnectDelay)
-> (ReconnectDelay -> ReconnectDelay -> ReconnectDelay)
-> (ReconnectDelay -> ReconnectDelay -> ReconnectDelay)
-> (ReconnectDelay -> ReconnectDelay)
-> (ReconnectDelay -> ReconnectDelay)
-> (ReconnectDelay -> ReconnectDelay)
-> (Integer -> ReconnectDelay)
-> Num ReconnectDelay
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
fromInteger :: Integer -> ReconnectDelay
$cfromInteger :: Integer -> ReconnectDelay
signum :: ReconnectDelay -> ReconnectDelay
$csignum :: ReconnectDelay -> ReconnectDelay
abs :: ReconnectDelay -> ReconnectDelay
$cabs :: ReconnectDelay -> ReconnectDelay
negate :: ReconnectDelay -> ReconnectDelay
$cnegate :: ReconnectDelay -> ReconnectDelay
* :: ReconnectDelay -> ReconnectDelay -> ReconnectDelay
$c* :: ReconnectDelay -> ReconnectDelay -> ReconnectDelay
- :: ReconnectDelay -> ReconnectDelay -> ReconnectDelay
$c- :: ReconnectDelay -> ReconnectDelay -> ReconnectDelay
+ :: ReconnectDelay -> ReconnectDelay -> ReconnectDelay
$c+ :: ReconnectDelay -> ReconnectDelay -> ReconnectDelay
Num

-- | 'ReconnectDelay' is an additive monoid.
--
instance Semigroup ReconnectDelay where
    ReconnectDelay DiffTime
a <> :: ReconnectDelay -> ReconnectDelay -> ReconnectDelay
<> ReconnectDelay DiffTime
b = DiffTime -> ReconnectDelay
ReconnectDelay (DiffTime
a DiffTime -> DiffTime -> DiffTime
forall a. Num a => a -> a -> a
+ DiffTime
b)

instance Monoid ReconnectDelay where
    mempty :: ReconnectDelay
mempty = DiffTime -> ReconnectDelay
ReconnectDelay DiffTime
0

type ReturnPolicy a = a -> ReconnectDelay

-- | 'ReturnPolicy' allows to compute reconnection delay from value return by
-- a mini-protocol.  If a mini-protocol returned with an error 'epErrorDelay'
-- is used.
data ExitPolicy a =
    ExitPolicy {
        -- | Compute 'ReturnCommand' from return value.
        --
        ExitPolicy a -> ReturnPolicy a
epReturnDelay :: ReturnPolicy a,

        -- | The delay when a mini-protocol returned with an error.
        --
        ExitPolicy a -> ReconnectDelay
epErrorDelay  :: ReconnectDelay
      }

alwaysCleanReturnPolicy :: ReconnectDelay -- ^ reconnection delay on error
                        -> ExitPolicy a
alwaysCleanReturnPolicy :: ReconnectDelay -> ExitPolicy a
alwaysCleanReturnPolicy = ReturnPolicy a -> ReconnectDelay -> ExitPolicy a
forall a. ReturnPolicy a -> ReconnectDelay -> ExitPolicy a
ExitPolicy ReturnPolicy a
forall a. Monoid a => a
mempty

-- | 'ExitPolicy' with 10s error delay.
--
stdExitPolicy :: ReturnPolicy a -> ExitPolicy a
stdExitPolicy :: ReturnPolicy a -> ExitPolicy a
stdExitPolicy ReturnPolicy a
epReturnDelay =
    ExitPolicy :: forall a. ReturnPolicy a -> ReconnectDelay -> ExitPolicy a
ExitPolicy {
        ReturnPolicy a
epReturnDelay :: ReturnPolicy a
epReturnDelay :: ReturnPolicy a
epReturnDelay,
        epErrorDelay :: ReconnectDelay
epErrorDelay = ReconnectDelay
10
      }