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:
Evgeny
2025-10-17 18:34:59 +01:00
committed by GitHub
parent 234aeb81dd
commit 1329fc726f
54 changed files with 653 additions and 221 deletions
+47
View File
@@ -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 #-}