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

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

import           Control.Monad.Class.MonadTime.SI
import           Data.Semigroup (Max (..))

newtype ReconnectDelay = ReconnectDelay { ReconnectDelay -> DiffTime
reconnectDelay :: DiffTime }
  deriving (ReconnectDelay -> ReconnectDelay -> Bool
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, Eq ReconnectDelay
ReconnectDelay -> ReconnectDelay -> Bool
ReconnectDelay -> ReconnectDelay -> Ordering
ReconnectDelay -> ReconnectDelay -> ReconnectDelay
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: ReconnectDelay -> ReconnectDelay -> ReconnectDelay
$cmin :: ReconnectDelay -> ReconnectDelay -> ReconnectDelay
max :: ReconnectDelay -> ReconnectDelay -> ReconnectDelay
$cmax :: ReconnectDelay -> ReconnectDelay -> ReconnectDelay
>= :: ReconnectDelay -> ReconnectDelay -> Bool
$c>= :: ReconnectDelay -> ReconnectDelay -> Bool
> :: ReconnectDelay -> ReconnectDelay -> Bool
$c> :: ReconnectDelay -> ReconnectDelay -> Bool
<= :: ReconnectDelay -> ReconnectDelay -> Bool
$c<= :: ReconnectDelay -> ReconnectDelay -> Bool
< :: ReconnectDelay -> ReconnectDelay -> Bool
$c< :: ReconnectDelay -> ReconnectDelay -> Bool
compare :: ReconnectDelay -> ReconnectDelay -> Ordering
$ccompare :: ReconnectDelay -> ReconnectDelay -> Ordering
Ord)
  deriving newtype Integer -> ReconnectDelay
ReconnectDelay -> ReconnectDelay
ReconnectDelay -> ReconnectDelay -> 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
  deriving newtype Num ReconnectDelay
Rational -> ReconnectDelay
ReconnectDelay -> ReconnectDelay
ReconnectDelay -> ReconnectDelay -> ReconnectDelay
forall a.
Num a
-> (a -> a -> a) -> (a -> a) -> (Rational -> a) -> Fractional a
fromRational :: Rational -> ReconnectDelay
$cfromRational :: Rational -> ReconnectDelay
recip :: ReconnectDelay -> ReconnectDelay
$crecip :: ReconnectDelay -> ReconnectDelay
/ :: ReconnectDelay -> ReconnectDelay -> ReconnectDelay
$c/ :: ReconnectDelay -> ReconnectDelay -> ReconnectDelay
Fractional
  deriving NonEmpty ReconnectDelay -> ReconnectDelay
ReconnectDelay -> ReconnectDelay -> ReconnectDelay
forall b. Integral b => b -> ReconnectDelay -> ReconnectDelay
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
stimes :: forall b. Integral b => b -> ReconnectDelay -> ReconnectDelay
$cstimes :: forall b. Integral b => b -> ReconnectDelay -> ReconnectDelay
sconcat :: NonEmpty ReconnectDelay -> ReconnectDelay
$csconcat :: NonEmpty ReconnectDelay -> ReconnectDelay
<> :: ReconnectDelay -> ReconnectDelay -> ReconnectDelay
$c<> :: ReconnectDelay -> ReconnectDelay -> ReconnectDelay
Semigroup via Max DiffTime

-- It ought to be derived via 'Quiet' but 'Difftime' lacks 'Generic' instance.
instance Show ReconnectDelay where
    show :: ReconnectDelay -> String
show (ReconnectDelay DiffTime
d) = String
"ReconnectDelay " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show DiffTime
d

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.
        --
        forall a. ExitPolicy a -> ReturnPolicy a
epReturnDelay :: ReturnPolicy a,

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

alwaysCleanReturnPolicy :: ReconnectDelay -- ^ reconnection delay on error
                        -> ExitPolicy a
alwaysCleanReturnPolicy :: forall a. ReconnectDelay -> ExitPolicy a
alwaysCleanReturnPolicy = forall a. ReturnPolicy a -> ReconnectDelay -> ExitPolicy a
ExitPolicy forall a b. (a -> b) -> a -> b
$ \a
_ -> ReconnectDelay
0

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