module Hydra.Tx.DepositDeadline where

import Hydra.Prelude hiding (Show, show)

import Data.Fixed (Pico)
import Data.Time (secondsToNominalDiffTime)
import Test.QuickCheck (choose)
import Text.Show (Show (..))

-- | A positive, non-zero number of seconds.
newtype DepositDeadline = UnsafeDepositDeadline Natural
  deriving stock (DepositDeadline -> DepositDeadline -> Bool
(DepositDeadline -> DepositDeadline -> Bool)
-> (DepositDeadline -> DepositDeadline -> Bool)
-> Eq DepositDeadline
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: DepositDeadline -> DepositDeadline -> Bool
== :: DepositDeadline -> DepositDeadline -> Bool
$c/= :: DepositDeadline -> DepositDeadline -> Bool
/= :: DepositDeadline -> DepositDeadline -> Bool
Eq, Eq DepositDeadline
Eq DepositDeadline =>
(DepositDeadline -> DepositDeadline -> Ordering)
-> (DepositDeadline -> DepositDeadline -> Bool)
-> (DepositDeadline -> DepositDeadline -> Bool)
-> (DepositDeadline -> DepositDeadline -> Bool)
-> (DepositDeadline -> DepositDeadline -> Bool)
-> (DepositDeadline -> DepositDeadline -> DepositDeadline)
-> (DepositDeadline -> DepositDeadline -> DepositDeadline)
-> Ord DepositDeadline
DepositDeadline -> DepositDeadline -> Bool
DepositDeadline -> DepositDeadline -> Ordering
DepositDeadline -> DepositDeadline -> DepositDeadline
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 :: DepositDeadline -> DepositDeadline -> Ordering
compare :: DepositDeadline -> DepositDeadline -> Ordering
$c< :: DepositDeadline -> DepositDeadline -> Bool
< :: DepositDeadline -> DepositDeadline -> Bool
$c<= :: DepositDeadline -> DepositDeadline -> Bool
<= :: DepositDeadline -> DepositDeadline -> Bool
$c> :: DepositDeadline -> DepositDeadline -> Bool
> :: DepositDeadline -> DepositDeadline -> Bool
$c>= :: DepositDeadline -> DepositDeadline -> Bool
>= :: DepositDeadline -> DepositDeadline -> Bool
$cmax :: DepositDeadline -> DepositDeadline -> DepositDeadline
max :: DepositDeadline -> DepositDeadline -> DepositDeadline
$cmin :: DepositDeadline -> DepositDeadline -> DepositDeadline
min :: DepositDeadline -> DepositDeadline -> DepositDeadline
Ord)
  deriving newtype ([DepositDeadline] -> Value
[DepositDeadline] -> Encoding
DepositDeadline -> Bool
DepositDeadline -> Value
DepositDeadline -> Encoding
(DepositDeadline -> Value)
-> (DepositDeadline -> Encoding)
-> ([DepositDeadline] -> Value)
-> ([DepositDeadline] -> Encoding)
-> (DepositDeadline -> Bool)
-> ToJSON DepositDeadline
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> (a -> Bool)
-> ToJSON a
$ctoJSON :: DepositDeadline -> Value
toJSON :: DepositDeadline -> Value
$ctoEncoding :: DepositDeadline -> Encoding
toEncoding :: DepositDeadline -> Encoding
$ctoJSONList :: [DepositDeadline] -> Value
toJSONList :: [DepositDeadline] -> Value
$ctoEncodingList :: [DepositDeadline] -> Encoding
toEncodingList :: [DepositDeadline] -> Encoding
$comitField :: DepositDeadline -> Bool
omitField :: DepositDeadline -> Bool
ToJSON, Maybe DepositDeadline
Value -> Parser [DepositDeadline]
Value -> Parser DepositDeadline
(Value -> Parser DepositDeadline)
-> (Value -> Parser [DepositDeadline])
-> Maybe DepositDeadline
-> FromJSON DepositDeadline
forall a.
(Value -> Parser a)
-> (Value -> Parser [a]) -> Maybe a -> FromJSON a
$cparseJSON :: Value -> Parser DepositDeadline
parseJSON :: Value -> Parser DepositDeadline
$cparseJSONList :: Value -> Parser [DepositDeadline]
parseJSONList :: Value -> Parser [DepositDeadline]
$comittedField :: Maybe DepositDeadline
omittedField :: Maybe DepositDeadline
FromJSON)

instance Show DepositDeadline where
  show :: DepositDeadline -> String
show (UnsafeDepositDeadline 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 DepositDeadline where
  arbitrary :: Gen DepositDeadline
arbitrary = Natural -> DepositDeadline
UnsafeDepositDeadline (Natural -> DepositDeadline)
-> (Integer -> Natural) -> Integer -> DepositDeadline
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Natural
forall a. Num a => Integer -> a
fromInteger (Integer -> DepositDeadline) -> Gen Integer -> Gen DepositDeadline
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Integer, Integer) -> Gen Integer
forall a. Random a => (a, a) -> Gen a
choose (Integer
1, Integer
300)

-- | Create a 'DepositDeadline' from a 'NominalDiffTime'. This will fail if a
-- negative NominalDiffTime is provided and truncates to 1s if values < 1s are given.
depositFromNominalDiffTime :: MonadFail m => NominalDiffTime -> m DepositDeadline
depositFromNominalDiffTime :: forall (m :: * -> *).
MonadFail m =>
NominalDiffTime -> m DepositDeadline
depositFromNominalDiffTime NominalDiffTime
dt =
  if Pico
seconds Pico -> Pico -> Bool
forall a. Ord a => a -> a -> Bool
> Pico
0
    then DepositDeadline -> m DepositDeadline
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (DepositDeadline -> m DepositDeadline)
-> (Natural -> DepositDeadline) -> Natural -> m DepositDeadline
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Natural -> DepositDeadline
UnsafeDepositDeadline (Natural -> m DepositDeadline) -> Natural -> m DepositDeadline
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 DepositDeadline
forall a. String -> m a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> m DepositDeadline) -> String -> m DepositDeadline
forall a b. (a -> b) -> a -> b
$ String
"depositFromNominalDiffTime: deposit deadline <= 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

depositToNominalDiffTime :: DepositDeadline -> NominalDiffTime
depositToNominalDiffTime :: DepositDeadline -> NominalDiffTime
depositToNominalDiffTime (UnsafeDepositDeadline 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