module Hydra.Tx.ContestationPeriod where

import Hydra.Prelude hiding (Show, show)

import Data.Fixed (Pico)
import Data.Ratio ((%))
import Data.Time (secondsToNominalDiffTime)
import Hydra.Data.ContestationPeriod qualified as OnChain
import Test.QuickCheck (choose, oneof)
import Text.Show (Show (..))

-- | A positive, non-zero number of seconds.
newtype ContestationPeriod = UnsafeContestationPeriod Natural
  deriving stock (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)
  deriving newtype ([ContestationPeriod] -> Value
[ContestationPeriod] -> Encoding
ContestationPeriod -> Bool
ContestationPeriod -> Value
ContestationPeriod -> Encoding
(ContestationPeriod -> Value)
-> (ContestationPeriod -> Encoding)
-> ([ContestationPeriod] -> Value)
-> ([ContestationPeriod] -> Encoding)
-> (ContestationPeriod -> Bool)
-> ToJSON ContestationPeriod
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> (a -> Bool)
-> ToJSON a
$ctoJSON :: ContestationPeriod -> Value
toJSON :: ContestationPeriod -> Value
$ctoEncoding :: ContestationPeriod -> Encoding
toEncoding :: ContestationPeriod -> Encoding
$ctoJSONList :: [ContestationPeriod] -> Value
toJSONList :: [ContestationPeriod] -> Value
$ctoEncodingList :: [ContestationPeriod] -> Encoding
toEncodingList :: [ContestationPeriod] -> Encoding
$comitField :: ContestationPeriod -> Bool
omitField :: ContestationPeriod -> Bool
ToJSON, Maybe ContestationPeriod
Value -> Parser [ContestationPeriod]
Value -> Parser ContestationPeriod
(Value -> Parser ContestationPeriod)
-> (Value -> Parser [ContestationPeriod])
-> Maybe ContestationPeriod
-> FromJSON ContestationPeriod
forall a.
(Value -> Parser a)
-> (Value -> Parser [a]) -> Maybe a -> FromJSON a
$cparseJSON :: Value -> Parser ContestationPeriod
parseJSON :: Value -> Parser ContestationPeriod
$cparseJSONList :: Value -> Parser [ContestationPeriod]
parseJSONList :: Value -> Parser [ContestationPeriod]
$comittedField :: Maybe ContestationPeriod
omittedField :: Maybe ContestationPeriod
FromJSON)

instance Show ContestationPeriod where
  show :: ContestationPeriod -> String
show (UnsafeContestationPeriod Natural
s) = Natural -> String
forall a. Show a => a -> String
show Natural
s String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
"s"

instance Arbitrary ContestationPeriod where
  arbitrary :: Gen ContestationPeriod
arbitrary = do
    Natural -> ContestationPeriod
UnsafeContestationPeriod
      (Natural -> ContestationPeriod)
-> (Integer -> Natural) -> Integer -> ContestationPeriod
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Natural
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] -> Gen Integer
forall a. HasCallStack => [Gen a] -> Gen a
oneof
        [ (Integer, Integer) -> Gen Integer
forall a. Random a => (a, a) -> Gen a
choose (Integer
1, Integer
confirmedHorizon)
        , Integer -> Gen Integer
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Integer
confirmedHorizon
        , (Integer, Integer) -> Gen Integer
forall a. Random a => (a, a) -> Gen a
choose (Integer
confirmedHorizon, Integer
oneDay)
        , Integer -> Gen Integer
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Integer
oneDay
        , Integer -> Gen Integer
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Integer
oneWeek
        , Integer -> Gen Integer
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Integer
oneMonth
        , Integer -> Gen Integer
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Integer
oneYear
        ]
   where
    confirmedHorizon :: Integer
confirmedHorizon = Integer
2160 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
20 -- k blocks on mainnet
    oneDay :: Integer
oneDay = Integer
3600 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
24
    oneWeek :: Integer
oneWeek = Integer
oneDay Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
7
    oneMonth :: Integer
oneMonth = Integer
oneDay Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
30
    oneYear :: Integer
oneYear = Integer
oneDay Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
365

-- | Create a 'ContestationPeriod' from a 'NominalDiffTime'. This will fail if a
-- negative NominalDiffTime is provided and truncates to 1s if values < 1s are given.
fromNominalDiffTime :: MonadFail m => NominalDiffTime -> m ContestationPeriod
fromNominalDiffTime :: forall (m :: * -> *).
MonadFail m =>
NominalDiffTime -> m ContestationPeriod
fromNominalDiffTime NominalDiffTime
dt =
  if Pico
seconds Pico -> Pico -> Bool
forall a. Ord a => a -> a -> Bool
> Pico
0
    then ContestationPeriod -> m ContestationPeriod
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ContestationPeriod -> m ContestationPeriod)
-> (Natural -> ContestationPeriod)
-> Natural
-> m ContestationPeriod
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Natural -> ContestationPeriod
UnsafeContestationPeriod (Natural -> m ContestationPeriod)
-> Natural -> m ContestationPeriod
forall a b. (a -> b) -> a -> b
$ Pico -> Natural
forall b. Integral b => Pico -> b
forall a b. (RealFrac a, Integral b) => a -> b
ceiling Pico
seconds
    else String -> m ContestationPeriod
forall a. String -> m a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> m ContestationPeriod) -> String -> m ContestationPeriod
forall a b. (a -> b) -> a -> b
$ String
"fromNominalDiffTime: contestation period <= 0: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> NominalDiffTime -> String
forall a. Show a => a -> String
show NominalDiffTime
dt
 where
  Pico
seconds :: Pico = NominalDiffTime -> Pico
forall a b. (Real a, Fractional b) => a -> b
realToFrac NominalDiffTime
dt

toNominalDiffTime :: ContestationPeriod -> NominalDiffTime
toNominalDiffTime :: ContestationPeriod -> NominalDiffTime
toNominalDiffTime (UnsafeContestationPeriod Natural
s) =
  Pico -> NominalDiffTime
secondsToNominalDiffTime (Pico -> NominalDiffTime) -> Pico -> NominalDiffTime
forall a b. (a -> b) -> a -> b
$ Natural -> Pico
forall a b. (Integral a, Num b) => a -> b
fromIntegral Natural
s

-- | Convert an off-chain contestation period to its on-chain representation.
toChain :: ContestationPeriod -> OnChain.ContestationPeriod
toChain :: ContestationPeriod -> ContestationPeriod
toChain (UnsafeContestationPeriod Natural
s) =
  DiffMilliSeconds -> ContestationPeriod
OnChain.UnsafeContestationPeriod
    (DiffMilliSeconds -> ContestationPeriod)
-> (Natural -> DiffMilliSeconds) -> Natural -> ContestationPeriod
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Natural -> DiffMilliSeconds
forall a b. (Integral a, Num b) => a -> b
fromIntegral
    (Natural -> ContestationPeriod) -> Natural -> ContestationPeriod
forall a b. (a -> b) -> a -> b
$ Natural
s Natural -> Natural -> Natural
forall a. Num a => a -> a -> a
* Natural
1000

-- | Convert an on-chain contestation period to its off-chain representation.
-- NOTE: Does truncate to whole seconds.
fromChain :: OnChain.ContestationPeriod -> ContestationPeriod
fromChain :: ContestationPeriod -> ContestationPeriod
fromChain ContestationPeriod
cp =
  Natural -> ContestationPeriod
UnsafeContestationPeriod
    (Natural -> ContestationPeriod)
-> (Ratio Integer -> Natural)
-> Ratio Integer
-> ContestationPeriod
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ratio Integer -> Natural
forall b. Integral b => Ratio Integer -> b
forall a b. (RealFrac a, Integral b) => a -> b
truncate
    (Ratio Integer -> ContestationPeriod)
-> Ratio Integer -> ContestationPeriod
forall a b. (a -> b) -> a -> b
$ DiffMilliSeconds -> Integer
forall a. Integral a => a -> Integer
toInteger (ContestationPeriod -> DiffMilliSeconds
OnChain.milliseconds ContestationPeriod
cp) Integer -> Integer -> Ratio Integer
forall a. Integral a => a -> a -> Ratio a
% Integer
1000