{-# LANGUAGE TemplateHaskell #-}

module Hydra.Data.ContestationPeriod where

import Hydra.Prelude

import PlutusTx.Prelude qualified as Plutus

import Data.Ratio ((%))
import Data.Time (nominalDiffTimeToSeconds, secondsToNominalDiffTime)
import PlutusLedgerApi.V1.Time (DiffMilliSeconds, fromMilliSeconds)
import PlutusLedgerApi.V3 (POSIXTime (..))
import PlutusTx qualified

newtype ContestationPeriod = UnsafeContestationPeriod {ContestationPeriod -> DiffMilliSeconds
milliseconds :: DiffMilliSeconds}
  deriving stock ((forall x. ContestationPeriod -> Rep ContestationPeriod x)
-> (forall x. Rep ContestationPeriod x -> ContestationPeriod)
-> Generic ContestationPeriod
forall x. Rep ContestationPeriod x -> ContestationPeriod
forall x. ContestationPeriod -> Rep ContestationPeriod x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ContestationPeriod -> Rep ContestationPeriod x
from :: forall x. ContestationPeriod -> Rep ContestationPeriod x
$cto :: forall x. Rep ContestationPeriod x -> ContestationPeriod
to :: forall x. Rep ContestationPeriod x -> ContestationPeriod
Generic, ContestationPeriod -> ContestationPeriod -> Bool
(ContestationPeriod -> ContestationPeriod -> Bool)
-> (ContestationPeriod -> ContestationPeriod -> Bool)
-> Eq ContestationPeriod
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ContestationPeriod -> ContestationPeriod -> Bool
== :: ContestationPeriod -> ContestationPeriod -> Bool
$c/= :: ContestationPeriod -> ContestationPeriod -> Bool
/= :: ContestationPeriod -> ContestationPeriod -> Bool
Eq, Eq ContestationPeriod
Eq ContestationPeriod =>
(ContestationPeriod -> ContestationPeriod -> Ordering)
-> (ContestationPeriod -> ContestationPeriod -> Bool)
-> (ContestationPeriod -> ContestationPeriod -> Bool)
-> (ContestationPeriod -> ContestationPeriod -> Bool)
-> (ContestationPeriod -> ContestationPeriod -> Bool)
-> (ContestationPeriod -> ContestationPeriod -> ContestationPeriod)
-> (ContestationPeriod -> ContestationPeriod -> ContestationPeriod)
-> Ord ContestationPeriod
ContestationPeriod -> ContestationPeriod -> Bool
ContestationPeriod -> ContestationPeriod -> Ordering
ContestationPeriod -> ContestationPeriod -> ContestationPeriod
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 :: ContestationPeriod -> ContestationPeriod -> Ordering
compare :: ContestationPeriod -> ContestationPeriod -> Ordering
$c< :: ContestationPeriod -> ContestationPeriod -> Bool
< :: ContestationPeriod -> ContestationPeriod -> Bool
$c<= :: ContestationPeriod -> ContestationPeriod -> Bool
<= :: ContestationPeriod -> ContestationPeriod -> Bool
$c> :: ContestationPeriod -> ContestationPeriod -> Bool
> :: ContestationPeriod -> ContestationPeriod -> Bool
$c>= :: ContestationPeriod -> ContestationPeriod -> Bool
>= :: ContestationPeriod -> ContestationPeriod -> Bool
$cmax :: ContestationPeriod -> ContestationPeriod -> ContestationPeriod
max :: ContestationPeriod -> ContestationPeriod -> ContestationPeriod
$cmin :: ContestationPeriod -> ContestationPeriod -> ContestationPeriod
min :: ContestationPeriod -> ContestationPeriod -> ContestationPeriod
Ord, Int -> ContestationPeriod -> ShowS
[ContestationPeriod] -> ShowS
ContestationPeriod -> String
(Int -> ContestationPeriod -> ShowS)
-> (ContestationPeriod -> String)
-> ([ContestationPeriod] -> ShowS)
-> Show ContestationPeriod
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ContestationPeriod -> ShowS
showsPrec :: Int -> ContestationPeriod -> ShowS
$cshow :: ContestationPeriod -> String
show :: ContestationPeriod -> String
$cshowList :: [ContestationPeriod] -> ShowS
showList :: [ContestationPeriod] -> ShowS
Show)
  deriving newtype (Integer -> ContestationPeriod
ContestationPeriod -> ContestationPeriod
ContestationPeriod -> ContestationPeriod -> ContestationPeriod
(ContestationPeriod -> ContestationPeriod -> ContestationPeriod)
-> (ContestationPeriod -> ContestationPeriod -> ContestationPeriod)
-> (ContestationPeriod -> ContestationPeriod -> ContestationPeriod)
-> (ContestationPeriod -> ContestationPeriod)
-> (ContestationPeriod -> ContestationPeriod)
-> (ContestationPeriod -> ContestationPeriod)
-> (Integer -> ContestationPeriod)
-> Num ContestationPeriod
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
$c+ :: ContestationPeriod -> ContestationPeriod -> ContestationPeriod
+ :: ContestationPeriod -> ContestationPeriod -> ContestationPeriod
$c- :: ContestationPeriod -> ContestationPeriod -> ContestationPeriod
- :: ContestationPeriod -> ContestationPeriod -> ContestationPeriod
$c* :: ContestationPeriod -> ContestationPeriod -> ContestationPeriod
* :: ContestationPeriod -> ContestationPeriod -> ContestationPeriod
$cnegate :: ContestationPeriod -> ContestationPeriod
negate :: ContestationPeriod -> ContestationPeriod
$cabs :: ContestationPeriod -> ContestationPeriod
abs :: ContestationPeriod -> ContestationPeriod
$csignum :: ContestationPeriod -> ContestationPeriod
signum :: ContestationPeriod -> ContestationPeriod
$cfromInteger :: Integer -> ContestationPeriod
fromInteger :: Integer -> ContestationPeriod
Num, ContestationPeriod -> ContestationPeriod -> Bool
(ContestationPeriod -> ContestationPeriod -> Bool)
-> Eq ContestationPeriod
forall a. (a -> a -> Bool) -> Eq a
$c== :: ContestationPeriod -> ContestationPeriod -> Bool
== :: ContestationPeriod -> ContestationPeriod -> Bool
Plutus.Eq)

PlutusTx.unstableMakeIsData ''ContestationPeriod

instance Arbitrary ContestationPeriod where
  arbitrary :: Gen ContestationPeriod
arbitrary = Integer -> ContestationPeriod
forall a. Num a => Integer -> a
fromInteger (Integer -> ContestationPeriod)
-> Gen Integer -> Gen ContestationPeriod
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen Integer
forall a. Arbitrary a => Gen a
arbitrary

instance FromJSON ContestationPeriod where
  parseJSON :: Value -> Parser ContestationPeriod
parseJSON =
    (Integer -> ContestationPeriod)
-> Parser Integer -> Parser ContestationPeriod
forall a b. (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (DiffMilliSeconds -> ContestationPeriod
UnsafeContestationPeriod (DiffMilliSeconds -> ContestationPeriod)
-> (Integer -> DiffMilliSeconds) -> Integer -> ContestationPeriod
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> DiffMilliSeconds
forall a. Num a => Integer -> a
fromInteger) (Parser Integer -> Parser ContestationPeriod)
-> (Value -> Parser Integer) -> Value -> Parser ContestationPeriod
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value -> Parser Integer
forall a. FromJSON a => Value -> Parser a
parseJSON

instance ToJSON ContestationPeriod where
  toJSON :: ContestationPeriod -> Value
toJSON =
    Integer -> Value
forall a. ToJSON a => a -> Value
toJSON (Integer -> Value)
-> (ContestationPeriod -> Integer) -> ContestationPeriod -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DiffMilliSeconds -> Integer
forall a. Integral a => a -> Integer
toInteger (DiffMilliSeconds -> Integer)
-> (ContestationPeriod -> DiffMilliSeconds)
-> ContestationPeriod
-> Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ContestationPeriod -> DiffMilliSeconds
milliseconds

contestationPeriodFromDiffTime :: NominalDiffTime -> ContestationPeriod
contestationPeriodFromDiffTime :: NominalDiffTime -> ContestationPeriod
contestationPeriodFromDiffTime = DiffMilliSeconds -> ContestationPeriod
UnsafeContestationPeriod (DiffMilliSeconds -> ContestationPeriod)
-> (NominalDiffTime -> DiffMilliSeconds)
-> NominalDiffTime
-> ContestationPeriod
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Pico -> DiffMilliSeconds
forall b. Integral b => Pico -> b
forall a b. (RealFrac a, Integral b) => a -> b
truncate (Pico -> DiffMilliSeconds)
-> (NominalDiffTime -> Pico) -> NominalDiffTime -> DiffMilliSeconds
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Pico -> Pico -> Pico
forall a. Num a => a -> a -> a
* Pico
1000) (Pico -> Pico)
-> (NominalDiffTime -> Pico) -> NominalDiffTime -> Pico
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NominalDiffTime -> Pico
nominalDiffTimeToSeconds

contestationPeriodToDiffTime :: ContestationPeriod -> NominalDiffTime
contestationPeriodToDiffTime :: ContestationPeriod -> NominalDiffTime
contestationPeriodToDiffTime ContestationPeriod
cp =
  Pico -> NominalDiffTime
secondsToNominalDiffTime (Pico -> NominalDiffTime) -> Pico -> NominalDiffTime
forall a b. (a -> b) -> a -> b
$ Rational -> Pico
forall a. Fractional a => Rational -> a
fromRational (DiffMilliSeconds -> Integer
forall a. Integral a => a -> Integer
toInteger (ContestationPeriod -> DiffMilliSeconds
milliseconds ContestationPeriod
cp) Integer -> Integer -> Rational
forall a. Integral a => a -> a -> Ratio a
% Integer
1000)

-- | Compute the (on-chain) contestation deadline from a given current time and
-- the 'ContestationPeriod'.
addContestationPeriod :: POSIXTime -> ContestationPeriod -> POSIXTime
addContestationPeriod :: POSIXTime -> ContestationPeriod -> POSIXTime
addContestationPeriod POSIXTime
time UnsafeContestationPeriod{DiffMilliSeconds
milliseconds :: ContestationPeriod -> DiffMilliSeconds
milliseconds :: DiffMilliSeconds
milliseconds} = POSIXTime
time POSIXTime -> POSIXTime -> POSIXTime
forall a. AdditiveSemigroup a => a -> a -> a
Plutus.+ DiffMilliSeconds -> POSIXTime
fromMilliSeconds DiffMilliSeconds
milliseconds
{-# INLINEABLE addContestationPeriod #-}