diff --git a/ouroboros-network-protocols/bench-cddl/Main.hs b/ouroboros-network-protocols/bench-cddl/Main.hs index 9bf0d0abd1e..c89164a9061 100644 --- a/ouroboros-network-protocols/bench-cddl/Main.hs +++ b/ouroboros-network-protocols/bench-cddl/Main.hs @@ -318,7 +318,12 @@ localStateQueryMessages = (Stateful.AnyMessage StateIdle (LocalStateQuery.MsgAcquire - (SpecificPoint (BlockPoint largeCBORBS)))) + (SpecificPoint (BlockPoint largeCBORBS)) Nothing)) + , AnyMessageWithResult + (Stateful.AnyMessage + StateIdle + (LocalStateQuery.MsgAcquire + (SpecificPoint (BlockPoint largeCBORBS)) (Just 2600))) , AnyMessageWithResult (Stateful.AnyMessage StateAcquiring diff --git a/ouroboros-network-protocols/cddl/specs/local-state-query.cddl b/ouroboros-network-protocols/cddl/specs/local-state-query.cddl index 422b3c47f2d..25ee2e38ee4 100644 --- a/ouroboros-network-protocols/cddl/specs/local-state-query.cddl +++ b/ouroboros-network-protocols/cddl/specs/local-state-query.cddl @@ -23,14 +23,14 @@ failure = acquireFailurePointTooOld query = any result = any -msgAcquire = [0, base.point, ? bool] - / [8, ? bool] - / [10, ? bool] +msgAcquire = [0, point, ? word32] + / [8, ? word32] + / [10, ? word32] msgAcquired = [1] msgFailure = [2, failure] msgQuery = [3, query] msgResult = [4, result] -msgRelease = [5] +msgRelease = [5, ? word32] msgReAcquire = [6, point] / [9] / [11] diff --git a/ouroboros-network-protocols/src/Ouroboros/Network/Protocol/LocalStateQuery/Client.hs b/ouroboros-network-protocols/src/Ouroboros/Network/Protocol/LocalStateQuery/Client.hs index 34367accd51..6f41aced6ea 100644 --- a/ouroboros-network-protocols/src/Ouroboros/Network/Protocol/LocalStateQuery/Client.hs +++ b/ouroboros-network-protocols/src/Ouroboros/Network/Protocol/LocalStateQuery/Client.hs @@ -40,7 +40,7 @@ newtype LocalStateQueryClient block point (query :: Type -> Type) m a = -- data ClientStIdle block point query (m :: Type -> Type) a where SendMsgAcquire :: Target point - -> Bool + -> Maybe LeashID -> ClientStAcquiring block point query m a -> ClientStIdle block point query m a @@ -77,7 +77,8 @@ data ClientStAcquired block point query m a where -> ClientStAcquiring block point query m a -> ClientStAcquired block point query m a - SendMsgRelease :: m (ClientStIdle block point query m a) + SendMsgRelease :: Maybe LeashID + -> m (ClientStIdle block point query m a) -> ClientStAcquired block point query m a -- | In the 'StQuerying' protocol state, the client does not have agency. @@ -127,8 +128,8 @@ mapLocalStateQueryClient fpoint fquery fresult = -> ClientStAcquired block' point' query' m a goAcquired (SendMsgQuery q k) = case fquery q of Some q' -> SendMsgQuery q' (goQuerying q q' k) - goAcquired (SendMsgReAcquire tgt k) = SendMsgReAcquire (fpoint <$> tgt) (goAcquiring k) - goAcquired (SendMsgRelease k) = SendMsgRelease (fmap goIdle k) + goAcquired (SendMsgReAcquire tgt k) = SendMsgReAcquire (fpoint <$> tgt) (goAcquiring k) + goAcquired (SendMsgRelease mLeashId k) = SendMsgRelease mLeashId (fmap goIdle k) goQuerying :: forall result result'. query result @@ -190,9 +191,9 @@ localStateQueryClientPeer (LocalStateQueryClient handler) = Yield StateAcquired StateAcquiring (MsgReAcquire tgt) (handleStAcquiring stAcquiring) - SendMsgRelease stIdle -> + SendMsgRelease mLeashId stIdle -> Yield StateAcquired StateIdle - MsgRelease + (MsgRelease mLeashId) (Effect (handleStIdle <$> stIdle)) handleStQuerying diff --git a/ouroboros-network-protocols/src/Ouroboros/Network/Protocol/LocalStateQuery/Codec.hs b/ouroboros-network-protocols/src/Ouroboros/Network/Protocol/LocalStateQuery/Codec.hs index 2241413ab47..c95bc0452c0 100644 --- a/ouroboros-network-protocols/src/Ouroboros/Network/Protocol/LocalStateQuery/Codec.hs +++ b/ouroboros-network-protocols/src/Ouroboros/Network/Protocol/LocalStateQuery/Codec.hs @@ -77,27 +77,27 @@ codecLocalStateQuery version State st -> Message (LocalStateQuery block point query) st st' -> CBOR.Encoding - encode _ (MsgAcquire (SpecificPoint pt) False) = + encode _ (MsgAcquire (SpecificPoint pt) Nothing) = CBOR.encodeListLen 2 <> CBOR.encodeWord 0 <> encodePoint pt - encode _ (MsgAcquire (SpecificPoint pt) True) = + encode _ (MsgAcquire (SpecificPoint pt) (Just (LeashID leashId))) = CBOR.encodeListLen 3 <> CBOR.encodeWord 0 <> encodePoint pt - <> CBOR.encodeBool True + <> CBOR.encodeWord32 leashId - encode _ (MsgAcquire VolatileTip False) = + encode _ (MsgAcquire VolatileTip Nothing) = CBOR.encodeListLen 1 <> CBOR.encodeWord 8 - encode _ (MsgAcquire VolatileTip True) = + encode _ (MsgAcquire VolatileTip (Just (LeashID leashId))) = CBOR.encodeListLen 2 <> CBOR.encodeWord 8 - <> CBOR.encodeBool True + <> CBOR.encodeWord32 leashId - encode _ (MsgAcquire ImmutableTip False) + encode _ (MsgAcquire ImmutableTip Nothing) | canAcquireImmutable = CBOR.encodeListLen 1 <> CBOR.encodeWord 10 @@ -106,11 +106,11 @@ codecLocalStateQuery version ++ "must be conditional on negotiating v16 of the node-to-client " ++ "protocol" - encode _ (MsgAcquire ImmutableTip True) + encode _ (MsgAcquire ImmutableTip (Just (LeashID leashId))) | canAcquireImmutable = CBOR.encodeListLen 2 <> CBOR.encodeWord 10 - <> CBOR.encodeBool True + <> CBOR.encodeWord32 leashId | otherwise = error $ "encodeFailure: local state query: acquiring the immutable tip " ++ "must be conditional on negotiating v16 of the node-to-client " @@ -135,10 +135,15 @@ codecLocalStateQuery version <> CBOR.encodeWord 4 <> encodeResult query result - encode _ MsgRelease = + encode _ (MsgRelease Nothing) = CBOR.encodeListLen 1 <> CBOR.encodeWord 5 + encode _ (MsgRelease (Just (LeashID leashId))) = + CBOR.encodeListLen 2 + <> CBOR.encodeWord 5 + <> CBOR.encodeWord32 leashId + encode _ (MsgReAcquire (SpecificPoint pt)) = CBOR.encodeListLen 2 <> CBOR.encodeWord 6 @@ -172,26 +177,26 @@ codecLocalStateQuery version case (stok, f, len, key) of (SingIdle, _, 2, 0) -> do pt <- decodePoint - return (SomeMessage (MsgAcquire (SpecificPoint pt) False)) + return (SomeMessage (MsgAcquire (SpecificPoint pt) Nothing)) (SingIdle, _, 3, 0) -> do pt <- decodePoint - leashed <- CBOR.decodeBool - return (SomeMessage (MsgAcquire (SpecificPoint pt) leashed)) + leashed <- CBOR.decodeWord32 + return (SomeMessage (MsgAcquire (SpecificPoint pt) (Just (LeashID leashed)))) (SingIdle, _, 1, 8) -> do - return (SomeMessage (MsgAcquire VolatileTip False)) + return (SomeMessage (MsgAcquire VolatileTip Nothing)) (SingIdle, _, 2, 8) -> do - leashed <- CBOR.decodeBool - return (SomeMessage (MsgAcquire VolatileTip leashed)) + leashed <- CBOR.decodeWord32 + return (SomeMessage (MsgAcquire VolatileTip (Just (LeashID leashed)))) (SingIdle, _, 1, 10) -> do - return (SomeMessage (MsgAcquire ImmutableTip False)) + return (SomeMessage (MsgAcquire ImmutableTip Nothing)) (SingIdle, _, 2, 10) -> do - leashed <- CBOR.decodeBool - return (SomeMessage (MsgAcquire ImmutableTip leashed)) + leashed <- CBOR.decodeWord32 + return (SomeMessage (MsgAcquire ImmutableTip (Just (LeashID leashed)))) (SingAcquiring, _, 1, 1) -> return (SomeMessage MsgAcquired) @@ -209,7 +214,11 @@ codecLocalStateQuery version return (SomeMessage (MsgResult result)) (SingAcquired, _, 1, 5) -> - return (SomeMessage MsgRelease) + return (SomeMessage $ MsgRelease Nothing) + + (SingAcquired, _, 2, 5) -> do + leashId <- CBOR.decodeWord32 + return (SomeMessage $ MsgRelease (Just (LeashID leashId))) (SingAcquired, _, 2, 6) -> do pt <- decodePoint diff --git a/ouroboros-network-protocols/src/Ouroboros/Network/Protocol/LocalStateQuery/Server.hs b/ouroboros-network-protocols/src/Ouroboros/Network/Protocol/LocalStateQuery/Server.hs index 25625ff6662..c70b6777445 100644 --- a/ouroboros-network-protocols/src/Ouroboros/Network/Protocol/LocalStateQuery/Server.hs +++ b/ouroboros-network-protocols/src/Ouroboros/Network/Protocol/LocalStateQuery/Server.hs @@ -37,7 +37,7 @@ newtype LocalStateQueryServer block point (query :: Type -> Type) m a = LocalSta -- data ServerStIdle block point query m a = ServerStIdle { recvMsgAcquire :: Target point - -> Bool + -> Maybe LeashID -> m (ServerStAcquiring block point query m a), recvMsgDone :: m a @@ -74,7 +74,8 @@ data ServerStAcquired block point query m a = ServerStAcquired { recvMsgReAcquire :: Target point -> m (ServerStAcquiring block point query m a), - recvMsgRelease :: m (ServerStIdle block point query m a) + recvMsgRelease :: Maybe LeashID + -> m (ServerStIdle block point query m a) } -- | In the 'StQuerying' protocol state, the server has agency and must send: @@ -127,15 +128,15 @@ localStateQueryServerPeer (LocalStateQueryServer handler) = -> Server (LocalStateQuery block point query) StAcquired State m a handleStAcquired ServerStAcquired{recvMsgQuery, recvMsgReAcquire, recvMsgRelease} = Await $ \_ req -> case req of - MsgQuery query -> ( Effect $ handleStQuerying query <$> recvMsgQuery query - , StateQuerying query - ) - MsgReAcquire pt -> ( Effect $ handleStAcquiring <$> recvMsgReAcquire pt - , StateAcquiring - ) - MsgRelease -> ( Effect $ handleStIdle <$> recvMsgRelease - , StateIdle - ) + MsgQuery query -> ( Effect $ handleStQuerying query <$> recvMsgQuery query + , StateQuerying query + ) + MsgReAcquire pt -> ( Effect $ handleStAcquiring <$> recvMsgReAcquire pt + , StateAcquiring + ) + MsgRelease mLeashId -> ( Effect $ handleStIdle <$> recvMsgRelease mLeashId + , StateIdle + ) handleStQuerying :: query result diff --git a/ouroboros-network-protocols/src/Ouroboros/Network/Protocol/LocalStateQuery/Type.hs b/ouroboros-network-protocols/src/Ouroboros/Network/Protocol/LocalStateQuery/Type.hs index f87e1176ecc..25d2bba4362 100644 --- a/ouroboros-network-protocols/src/Ouroboros/Network/Protocol/LocalStateQuery/Type.hs +++ b/ouroboros-network-protocols/src/Ouroboros/Network/Protocol/LocalStateQuery/Type.hs @@ -12,6 +12,8 @@ {-# LANGUAGE StandaloneKindSignatures #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE UndecidableInstances #-} +{-# LANGUAGE DerivingStrategies #-} +{-# LANGUAGE GeneralizedNewtypeDeriving #-} -- | The type of the local ledger state query protocol. -- @@ -29,6 +31,8 @@ import Network.TypedProtocol.Stateful.Codec (AnyMessage (..)) import Control.DeepSeq import GHC.Generics import Ouroboros.Network.Util.ShowProxy (ShowProxy (..)) +import Data.Word (Word32) +import NoThunks.Class (NoThunks) -- | The kind of the local state query protocol, and the types of @@ -128,6 +132,12 @@ data Target point = -- | The tip of the volatile chain | ImmutableTip deriving (Eq, Foldable, Functor, Generic, Ord, Show, Traversable, NFData) + +newtype LeashID = LeashID Word32 + deriving stock (Show) + -- TODO: anything else? + deriving newtype (Eq, Ord, NFData, Num, Read, NoThunks) + instance Protocol (LocalStateQuery (block :: Type) (point :: Type) (query :: Type -> Type)) where -- | The messages in the state query protocol. @@ -141,7 +151,7 @@ instance Protocol (LocalStateQuery (block :: Type) (point :: Type) (query :: Typ -- MsgAcquire :: Target point - -> Bool + -> Maybe LeashID -- ^ Optional leashing ID -> Message (LocalStateQuery block point query) StIdle StAcquiring -- | The server can confirm that it has the state at the requested point. @@ -169,10 +179,14 @@ instance Protocol (LocalStateQuery (block :: Type) (point :: Type) (query :: Typ -> Message (LocalStateQuery block point query) (StQuerying result) StAcquired -- | The client can instruct the server to release the state. This lets - -- the server free resources. + -- the server free resources. If the LeashID is set, it means that this client's + -- leash should be removed, otherwise the node should continue to be leashed + -- for later reconnection. -- MsgRelease - :: Message (LocalStateQuery block point query) StAcquired StIdle + -- TODO: Should there be a backwards compatible pattern and a new one for leashing? + :: Maybe LeashID -- If this is set, then it means the client wishes to UNleash + -> Message (LocalStateQuery block point query) StAcquired StIdle -- | This is like 'MsgAcquire' but for when the client already has a -- state. By moving to another state directly without a 'MsgRelease' it @@ -210,7 +224,7 @@ instance ( forall result. NFData (query result) rnf (MsgFailure af) = rnf af rnf (MsgQuery qr) = rnf qr rnf (MsgResult r) = rwhnf r - rnf MsgRelease = () + rnf (MsgRelease lId) = rnf lId rnf (MsgReAcquire mbPoint) = rnf mbPoint rnf MsgDone = () @@ -254,8 +268,10 @@ instance (ShowQuery query, Show point) showParen (p >= 11) $ showString "MsgResult " . showParen True (showString (showResult query result)) - AnyMessage _f MsgRelease -> - showString "MsgRelease" + AnyMessage _f (MsgRelease mLeashId) -> + showParen (p >= 11) $ + showString "MsgRelease" . + showsPrec 11 mLeashId AnyMessage _f (MsgReAcquire pt) -> showParen (p >= 11) $ showString "MsgReAcquire " . diff --git a/ouroboros-network-protocols/testlib/Ouroboros/Network/Protocol/LocalStateQuery/Direct.hs b/ouroboros-network-protocols/testlib/Ouroboros/Network/Protocol/LocalStateQuery/Direct.hs index 05a03a4f471..8fbc6cfb5f5 100644 --- a/ouroboros-network-protocols/testlib/Ouroboros/Network/Protocol/LocalStateQuery/Direct.hs +++ b/ouroboros-network-protocols/testlib/Ouroboros/Network/Protocol/LocalStateQuery/Direct.hs @@ -48,9 +48,9 @@ direct (LocalStateQueryClient mclient) (LocalStateQueryServer mserver) = do directAcquired (SendMsgReAcquire tgt client') ServerStAcquired{recvMsgReAcquire} = do server' <- recvMsgReAcquire tgt directAcquiring client' server' - directAcquired (SendMsgRelease client) ServerStAcquired{recvMsgRelease} = do + directAcquired (SendMsgRelease mLeashId client) ServerStAcquired{recvMsgRelease} = do client' <- client - server' <- recvMsgRelease + server' <- recvMsgRelease mLeashId directIdle client' server' directQuerying diff --git a/ouroboros-network-protocols/testlib/Ouroboros/Network/Protocol/LocalStateQuery/Examples.hs b/ouroboros-network-protocols/testlib/Ouroboros/Network/Protocol/LocalStateQuery/Examples.hs index e8df83115dd..666a21c2bb4 100644 --- a/ouroboros-network-protocols/testlib/Ouroboros/Network/Protocol/LocalStateQuery/Examples.hs +++ b/ouroboros-network-protocols/testlib/Ouroboros/Network/Protocol/LocalStateQuery/Examples.hs @@ -5,7 +5,8 @@ module Ouroboros.Network.Protocol.LocalStateQuery.Examples where import Ouroboros.Network.Protocol.LocalStateQuery.Client import Ouroboros.Network.Protocol.LocalStateQuery.Server import Ouroboros.Network.Protocol.LocalStateQuery.Type (AcquireFailure (..), - Target) + Target, + LeashID) -- @@ -20,39 +21,39 @@ import Ouroboros.Network.Protocol.LocalStateQuery.Type (AcquireFailure (..), localStateQueryClient :: forall block point query result m. Applicative m - => [(Target point, Bool, query result)] + => [(Target point, Maybe LeashID, query result)] -> LocalStateQueryClient block point query m - [(Target point, Bool, Either AcquireFailure result)] + [(Target point, Maybe LeashID, Either AcquireFailure result)] localStateQueryClient = LocalStateQueryClient . pure . goIdle [] where goIdle - :: [(Target point, Bool, Either AcquireFailure result)] -- ^ Accumulator - -> [(Target point, Bool, query result)] -- ^ Remainder + :: [(Target point, Maybe LeashID, Either AcquireFailure result)] -- ^ Accumulator + -> [(Target point, Maybe LeashID, query result)] -- ^ Remainder -> ClientStIdle block point query m - [(Target point, Bool, Either AcquireFailure result)] + [(Target point, Maybe LeashID, Either AcquireFailure result)] goIdle acc [] = SendMsgDone $ reverse acc goIdle acc ((tgt, leashed, q):ptqs') = SendMsgAcquire tgt leashed $ goAcquiring acc tgt leashed q ptqs' goAcquiring - :: [(Target point, Bool, Either AcquireFailure result)] -- ^ Accumulator + :: [(Target point, Maybe LeashID, Either AcquireFailure result)] -- ^ Accumulator -> Target point - -> Bool + -> Maybe LeashID -> query result - -> [(Target point, Bool, query result)] -- ^ Remainder + -> [(Target point, Maybe LeashID, query result)] -- ^ Remainder -> ClientStAcquiring block point query m - [(Target point, Bool, Either AcquireFailure result)] + [(Target point, Maybe LeashID, Either AcquireFailure result)] goAcquiring acc pt leashed q ptqss' = ClientStAcquiring { recvMsgAcquired = pure $ goQuery q $ \r -> goAcquired ((pt, leashed, Right r):acc) ptqss' , recvMsgFailure = \failure -> pure $ goIdle ((pt, leashed, Left failure):acc) ptqss' } goAcquired - :: [(Target point, Bool, Either AcquireFailure result)] - -> [(Target point, Bool, query result)] -- ^ Remainder + :: [(Target point, Maybe LeashID, Either AcquireFailure result)] + -> [(Target point, Maybe LeashID, query result)] -- ^ Remainder -> ClientStAcquired block point query m - [(Target point, Bool, Either AcquireFailure result)] - goAcquired acc [] = SendMsgRelease $ pure $ SendMsgDone $ reverse acc + [(Target point, Maybe LeashID, Either AcquireFailure result)] + goAcquired acc [] = SendMsgRelease Nothing $ pure $ SendMsgDone $ reverse acc goAcquired acc ((tgt, leashed, qs):ptqss') = SendMsgReAcquire tgt $ goAcquiring acc tgt leashed qs ptqss' @@ -73,7 +74,7 @@ localStateQueryClient = LocalStateQueryClient . pure . goIdle [] -- localStateQueryServer :: forall block point query m state. Applicative m - => (Target point -> Bool -> Either AcquireFailure state) + => (Target point -> Maybe LeashID -> Either AcquireFailure state) -> (forall result. state -> query result -> result) -> LocalStateQueryServer block point query m () localStateQueryServer acquire answer = @@ -85,15 +86,15 @@ localStateQueryServer acquire answer = , recvMsgDone = pure () } - goAcquiring :: Target point -> Bool -> m (ServerStAcquiring block point query m ()) + goAcquiring :: Target point -> Maybe LeashID -> m (ServerStAcquiring block point query m ()) goAcquiring tgt leashed = pure $ case acquire tgt leashed of Left failure -> SendMsgFailure failure goIdle Right state -> SendMsgAcquired $ goAcquired leashed state - goAcquired :: Bool -> state -> ServerStAcquired block point query m () + goAcquired :: Maybe LeashID -> state -> ServerStAcquired block point query m () goAcquired leashed state = ServerStAcquired { recvMsgQuery = \query -> pure $ SendMsgResult (answer state query) $ goAcquired leashed state , recvMsgReAcquire = flip goAcquiring leashed - , recvMsgRelease = pure goIdle + , recvMsgRelease = \_mLeashId -> pure goIdle } diff --git a/ouroboros-network-protocols/testlib/Ouroboros/Network/Protocol/LocalStateQuery/Test.hs b/ouroboros-network-protocols/testlib/Ouroboros/Network/Protocol/LocalStateQuery/Test.hs index cab13f9945c..b43b261b966 100644 --- a/ouroboros-network-protocols/testlib/Ouroboros/Network/Protocol/LocalStateQuery/Test.hs +++ b/ouroboros-network-protocols/testlib/Ouroboros/Network/Protocol/LocalStateQuery/Test.hs @@ -165,10 +165,10 @@ prop_direct :: SetupData prop_direct input = runSimOrThrow (direct - (localStateQueryClient (map (\(tgt, q) -> (tgt, False, q)) clientInput)) + (localStateQueryClient (map (\(tgt, q) -> (tgt, Nothing, q)) clientInput)) (localStateQueryServer (\tgt _ -> serverAcquire tgt) serverAnswer)) === - (map (\(t, r) -> (t, False, r)) expected, ()) + (map (\(t, r) -> (t, Nothing, r)) expected, ()) where Setup { clientInput, serverAcquire, serverAnswer, expected } = mkSetup input @@ -186,7 +186,7 @@ prop_connect input = case runSimOrThrow (Stateful.connect StateIdle (localStateQueryClientPeer $ - localStateQueryClient (map (\(tgt, q) -> (tgt, False, q)) clientInput)) + localStateQueryClient (map (\(tgt, q) -> (tgt, Nothing, q)) clientInput)) (localStateQueryServerPeer $ localStateQueryServer (\tgt _ -> serverAcquire tgt) serverAnswer)) of @@ -218,7 +218,7 @@ prop_channel createChannels input = do codec StateIdle (localStateQueryClientPeer $ - localStateQueryClient (map (\(tgt, q) -> (tgt, False, q)) clientInput)) + localStateQueryClient (map (\(tgt, q) -> (tgt, Nothing, q)) clientInput)) (localStateQueryServerPeer $ localStateQueryServer (\tgt _ -> serverAcquire tgt) serverAnswer) return $ case r of @@ -304,6 +304,8 @@ newtype AnyMessageV7 block point query result = AnyMessageV7 { } deriving Show +deriving instance Arbitrary LeashID + instance ( Arbitrary point , Arbitrary (query result) , Arbitrary result @@ -328,7 +330,9 @@ instance ( Arbitrary point (MsgResult result)) <$> (arbitrary :: Gen (QueryWithResult query result)) - , pure (Stateful.AnyMessage StateAcquired MsgRelease) + , (\mLeashId -> + Stateful.AnyMessage StateAcquired (MsgRelease mLeashId)) + <$> arbitrary , Stateful.AnyMessage StateAcquired <$> (MsgReAcquire <$> arbitrary) @@ -341,8 +345,8 @@ instance ShowQuery Query where instance Eq (Stateful.AnyMessage (LocalStateQuery Block (Point Block) Query) State) where - (==) (Stateful.AnyMessage _ (MsgAcquire tgt leashed)) - (Stateful.AnyMessage _ (MsgAcquire tgt' leashed')) = tgt == tgt' && leashed == leashed' + (==) (Stateful.AnyMessage _ (MsgAcquire tgt mLeashId)) + (Stateful.AnyMessage _ (MsgAcquire tgt' mLeashId')) = tgt == tgt' && mLeashId == mLeashId' (==) (Stateful.AnyMessage _ MsgAcquired) (Stateful.AnyMessage _ MsgAcquired) = True @@ -360,8 +364,8 @@ instance Eq (Stateful.AnyMessage (LocalStateQuery Block (Point Block) Query) St case (query, query') of (GetTheLedgerState, GetTheLedgerState) -> result == result' - (==) (Stateful.AnyMessage _ MsgRelease) - (Stateful.AnyMessage _ MsgRelease) = True + (==) (Stateful.AnyMessage _ (MsgRelease mLeashId)) + (Stateful.AnyMessage _ (MsgRelease mLeashId')) = mLeashId == mLeashId' (==) (Stateful.AnyMessage _ (MsgReAcquire tgt)) (Stateful.AnyMessage _ (MsgReAcquire tgt')) = tgt == tgt'