module Hydra.Tx.DepositPeriod where

import Hydra.Prelude hiding (Show, show)

import Hydra.Data.DepositPeriod qualified as OnChain
import Text.Show (Show (..))

-- | A non-negative duration used as the deposit validity window.
-- Nodes within the same Head must configure identical values. Use
-- 'fromNominalDiffTime' to create values of unknown sign.
--
-- NOTE: Zero is allowed, unlike 'Hydra.Tx.ContestationPeriod': it means "no
-- margin", degenerate but workable, and it is what a sub-second period
-- truncates to. Sub-millisecond precision is not, see 'fromNominalDiffTime'.
-- NOTE: 'FromJSON' is deliberately newtype-derived and therefore total, for the
-- same reason as 'Hydra.Tx.ContestationPeriod': it also decodes the persisted
-- event log. A configured period is validated at the configuration boundary
-- instead, see 'Hydra.Config.parseCardanoChainConfig'.
newtype DepositPeriod = DepositPeriod {DepositPeriod -> NominalDiffTime
toNominalDiffTime :: NominalDiffTime}
  deriving stock (DepositPeriod -> DepositPeriod -> Bool
(DepositPeriod -> DepositPeriod -> Bool)
-> (DepositPeriod -> DepositPeriod -> Bool) -> Eq DepositPeriod
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: DepositPeriod -> DepositPeriod -> Bool
== :: DepositPeriod -> DepositPeriod -> Bool
$c/= :: DepositPeriod -> DepositPeriod -> Bool
/= :: DepositPeriod -> DepositPeriod -> Bool
Eq, Eq DepositPeriod
Eq DepositPeriod =>
(DepositPeriod -> DepositPeriod -> Ordering)
-> (DepositPeriod -> DepositPeriod -> Bool)
-> (DepositPeriod -> DepositPeriod -> Bool)
-> (DepositPeriod -> DepositPeriod -> Bool)
-> (DepositPeriod -> DepositPeriod -> Bool)
-> (DepositPeriod -> DepositPeriod -> DepositPeriod)
-> (DepositPeriod -> DepositPeriod -> DepositPeriod)
-> Ord DepositPeriod
DepositPeriod -> DepositPeriod -> Bool
DepositPeriod -> DepositPeriod -> Ordering
DepositPeriod -> DepositPeriod -> DepositPeriod
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 :: DepositPeriod -> DepositPeriod -> Ordering
compare :: DepositPeriod -> DepositPeriod -> Ordering
$c< :: DepositPeriod -> DepositPeriod -> Bool
< :: DepositPeriod -> DepositPeriod -> Bool
$c<= :: DepositPeriod -> DepositPeriod -> Bool
<= :: DepositPeriod -> DepositPeriod -> Bool
$c> :: DepositPeriod -> DepositPeriod -> Bool
> :: DepositPeriod -> DepositPeriod -> Bool
$c>= :: DepositPeriod -> DepositPeriod -> Bool
>= :: DepositPeriod -> DepositPeriod -> Bool
$cmax :: DepositPeriod -> DepositPeriod -> DepositPeriod
max :: DepositPeriod -> DepositPeriod -> DepositPeriod
$cmin :: DepositPeriod -> DepositPeriod -> DepositPeriod
min :: DepositPeriod -> DepositPeriod -> DepositPeriod
Ord, (forall x. DepositPeriod -> Rep DepositPeriod x)
-> (forall x. Rep DepositPeriod x -> DepositPeriod)
-> Generic DepositPeriod
forall x. Rep DepositPeriod x -> DepositPeriod
forall x. DepositPeriod -> Rep DepositPeriod x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. DepositPeriod -> Rep DepositPeriod x
from :: forall x. DepositPeriod -> Rep DepositPeriod x
$cto :: forall x. Rep DepositPeriod x -> DepositPeriod
to :: forall x. Rep DepositPeriod x -> DepositPeriod
Generic)
  deriving newtype (ReadPrec [DepositPeriod]
ReadPrec DepositPeriod
Int -> ReadS DepositPeriod
ReadS [DepositPeriod]
(Int -> ReadS DepositPeriod)
-> ReadS [DepositPeriod]
-> ReadPrec DepositPeriod
-> ReadPrec [DepositPeriod]
-> Read DepositPeriod
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS DepositPeriod
readsPrec :: Int -> ReadS DepositPeriod
$creadList :: ReadS [DepositPeriod]
readList :: ReadS [DepositPeriod]
$creadPrec :: ReadPrec DepositPeriod
readPrec :: ReadPrec DepositPeriod
$creadListPrec :: ReadPrec [DepositPeriod]
readListPrec :: ReadPrec [DepositPeriod]
Read, Integer -> DepositPeriod
DepositPeriod -> DepositPeriod
DepositPeriod -> DepositPeriod -> DepositPeriod
(DepositPeriod -> DepositPeriod -> DepositPeriod)
-> (DepositPeriod -> DepositPeriod -> DepositPeriod)
-> (DepositPeriod -> DepositPeriod -> DepositPeriod)
-> (DepositPeriod -> DepositPeriod)
-> (DepositPeriod -> DepositPeriod)
-> (DepositPeriod -> DepositPeriod)
-> (Integer -> DepositPeriod)
-> Num DepositPeriod
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
$c+ :: DepositPeriod -> DepositPeriod -> DepositPeriod
+ :: DepositPeriod -> DepositPeriod -> DepositPeriod
$c- :: DepositPeriod -> DepositPeriod -> DepositPeriod
- :: DepositPeriod -> DepositPeriod -> DepositPeriod
$c* :: DepositPeriod -> DepositPeriod -> DepositPeriod
* :: DepositPeriod -> DepositPeriod -> DepositPeriod
$cnegate :: DepositPeriod -> DepositPeriod
negate :: DepositPeriod -> DepositPeriod
$cabs :: DepositPeriod -> DepositPeriod
abs :: DepositPeriod -> DepositPeriod
$csignum :: DepositPeriod -> DepositPeriod
signum :: DepositPeriod -> DepositPeriod
$cfromInteger :: Integer -> DepositPeriod
fromInteger :: Integer -> DepositPeriod
Num, Num DepositPeriod
Ord DepositPeriod
(Num DepositPeriod, Ord DepositPeriod) =>
(DepositPeriod -> Rational) -> Real DepositPeriod
DepositPeriod -> Rational
forall a. (Num a, Ord a) => (a -> Rational) -> Real a
$ctoRational :: DepositPeriod -> Rational
toRational :: DepositPeriod -> Rational
Real, [DepositPeriod] -> Value
[DepositPeriod] -> Encoding
DepositPeriod -> Bool
DepositPeriod -> Value
DepositPeriod -> Encoding
(DepositPeriod -> Value)
-> (DepositPeriod -> Encoding)
-> ([DepositPeriod] -> Value)
-> ([DepositPeriod] -> Encoding)
-> (DepositPeriod -> Bool)
-> ToJSON DepositPeriod
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> (a -> Bool)
-> ToJSON a
$ctoJSON :: DepositPeriod -> Value
toJSON :: DepositPeriod -> Value
$ctoEncoding :: DepositPeriod -> Encoding
toEncoding :: DepositPeriod -> Encoding
$ctoJSONList :: [DepositPeriod] -> Value
toJSONList :: [DepositPeriod] -> Value
$ctoEncodingList :: [DepositPeriod] -> Encoding
toEncodingList :: [DepositPeriod] -> Encoding
$comitField :: DepositPeriod -> Bool
omitField :: DepositPeriod -> Bool
ToJSON, Maybe DepositPeriod
Value -> Parser [DepositPeriod]
Value -> Parser DepositPeriod
(Value -> Parser DepositPeriod)
-> (Value -> Parser [DepositPeriod])
-> Maybe DepositPeriod
-> FromJSON DepositPeriod
forall a.
(Value -> Parser a)
-> (Value -> Parser [a]) -> Maybe a -> FromJSON a
$cparseJSON :: Value -> Parser DepositPeriod
parseJSON :: Value -> Parser DepositPeriod
$cparseJSONList :: Value -> Parser [DepositPeriod]
parseJSONList :: Value -> Parser [DepositPeriod]
$comittedField :: Maybe DepositPeriod
omittedField :: Maybe DepositPeriod
FromJSON)

instance ToCBOR DepositPeriod where
  toCBOR :: DepositPeriod -> Encoding
toCBOR = DepositPeriod -> Encoding
forall a. (Generic a, GToCBOR (Rep a)) => a -> Encoding
genericToCBOR

instance FromCBOR DepositPeriod where
  fromCBOR :: forall s. Decoder s DepositPeriod
fromCBOR = Decoder s DepositPeriod
forall a s. (Generic a, GFromCBOR (Rep a)) => Decoder s a
genericFromCBOR

instance Show DepositPeriod where
  show :: DepositPeriod -> String
show (DepositPeriod NominalDiffTime
dt) = Integer -> String
forall a. Show a => a -> String
show (NominalDiffTime -> Integer
forall b. Integral b => NominalDiffTime -> b
forall a b. (RealFrac a, Integral b) => a -> b
round NominalDiffTime
dt :: Integer) String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
"s"

-- | Create a 'DepositPeriod' from a 'NominalDiffTime', accepting exactly the
-- durations that survive the on-chain encoding: a non-negative whole number of
-- milliseconds.
--
-- A negative duration would invert the deposit window. A finer-grained one would
-- be written to the datum as a different period than the one configured, and the
-- initiator would then not recognise its own head, consuming the seed and
-- stranding the head output with no way to abort.
fromNominalDiffTime :: MonadFail m => NominalDiffTime -> m DepositPeriod
fromNominalDiffTime :: forall (m :: * -> *).
MonadFail m =>
NominalDiffTime -> m DepositPeriod
fromNominalDiffTime NominalDiffTime
dt
  | NominalDiffTime
dt NominalDiffTime -> NominalDiffTime -> Bool
forall a. Ord a => a -> a -> Bool
< NominalDiffTime
0 =
      String -> m DepositPeriod
forall a. String -> m a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> m DepositPeriod) -> String -> m DepositPeriod
forall a b. (a -> b) -> a -> b
$ String
"fromNominalDiffTime: deposit period < 0: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> NominalDiffTime -> String
forall a. Show a => a -> String
show NominalDiffTime
dt
  | DepositPeriod -> NominalDiffTime
OnChain.depositPeriodToDiffTime (NominalDiffTime -> DepositPeriod
OnChain.depositPeriodFromDiffTime NominalDiffTime
dt) NominalDiffTime -> NominalDiffTime -> Bool
forall a. Eq a => a -> a -> Bool
/= NominalDiffTime
dt =
      String -> m DepositPeriod
forall a. String -> m a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> m DepositPeriod) -> String -> m DepositPeriod
forall a b. (a -> b) -> a -> b
$ String
"fromNominalDiffTime: deposit period is not a whole number of milliseconds: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> NominalDiffTime -> String
forall a. Show a => a -> String
show NominalDiffTime
dt
  | Bool
otherwise = DepositPeriod -> m DepositPeriod
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (DepositPeriod -> m DepositPeriod)
-> DepositPeriod -> m DepositPeriod
forall a b. (a -> b) -> a -> b
$ NominalDiffTime -> DepositPeriod
DepositPeriod NominalDiffTime
dt

-- | Convert an off-chain deposit period to its on-chain representation.
toChain :: DepositPeriod -> OnChain.DepositPeriod
toChain :: DepositPeriod -> DepositPeriod
toChain (DepositPeriod NominalDiffTime
dt) = NominalDiffTime -> DepositPeriod
OnChain.depositPeriodFromDiffTime NominalDiffTime
dt

-- | Convert an on-chain deposit period to its off-chain representation.
-- The on-chain representation is a signed number of milliseconds with no sign
-- constraint, so an observed datum can carry a negative value, which would
-- invert the deposit window; such a period is rejected.
-- NOTE: Truncates to whole milliseconds.
fromChain :: OnChain.DepositPeriod -> Either Text DepositPeriod
fromChain :: DepositPeriod -> Either Text DepositPeriod
fromChain DepositPeriod
dp
  | NominalDiffTime
dt NominalDiffTime -> NominalDiffTime -> Bool
forall a. Ord a => a -> a -> Bool
>= NominalDiffTime
0 = DepositPeriod -> Either Text DepositPeriod
forall a b. b -> Either a b
Right (DepositPeriod -> Either Text DepositPeriod)
-> DepositPeriod -> Either Text DepositPeriod
forall a b. (a -> b) -> a -> b
$ NominalDiffTime -> DepositPeriod
DepositPeriod NominalDiffTime
dt
  | Bool
otherwise = Text -> Either Text DepositPeriod
forall a b. a -> Either a b
Left (Text -> Either Text DepositPeriod)
-> Text -> Either Text DepositPeriod
forall a b. (a -> b) -> a -> b
$ Text
"deposit period is negative: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
forall a. ToText a => a -> Text
toText (Integer -> String
forall a. Show a => a -> String
show (DiffMilliSeconds -> Integer
forall a. Integral a => a -> Integer
toInteger (DepositPeriod -> DiffMilliSeconds
OnChain.milliseconds DepositPeriod
dp))) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"ms"
 where
  dt :: NominalDiffTime
dt = DepositPeriod -> NominalDiffTime
OnChain.depositPeriodToDiffTime DepositPeriod
dp