mirror of
https://github.com/simplex-chat/simplexmq.git
synced 2026-06-05 21:31:24 +00:00
smp: support client notices (#1659)
* agent: support client notices * improve * fix, test * rename * cleanup * send and process notices in more cases * dont delete * dont remove notice on other permanent errors * dont remove notice if there is no notice ID in queue * add server to error * allow deleting * only use notice if key hash matches
This commit is contained in:
@@ -0,0 +1,47 @@
|
||||
{-# LANGUAGE CPP #-}
|
||||
{-# LANGUAGE DataKinds #-}
|
||||
{-# LANGUAGE DerivingStrategies #-}
|
||||
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
|
||||
{-# LANGUAGE KindSignatures #-}
|
||||
{-# LANGUAGE ScopedTypeVariables #-}
|
||||
{-# LANGUAGE TypeApplications #-}
|
||||
|
||||
module Simplex.Messaging.SystemTime 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 {roundedSeconds :: Int64}
|
||||
deriving (Eq, Ord, Show)
|
||||
deriving newtype (FromJSON, ToJSON, FromField, ToField)
|
||||
|
||||
type SystemDate = RoundedSystemTime 86400
|
||||
|
||||
type SystemSeconds = RoundedSystemTime 1
|
||||
|
||||
instance StrEncoding (RoundedSystemTime t) where
|
||||
strEncode (RoundedSystemTime t) = strEncode t
|
||||
strP = RoundedSystemTime <$> strP
|
||||
|
||||
getRoundedSystemTime :: forall t. KnownNat t => IO (RoundedSystemTime t)
|
||||
getRoundedSystemTime = (\t -> RoundedSystemTime $ (systemSeconds t `div` prec) * prec) <$> getSystemTime
|
||||
where
|
||||
prec = fromIntegral $ natVal $ Proxy @t
|
||||
|
||||
getSystemDate :: IO SystemDate
|
||||
getSystemDate = getRoundedSystemTime
|
||||
{-# INLINE getSystemDate #-}
|
||||
|
||||
getSystemSeconds :: IO SystemSeconds
|
||||
getSystemSeconds = RoundedSystemTime . systemSeconds <$> getSystemTime
|
||||
{-# INLINE getSystemSeconds #-}
|
||||
|
||||
roundedToUTCTime :: RoundedSystemTime t -> UTCTime
|
||||
roundedToUTCTime = systemToUTCTime . (`MkSystemTime` 0) . roundedSeconds
|
||||
{-# INLINE roundedToUTCTime #-}
|
||||
Reference in New Issue
Block a user