dmq: replaced sigTTL with sigExpiresAt

Author: coot

decentralized-message-queue/decentralized-message-queue.cabal

@@ -114,6 +114,7 @@ test-suite dmq-test
     quickcheck-instances,
     tasty,
     tasty-quickcheck,
+    time,
     typed-protocols,
     with-utf8,
 

decentralized-message-queue/src/DMQ/Diffusion/NodeKernel.hs

@@ -121,9 +121,9 @@ mempoolWorker (Mempool v) = loop
         (sigs :: Seq.Seq Sig) <- readTVar v
         let sigs' :: Seq.Seq Sig
             (resumeTime, sigs') =
-              foldr (\a (rt, as) -> if sigTTL a <= now
+              foldr (\a (rt, as) -> if sigExpiresAt a <= now
                                     then (rt, as)
-                                    else (rt `min` sigTTL a, a Seq.<| as))
+                                    else (rt `min` sigExpiresAt a, a Seq.<| as))
                     (now, Seq.empty)
                     sigs
         writeTVar v sigs'

decentralized-message-queue/src/DMQ/Protocol/SigSubmission/Codec.hs

@@ -92,14 +92,14 @@ codecSigSubmission =
     encodeSig :: Sig -> CBOR.Encoding
     encodeSig Sig { sigId,
                     sigBody,
-                    sigTTL,
+                    sigExpiresAt,
                     sigKesSignature,
                     sigOpCertificate
                   }
        = CBOR.encodeListLen 5
       <> encodeSigId sigId
       <> CBOR.encodeBytes (getSigBody sigBody)
-      <> CBOR.encodeWord32 (floor sigTTL)
+      <> CBOR.encodeWord32 (floor sigExpiresAt)
       <> CBOR.encodeBytes (getSigKesSignature sigKesSignature)
       <> CBOR.encodeBytes (getSigOpCertificate sigOpCertificate)
 
@@ -109,13 +109,13 @@ codecSigSubmission =
       when (a /= 5) $ fail (printf "codecSigSubmission: unexpected number of parameters %d" a)
       sigId <- decodeSigId
       sigBody <- SigBody <$> CBOR.decodeBytes
-      sigTTL <- realToFrac <$> CBOR.decodeWord32
+      sigExpiresAt <- realToFrac <$> CBOR.decodeWord32
       sigKesSignature <- SigKesSignature <$> CBOR.decodeBytes
       sigOpCertificate <- SigOpCertificate <$> CBOR.decodeBytes
       return Sig {
           sigId,
           sigBody,
-          sigTTL,
+          sigExpiresAt,
           sigKesSignature,
           sigOpCertificate
         }

decentralized-message-queue/src/DMQ/Protocol/SigSubmission/Type.hs

@@ -7,10 +7,9 @@ module DMQ.Protocol.SigSubmission.Type
     SigHash (..)
   , SigId (..)
   , SigBody (..)
-  , SigTTL (..)
   , SigKesSignature (..)
   , SigOpCertificate (..)
-  , Sig (SigRaw, Sig, sigId, sigBody, sigTTL, sigOpCertificate, sigKesSignature)
+  , Sig (SigRaw, Sig, sigId, sigBody, sigExpiresAt, sigOpCertificate, sigKesSignature)
     -- * `TxSubmission` mini-protocol
   , SigSubmission
   , module SigSubmission
@@ -38,12 +37,6 @@ newtype SigBody = SigBody { getSigBody :: ByteString }
   deriving stock (Show, Eq)
 
 
--- | POSIX time since epoch in seconds.
---
-newtype SigTTL = SigTTL { getSigTTL :: POSIXTime }
-  deriving stock (Show, Eq)
-
-
 -- TODO:
 -- This type should be something like: `SignedKES (KES crypto) SigPayload`
 newtype SigKesSignature = SigKesSignature { getSigKesSignature :: ByteString }
@@ -63,7 +56,7 @@ data Sig = SigRaw {
 data SigPayload = SigPayload {
     sigPayloadId            :: SigId,
     sigPayloadBody          :: SigBody,
-    sigPayloadTTL           :: SigTTL,
+    sigPayloadExpiresAt     :: POSIXTime,
     sigPayloadOpCertificate :: SigOpCertificate
   }
   deriving stock (Show, Eq)
@@ -80,7 +73,7 @@ pattern Sig
 pattern
     Sig { sigId,
           sigBody,
-          sigTTL,
+          sigExpiresAt,
           sigOpCertificate,
           sigKesSignature
         }
@@ -90,15 +83,15 @@ pattern
         SigPayload {
           sigPayloadId            = sigId,
           sigPayloadBody          = sigBody,
-          sigPayloadTTL           = SigTTL sigTTL,
+          sigPayloadExpiresAt     = sigExpiresAt,
           sigPayloadOpCertificate = sigOpCertificate
         },
       sigRawKesSignature = sigKesSignature
     }
   where
     Sig sigPayloadId
         sigPayloadBody
-        sigTTL
+        sigPayloadExpiresAt
         sigPayloadOpCertificate
         sigRawKesSignature
       =
@@ -107,7 +100,7 @@ pattern
           SigPayload {
             sigPayloadId,
             sigPayloadBody,
-            sigPayloadTTL = SigTTL sigTTL,
+            sigPayloadExpiresAt,
             sigPayloadOpCertificate
           },
         sigRawKesSignature

decentralized-message-queue/test/Test/DMQ/Protocol/SigSubmission.hs

@@ -9,6 +9,7 @@ module Test.DMQ.Protocol.SigSubmission where
 import Control.Monad.ST (runST)
 import Data.Bifunctor (second)
 import Data.List.NonEmpty qualified as NonEmpty
+import Data.Time.Clock.POSIX (POSIXTime)
 import Data.Word (Word32)
 
 import Network.TypedProtocol.Codec hiding (prop_codec)
@@ -55,12 +56,11 @@ instance Arbitrary SigBody where
   arbitrary = SigBody <$> arbitrary
   shrink = map SigBody . shrink . getSigBody
 
-instance Arbitrary SigTTL where
+instance Arbitrary POSIXTime where
   -- generate only whole seconds (this is what we receive on the wire)
-  arbitrary = SigTTL . realToFrac @Word32 <$> arbitrary
+  arbitrary = realToFrac @Word32 <$> arbitrary
   -- shrink via Word32 (e.g. in seconds)
-  shrink (SigTTL posix) = SigTTL . realToFrac
-                      <$> shrink (floor @_ @Word32 posix)
+  shrink posix = realToFrac <$> shrink (floor @_ @Word32 posix)
 
 instance Arbitrary SigKesSignature where
   arbitrary = SigKesSignature <$> arbitrary
@@ -73,10 +73,10 @@ instance Arbitrary SigOpCertificate where
 instance Arbitrary Sig where
   arbitrary = Sig <$> arbitrary
                   <*> arbitrary
-                  <*> (getSigTTL <$> arbitrary)
                   <*> arbitrary
                   <*> arbitrary
-  shrink sig@Sig { sigId, sigBody, sigTTL, sigOpCertificate, sigKesSignature } =
+                  <*> arbitrary
+  shrink sig@Sig { sigId, sigBody, sigExpiresAt, sigOpCertificate, sigKesSignature } =
     [ sig { sigId = sigId' }
     | sigId' <- shrink sigId
     ]
@@ -85,8 +85,8 @@ instance Arbitrary Sig where
     | sigBody' <- shrink sigBody
     ]
     ++
-    [ sig { sigTTL = sigTTL' }
-    | SigTTL sigTTL' <- shrink (SigTTL sigTTL)
+    [ sig { sigExpiresAt = sigExpiresAt' }
+    | sigExpiresAt' <- shrink sigExpiresAt
     ]
     ++
     [ sig { sigOpCertificate = sigOpCertificate' }