{-# LANGUAGE TypeApplications #-}

module BtcLsp.Time
  ( getCurrentTime,
    getFutureTime,
    getPastTime,
    addSeconds,
    subSeconds,
    swapExpiryLimit,
    sleep300ms,
    sleep1s,
    sleep5s,
    sleep10s,
  )
where

import BtcLsp.Data.Orphan ()
import BtcLsp.Import.External
import qualified Data.Time.Clock as Time
import qualified LndClient as Lnd
import qualified LndClient.Util as Util

getCurrentTime :: (MonadIO m) => m UTCTime
getCurrentTime :: forall (m :: * -> *). MonadIO m => m UTCTime
getCurrentTime =
  IO UTCTime -> m UTCTime
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO UTCTime
Time.getCurrentTime

getFutureTime :: (MonadIO m) => Lnd.Seconds -> m UTCTime
getFutureTime :: forall (m :: * -> *). MonadIO m => Seconds -> m UTCTime
getFutureTime Seconds
ss =
  Seconds -> UTCTime -> UTCTime
addSeconds Seconds
ss (UTCTime -> UTCTime) -> m UTCTime -> m UTCTime
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO UTCTime -> m UTCTime
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO UTCTime
forall (m :: * -> *). MonadIO m => m UTCTime
getCurrentTime

getPastTime :: (MonadIO m) => Lnd.Seconds -> m UTCTime
getPastTime :: forall (m :: * -> *). MonadIO m => Seconds -> m UTCTime
getPastTime Seconds
ss =
  Seconds -> UTCTime -> UTCTime
subSeconds Seconds
ss
    (UTCTime -> UTCTime) -> m UTCTime -> m UTCTime
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO UTCTime -> m UTCTime
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO UTCTime
forall (m :: * -> *). MonadIO m => m UTCTime
getCurrentTime

addSeconds :: Lnd.Seconds -> UTCTime -> UTCTime
addSeconds :: Seconds -> UTCTime -> UTCTime
addSeconds =
  NominalDiffTime -> UTCTime -> UTCTime
addUTCTime
    (NominalDiffTime -> UTCTime -> UTCTime)
-> (Seconds -> NominalDiffTime) -> Seconds -> UTCTime -> UTCTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Rational -> NominalDiffTime
forall a. Fractional a => Rational -> a
fromRational
    (Rational -> NominalDiffTime)
-> (Seconds -> Rational) -> Seconds -> NominalDiffTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DiffTime -> Rational
forall a. Real a => a -> Rational
toRational
    (DiffTime -> Rational)
-> (Seconds -> DiffTime) -> Seconds -> Rational
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> DiffTime
secondsToDiffTime
    (Integer -> DiffTime)
-> (Seconds -> Integer) -> Seconds -> DiffTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall through source target.
(From source through, From through target,
 'False ~ (source == through), 'False ~ (through == target)) =>
source -> target
via @Word64

subSeconds :: Lnd.Seconds -> UTCTime -> UTCTime
subSeconds :: Seconds -> UTCTime -> UTCTime
subSeconds =
  NominalDiffTime -> UTCTime -> UTCTime
addUTCTime
    (NominalDiffTime -> UTCTime -> UTCTime)
-> (Seconds -> NominalDiffTime) -> Seconds -> UTCTime -> UTCTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Rational -> NominalDiffTime
forall a. Fractional a => Rational -> a
fromRational
    (Rational -> NominalDiffTime)
-> (Seconds -> Rational) -> Seconds -> NominalDiffTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DiffTime -> Rational
forall a. Real a => a -> Rational
toRational
    (DiffTime -> Rational)
-> (Seconds -> DiffTime) -> Seconds -> Rational
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> DiffTime
secondsToDiffTime
    (Integer -> DiffTime)
-> (Seconds -> Integer) -> Seconds -> DiffTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* (-Integer
1))
    (Integer -> Integer) -> (Seconds -> Integer) -> Seconds -> Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall through source target.
(From source through, From through target,
 'False ~ (source == through), 'False ~ (through == target)) =>
source -> target
via @Word64

swapExpiryLimit :: Lnd.Seconds
swapExpiryLimit :: Seconds
swapExpiryLimit =
  Word64 -> Seconds
Lnd.Seconds (Word64 -> Seconds) -> Word64 -> Seconds
forall a b. (a -> b) -> a -> b
$ Word64
24 Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
* Word64
60 Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
* Word64
60

sleep300ms :: (MonadIO m) => m ()
sleep300ms :: forall (m :: * -> *). MonadIO m => m ()
sleep300ms =
  MicroSecondsDelay -> m ()
forall (m :: * -> *). MonadIO m => MicroSecondsDelay -> m ()
Util.sleep (MicroSecondsDelay -> m ()) -> MicroSecondsDelay -> m ()
forall a b. (a -> b) -> a -> b
$ Int -> MicroSecondsDelay
Util.MicroSecondsDelay Int
300000

sleep1s :: (MonadIO m) => m ()
sleep1s :: forall (m :: * -> *). MonadIO m => m ()
sleep1s =
  MicroSecondsDelay -> m ()
forall (m :: * -> *). MonadIO m => MicroSecondsDelay -> m ()
Util.sleep (MicroSecondsDelay -> m ()) -> MicroSecondsDelay -> m ()
forall a b. (a -> b) -> a -> b
$ Int -> MicroSecondsDelay
Util.MicroSecondsDelay Int
1000000

sleep5s :: (MonadIO m) => m ()
sleep5s :: forall (m :: * -> *). MonadIO m => m ()
sleep5s =
  MicroSecondsDelay -> m ()
forall (m :: * -> *). MonadIO m => MicroSecondsDelay -> m ()
Util.sleep (MicroSecondsDelay -> m ()) -> MicroSecondsDelay -> m ()
forall a b. (a -> b) -> a -> b
$ Int -> MicroSecondsDelay
Util.MicroSecondsDelay Int
5000000

sleep10s :: (MonadIO m) => m ()
sleep10s :: forall (m :: * -> *). MonadIO m => m ()
sleep10s =
  MicroSecondsDelay -> m ()
forall (m :: * -> *). MonadIO m => MicroSecondsDelay -> m ()
Util.sleep (MicroSecondsDelay -> m ()) -> MicroSecondsDelay -> m ()
forall a b. (a -> b) -> a -> b
$ Int -> MicroSecondsDelay
Util.MicroSecondsDelay Int
10000000