{-# LANGUAGE CPP #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}

module Simplex.Messaging.SystemTime
  ( RoundedSystemTime (..),
    SystemDate,
    SystemSeconds,
    getRoundedSystemTime,
    getSystemDate,
    getSystemSeconds,
    roundedToUTCTime,
  ) where

import Data.Aeson (FromJSON, ToJSON)
import Data.Int (Int64)
import Data.Time.Clock (UTCTime)
import Data.Time.Clock.System (SystemTime (..), getSystemTime, systemToUTCTime)
import Data.Typeable (Proxy (..))
import GHC.TypeLits (KnownNat, Nat, natVal)
import Simplex.Messaging.Agent.Store.DB (FromField (..), ToField (..))
import Simplex.Messaging.Encoding.String

newtype RoundedSystemTime (t :: Nat) = RoundedSystemTime {forall (t :: Nat). RoundedSystemTime t -> Int64
roundedSeconds :: Int64}
  deriving (RoundedSystemTime t -> RoundedSystemTime t -> Bool
(RoundedSystemTime t -> RoundedSystemTime t -> Bool)
-> (RoundedSystemTime t -> RoundedSystemTime t -> Bool)
-> Eq (RoundedSystemTime t)
forall (t :: Nat).
RoundedSystemTime t -> RoundedSystemTime t -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall (t :: Nat).
RoundedSystemTime t -> RoundedSystemTime t -> Bool
== :: RoundedSystemTime t -> RoundedSystemTime t -> Bool
$c/= :: forall (t :: Nat).
RoundedSystemTime t -> RoundedSystemTime t -> Bool
/= :: RoundedSystemTime t -> RoundedSystemTime t -> Bool
Eq, Eq (RoundedSystemTime t)
Eq (RoundedSystemTime t) =>
(RoundedSystemTime t -> RoundedSystemTime t -> Ordering)
-> (RoundedSystemTime t -> RoundedSystemTime t -> Bool)
-> (RoundedSystemTime t -> RoundedSystemTime t -> Bool)
-> (RoundedSystemTime t -> RoundedSystemTime t -> Bool)
-> (RoundedSystemTime t -> RoundedSystemTime t -> Bool)
-> (RoundedSystemTime t
    -> RoundedSystemTime t -> RoundedSystemTime t)
-> (RoundedSystemTime t
    -> RoundedSystemTime t -> RoundedSystemTime t)
-> Ord (RoundedSystemTime t)
RoundedSystemTime t -> RoundedSystemTime t -> Bool
RoundedSystemTime t -> RoundedSystemTime t -> Ordering
RoundedSystemTime t -> RoundedSystemTime t -> RoundedSystemTime t
forall (t :: Nat). Eq (RoundedSystemTime t)
forall (t :: Nat).
RoundedSystemTime t -> RoundedSystemTime t -> Bool
forall (t :: Nat).
RoundedSystemTime t -> RoundedSystemTime t -> Ordering
forall (t :: Nat).
RoundedSystemTime t -> RoundedSystemTime t -> RoundedSystemTime t
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 :: forall (t :: Nat).
RoundedSystemTime t -> RoundedSystemTime t -> Ordering
compare :: RoundedSystemTime t -> RoundedSystemTime t -> Ordering
$c< :: forall (t :: Nat).
RoundedSystemTime t -> RoundedSystemTime t -> Bool
< :: RoundedSystemTime t -> RoundedSystemTime t -> Bool
$c<= :: forall (t :: Nat).
RoundedSystemTime t -> RoundedSystemTime t -> Bool
<= :: RoundedSystemTime t -> RoundedSystemTime t -> Bool
$c> :: forall (t :: Nat).
RoundedSystemTime t -> RoundedSystemTime t -> Bool
> :: RoundedSystemTime t -> RoundedSystemTime t -> Bool
$c>= :: forall (t :: Nat).
RoundedSystemTime t -> RoundedSystemTime t -> Bool
>= :: RoundedSystemTime t -> RoundedSystemTime t -> Bool
$cmax :: forall (t :: Nat).
RoundedSystemTime t -> RoundedSystemTime t -> RoundedSystemTime t
max :: RoundedSystemTime t -> RoundedSystemTime t -> RoundedSystemTime t
$cmin :: forall (t :: Nat).
RoundedSystemTime t -> RoundedSystemTime t -> RoundedSystemTime t
min :: RoundedSystemTime t -> RoundedSystemTime t -> RoundedSystemTime t
Ord, Int -> RoundedSystemTime t -> ShowS
[RoundedSystemTime t] -> ShowS
RoundedSystemTime t -> String
(Int -> RoundedSystemTime t -> ShowS)
-> (RoundedSystemTime t -> String)
-> ([RoundedSystemTime t] -> ShowS)
-> Show (RoundedSystemTime t)
forall (t :: Nat). Int -> RoundedSystemTime t -> ShowS
forall (t :: Nat). [RoundedSystemTime t] -> ShowS
forall (t :: Nat). RoundedSystemTime t -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall (t :: Nat). Int -> RoundedSystemTime t -> ShowS
showsPrec :: Int -> RoundedSystemTime t -> ShowS
$cshow :: forall (t :: Nat). RoundedSystemTime t -> String
show :: RoundedSystemTime t -> String
$cshowList :: forall (t :: Nat). [RoundedSystemTime t] -> ShowS
showList :: [RoundedSystemTime t] -> ShowS
Show)
  deriving newtype (Maybe (RoundedSystemTime t)
Value -> Parser [RoundedSystemTime t]
Value -> Parser (RoundedSystemTime t)
(Value -> Parser (RoundedSystemTime t))
-> (Value -> Parser [RoundedSystemTime t])
-> Maybe (RoundedSystemTime t)
-> FromJSON (RoundedSystemTime t)
forall (t :: Nat). Maybe (RoundedSystemTime t)
forall (t :: Nat). Value -> Parser [RoundedSystemTime t]
forall (t :: Nat). Value -> Parser (RoundedSystemTime t)
forall a.
(Value -> Parser a)
-> (Value -> Parser [a]) -> Maybe a -> FromJSON a
$cparseJSON :: forall (t :: Nat). Value -> Parser (RoundedSystemTime t)
parseJSON :: Value -> Parser (RoundedSystemTime t)
$cparseJSONList :: forall (t :: Nat). Value -> Parser [RoundedSystemTime t]
parseJSONList :: Value -> Parser [RoundedSystemTime t]
$comittedField :: forall (t :: Nat). Maybe (RoundedSystemTime t)
omittedField :: Maybe (RoundedSystemTime t)
FromJSON, [RoundedSystemTime t] -> Encoding
[RoundedSystemTime t] -> Value
RoundedSystemTime t -> Bool
RoundedSystemTime t -> Encoding
RoundedSystemTime t -> Value
(RoundedSystemTime t -> Value)
-> (RoundedSystemTime t -> Encoding)
-> ([RoundedSystemTime t] -> Value)
-> ([RoundedSystemTime t] -> Encoding)
-> (RoundedSystemTime t -> Bool)
-> ToJSON (RoundedSystemTime t)
forall (t :: Nat). [RoundedSystemTime t] -> Encoding
forall (t :: Nat). [RoundedSystemTime t] -> Value
forall (t :: Nat). RoundedSystemTime t -> Bool
forall (t :: Nat). RoundedSystemTime t -> Encoding
forall (t :: Nat). RoundedSystemTime t -> Value
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> (a -> Bool)
-> ToJSON a
$ctoJSON :: forall (t :: Nat). RoundedSystemTime t -> Value
toJSON :: RoundedSystemTime t -> Value
$ctoEncoding :: forall (t :: Nat). RoundedSystemTime t -> Encoding
toEncoding :: RoundedSystemTime t -> Encoding
$ctoJSONList :: forall (t :: Nat). [RoundedSystemTime t] -> Value
toJSONList :: [RoundedSystemTime t] -> Value
$ctoEncodingList :: forall (t :: Nat). [RoundedSystemTime t] -> Encoding
toEncodingList :: [RoundedSystemTime t] -> Encoding
$comitField :: forall (t :: Nat). RoundedSystemTime t -> Bool
omitField :: RoundedSystemTime t -> Bool
ToJSON, FieldParser (RoundedSystemTime t)
FieldParser (RoundedSystemTime t)
-> FromField (RoundedSystemTime t)
forall (t :: Nat). FieldParser (RoundedSystemTime t)
forall a. FieldParser a -> FromField a
$cfromField :: forall (t :: Nat). FieldParser (RoundedSystemTime t)
fromField :: FieldParser (RoundedSystemTime t)
FromField, RoundedSystemTime t -> SQLData
(RoundedSystemTime t -> SQLData) -> ToField (RoundedSystemTime t)
forall (t :: Nat). RoundedSystemTime t -> SQLData
forall a. (a -> SQLData) -> ToField a
$ctoField :: forall (t :: Nat). RoundedSystemTime t -> SQLData
toField :: RoundedSystemTime t -> SQLData
ToField)

type SystemDate = RoundedSystemTime 86400

type SystemSeconds = RoundedSystemTime 1

instance StrEncoding (RoundedSystemTime t) where
  strEncode :: RoundedSystemTime t -> ByteString
strEncode (RoundedSystemTime Int64
t) = Int64 -> ByteString
forall a. StrEncoding a => a -> ByteString
strEncode Int64
t
  strP :: Parser (RoundedSystemTime t)
strP = Int64 -> RoundedSystemTime t
forall (t :: Nat). Int64 -> RoundedSystemTime t
RoundedSystemTime (Int64 -> RoundedSystemTime t)
-> Parser ByteString Int64 -> Parser (RoundedSystemTime t)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString Int64
forall a. StrEncoding a => Parser a
strP

getRoundedSystemTime :: forall t. KnownNat t => IO (RoundedSystemTime t)
getRoundedSystemTime :: forall (t :: Nat). KnownNat t => IO (RoundedSystemTime t)
getRoundedSystemTime = (\SystemTime
t -> Int64 -> RoundedSystemTime t
forall (t :: Nat). Int64 -> RoundedSystemTime t
RoundedSystemTime (Int64 -> RoundedSystemTime t) -> Int64 -> RoundedSystemTime t
forall a b. (a -> b) -> a -> b
$ (SystemTime -> Int64
systemSeconds SystemTime
t Int64 -> Int64 -> Int64
forall a. Integral a => a -> a -> a
`div` Int64
prec) Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
* Int64
prec) (SystemTime -> RoundedSystemTime t)
-> IO SystemTime -> IO (RoundedSystemTime t)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO SystemTime
getSystemTime
  where
    prec :: Int64
prec = Integer -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Integer -> Int64) -> Integer -> Int64
forall a b. (a -> b) -> a -> b
$ Proxy t -> Integer
forall (n :: Nat) (proxy :: Nat -> *).
KnownNat n =>
proxy n -> Integer
natVal (Proxy t -> Integer) -> Proxy t -> Integer
forall a b. (a -> b) -> a -> b
$ forall (t :: Nat). Proxy t
forall {k} (t :: k). Proxy t
Proxy @t

getSystemDate :: IO SystemDate
getSystemDate :: IO SystemDate
getSystemDate = IO SystemDate
forall (t :: Nat). KnownNat t => IO (RoundedSystemTime t)
getRoundedSystemTime
{-# INLINE getSystemDate #-}

getSystemSeconds :: IO SystemSeconds
getSystemSeconds :: IO SystemSeconds
getSystemSeconds = Int64 -> SystemSeconds
forall (t :: Nat). Int64 -> RoundedSystemTime t
RoundedSystemTime (Int64 -> SystemSeconds)
-> (SystemTime -> Int64) -> SystemTime -> SystemSeconds
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SystemTime -> Int64
systemSeconds (SystemTime -> SystemSeconds) -> IO SystemTime -> IO SystemSeconds
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO SystemTime
getSystemTime
{-# INLINE getSystemSeconds #-}

roundedToUTCTime :: RoundedSystemTime t -> UTCTime
roundedToUTCTime :: forall (t :: Nat). RoundedSystemTime t -> UTCTime
roundedToUTCTime = SystemTime -> UTCTime
systemToUTCTime (SystemTime -> UTCTime)
-> (RoundedSystemTime t -> SystemTime)
-> RoundedSystemTime t
-> UTCTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int64 -> Word32 -> SystemTime
`MkSystemTime` Word32
0) (Int64 -> SystemTime)
-> (RoundedSystemTime t -> Int64)
-> RoundedSystemTime t
-> SystemTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RoundedSystemTime t -> Int64
forall (t :: Nat). RoundedSystemTime t -> Int64
roundedSeconds
{-# INLINE roundedToUTCTime #-}