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

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

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

-- | After demoting a peer to Warm or Cold, we use a delay to re-promote it
-- back.
--
newtype RepromoteDelay = RepromoteDelay { RepromoteDelay -> DiffTime
repromoteDelay :: DiffTime }
  deriving (RepromoteDelay -> RepromoteDelay -> Bool
(RepromoteDelay -> RepromoteDelay -> Bool)
-> (RepromoteDelay -> RepromoteDelay -> Bool) -> Eq RepromoteDelay
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: RepromoteDelay -> RepromoteDelay -> Bool
== :: RepromoteDelay -> RepromoteDelay -> Bool
$c/= :: RepromoteDelay -> RepromoteDelay -> Bool
/= :: RepromoteDelay -> RepromoteDelay -> Bool
Eq, Eq RepromoteDelay
Eq RepromoteDelay =>
(RepromoteDelay -> RepromoteDelay -> Ordering)
-> (RepromoteDelay -> RepromoteDelay -> Bool)
-> (RepromoteDelay -> RepromoteDelay -> Bool)
-> (RepromoteDelay -> RepromoteDelay -> Bool)
-> (RepromoteDelay -> RepromoteDelay -> Bool)
-> (RepromoteDelay -> RepromoteDelay -> RepromoteDelay)
-> (RepromoteDelay -> RepromoteDelay -> RepromoteDelay)
-> Ord RepromoteDelay
RepromoteDelay -> RepromoteDelay -> Bool
RepromoteDelay -> RepromoteDelay -> Ordering
RepromoteDelay -> RepromoteDelay -> RepromoteDelay
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
$ccompare :: RepromoteDelay -> RepromoteDelay -> Ordering
compare :: RepromoteDelay -> RepromoteDelay -> Ordering
$c< :: RepromoteDelay -> RepromoteDelay -> Bool
< :: RepromoteDelay -> RepromoteDelay -> Bool
$c<= :: RepromoteDelay -> RepromoteDelay -> Bool
<= :: RepromoteDelay -> RepromoteDelay -> Bool
$c> :: RepromoteDelay -> RepromoteDelay -> Bool
> :: RepromoteDelay -> RepromoteDelay -> Bool
$c>= :: RepromoteDelay -> RepromoteDelay -> Bool
>= :: RepromoteDelay -> RepromoteDelay -> Bool
$cmax :: RepromoteDelay -> RepromoteDelay -> RepromoteDelay
max :: RepromoteDelay -> RepromoteDelay -> RepromoteDelay
$cmin :: RepromoteDelay -> RepromoteDelay -> RepromoteDelay
min :: RepromoteDelay -> RepromoteDelay -> RepromoteDelay
Ord)
  deriving newtype Integer -> RepromoteDelay
RepromoteDelay -> RepromoteDelay
RepromoteDelay -> RepromoteDelay -> RepromoteDelay
(RepromoteDelay -> RepromoteDelay -> RepromoteDelay)
-> (RepromoteDelay -> RepromoteDelay -> RepromoteDelay)
-> (RepromoteDelay -> RepromoteDelay -> RepromoteDelay)
-> (RepromoteDelay -> RepromoteDelay)
-> (RepromoteDelay -> RepromoteDelay)
-> (RepromoteDelay -> RepromoteDelay)
-> (Integer -> RepromoteDelay)
-> Num RepromoteDelay
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
$c+ :: RepromoteDelay -> RepromoteDelay -> RepromoteDelay
+ :: RepromoteDelay -> RepromoteDelay -> RepromoteDelay
$c- :: RepromoteDelay -> RepromoteDelay -> RepromoteDelay
- :: RepromoteDelay -> RepromoteDelay -> RepromoteDelay
$c* :: RepromoteDelay -> RepromoteDelay -> RepromoteDelay
* :: RepromoteDelay -> RepromoteDelay -> RepromoteDelay
$cnegate :: RepromoteDelay -> RepromoteDelay
negate :: RepromoteDelay -> RepromoteDelay
$cabs :: RepromoteDelay -> RepromoteDelay
abs :: RepromoteDelay -> RepromoteDelay
$csignum :: RepromoteDelay -> RepromoteDelay
signum :: RepromoteDelay -> RepromoteDelay
$cfromInteger :: Integer -> RepromoteDelay
fromInteger :: Integer -> RepromoteDelay
Num
  deriving newtype Num RepromoteDelay
Num RepromoteDelay =>
(RepromoteDelay -> RepromoteDelay -> RepromoteDelay)
-> (RepromoteDelay -> RepromoteDelay)
-> (Rational -> RepromoteDelay)
-> Fractional RepromoteDelay
Rational -> RepromoteDelay
RepromoteDelay -> RepromoteDelay
RepromoteDelay -> RepromoteDelay -> RepromoteDelay
forall a.
Num a =>
(a -> a -> a) -> (a -> a) -> (Rational -> a) -> Fractional a
$c/ :: RepromoteDelay -> RepromoteDelay -> RepromoteDelay
/ :: RepromoteDelay -> RepromoteDelay -> RepromoteDelay
$crecip :: RepromoteDelay -> RepromoteDelay
recip :: RepromoteDelay -> RepromoteDelay
$cfromRational :: Rational -> RepromoteDelay
fromRational :: Rational -> RepromoteDelay
Fractional
  deriving NonEmpty RepromoteDelay -> RepromoteDelay
RepromoteDelay -> RepromoteDelay -> RepromoteDelay
(RepromoteDelay -> RepromoteDelay -> RepromoteDelay)
-> (NonEmpty RepromoteDelay -> RepromoteDelay)
-> (forall b. Integral b => b -> RepromoteDelay -> RepromoteDelay)
-> Semigroup RepromoteDelay
forall b. Integral b => b -> RepromoteDelay -> RepromoteDelay
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
$c<> :: RepromoteDelay -> RepromoteDelay -> RepromoteDelay
<> :: RepromoteDelay -> RepromoteDelay -> RepromoteDelay
$csconcat :: NonEmpty RepromoteDelay -> RepromoteDelay
sconcat :: NonEmpty RepromoteDelay -> RepromoteDelay
$cstimes :: forall b. Integral b => b -> RepromoteDelay -> RepromoteDelay
stimes :: forall b. Integral b => b -> RepromoteDelay -> RepromoteDelay
Semigroup via Max DiffTime


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

type ReturnPolicy a = a -> RepromoteDelay

-- | '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 'RepromoteDelay' from a 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 -> RepromoteDelay
epErrorDelay  :: RepromoteDelay
      }

alwaysCleanReturnPolicy :: RepromoteDelay -- ^ re-promote delay on error
                        -> ExitPolicy a
alwaysCleanReturnPolicy :: forall a. RepromoteDelay -> ExitPolicy a
alwaysCleanReturnPolicy = ReturnPolicy a -> RepromoteDelay -> ExitPolicy a
forall a. ReturnPolicy a -> RepromoteDelay -> ExitPolicy a
ExitPolicy (ReturnPolicy a -> RepromoteDelay -> ExitPolicy a)
-> ReturnPolicy a -> RepromoteDelay -> ExitPolicy a
forall a b. (a -> b) -> a -> b
$ \a
_ -> RepromoteDelay
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 :: RepromoteDelay
epErrorDelay = RepromoteDelay
10
      }