Add 'MsgRelease' to allow protocol to loop back to 'StIdle'

And seemingly, allow client to send 'Done' even after acquiring.
IntersectMBO · Oct 2, 2021 · 3b847a0 · 3b847a0
1 parent 2a22ab7
commit 3b847a0
Show file tree

Hide file tree

Showing 3 changed files with 22 additions and 5 deletions.
diff --git a/ouroboros-network/src/Ouroboros/Network/Protocol/LocalTxMonitor/Client.hs b/ouroboros-network/src/Ouroboros/Network/Protocol/LocalTxMonitor/Client.hs
@@ -88,6 +88,12 @@ data ClientStAcquired txid tx slot m a where
     :: (slot ->  m (ClientStAcquired txid tx slot m a))
     -> ClientStAcquired txid tx slot m a
 
+  -- | Release the acquired snapshot, in order to loop back to the idle state.
+  --
+  SendMsgRelease
+    :: m (ClientStIdle txid tx slot m a)
+    -> ClientStAcquired txid tx slot m a
+
 -- | Interpret a 'LocalTxMonitorClient' action sequence as a 'Peer' on the client
 -- side of the 'LocalTxMonitor' protocol.
 --
@@ -114,10 +120,6 @@ localTxMonitorClientPeer (LocalTxMonitorClient mClient) =
       :: ClientStAcquired txid tx slot m a
       -> Peer (LocalTxMonitor txid tx slot) AsClient StAcquired m a
     handleStAcquired = \case
-      SendMsgReAcquire stAcquired ->
-        Yield (ClientAgency TokAcquired) MsgReAcquire $
-          Await (ServerAgency TokAcquiring) $ \case
-            MsgAcquired slot -> Effect $ handleStAcquired <$> stAcquired slot
       SendMsgNextTx stAcquired ->
         Yield (ClientAgency TokAcquired) MsgNextTx $
           Await (ServerAgency (TokBusy TokBusyNext)) $ \case
@@ -126,3 +128,10 @@ localTxMonitorClientPeer (LocalTxMonitorClient mClient) =
         Yield (ClientAgency TokAcquired) (MsgHasTx txid) $
           Await (ServerAgency (TokBusy TokBusyHas)) $ \case
             MsgReplyHasTx res -> Effect $ handleStAcquired <$> stAcquired res
+      SendMsgReAcquire stAcquired ->
+        Yield (ClientAgency TokAcquired) MsgReAcquire $
+          Await (ServerAgency TokAcquiring) $ \case
+            MsgAcquired slot -> Effect $ handleStAcquired <$> stAcquired slot
+      SendMsgRelease stIdle ->
+        Yield (ClientAgency TokAcquired) MsgRelease $
+          Effect $ handleStIdle <$> stIdle
diff --git a/ouroboros-network/src/Ouroboros/Network/Protocol/LocalTxMonitor/Server.hs b/ouroboros-network/src/Ouroboros/Network/Protocol/LocalTxMonitor/Server.hs
@@ -69,6 +69,7 @@ data ServerStAcquired txid tx slot m a = ServerStAcquired
     { recvMsgNextTx :: m (ServerStBusy StBusyNext txid tx slot m a)
     , recvMsgHasTx :: txid -> m (ServerStBusy StBusyHas txid tx slot m a)
     , recvMsgReAcquire :: m (ServerStAcquiring txid tx slot m a)
+    , recvMsgRelease :: m (ServerStIdle txid tx slot m a)
     }
 
 -- In the 'StBusy' protocol state, the server has agency and is responding to one of the client
@@ -121,14 +122,16 @@ localTxMonitorServerPeer (LocalTxMonitorServer mServer) =
       :: ServerStAcquired txid tx slot m a
       -> Peer (LocalTxMonitor txid tx slot) AsServer StAcquired m a
     handleStAcquired = \case
-      ServerStAcquired{recvMsgNextTx, recvMsgHasTx, recvMsgReAcquire} ->
+      ServerStAcquired{recvMsgNextTx, recvMsgHasTx, recvMsgReAcquire, recvMsgRelease} ->
         Await (ClientAgency TokAcquired) $ \case
           MsgNextTx ->
             Effect $ handleStBusyNext <$> recvMsgNextTx
           MsgHasTx txid ->
             Effect $ handleStBusyHas <$> recvMsgHasTx txid
           MsgReAcquire ->
             Effect $ handleStAcquiring <$> recvMsgReAcquire
+          MsgRelease ->
+            Effect $ handleStIdle <$> recvMsgRelease
 
     handleStBusyNext
       :: ServerStBusy StBusyNext txid tx slot m a

diff --git a/ouroboros-network/src/Ouroboros/Network/Protocol/LocalTxMonitor/Type.hs b/ouroboros-network/src/Ouroboros/Network/Protocol/LocalTxMonitor/Type.hs
@@ -131,6 +131,11 @@ instance Protocol (LocalTxMonitor txid tx slot) where
       :: Bool
       -> Message (LocalTxMonitor txid tx slot) (StBusy StBusyHas) StAcquired
 
+    -- | Release the acquired snapshot, in order to loop back to the idle state.
+    --
+    MsgRelease
+      :: Message (LocalTxMonitor txid tx slot) StAcquired StIdle
+
     -- | The client can terminate the protocol.
     --
     MsgDone