{-# LANGUAGE DataKinds #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeFamilies #-}
module Ouroboros.Network.Protocol.LocalTxMonitor.Codec
( codecLocalTxMonitor
, codecLocalTxMonitorId
) where
import Control.Monad.Class.MonadST
import Network.TypedProtocol.Codec.CBOR
import Data.ByteString.Lazy (ByteString)
import qualified Codec.CBOR.Decoding as CBOR
import qualified Codec.CBOR.Encoding as CBOR
import qualified Codec.CBOR.Read as CBOR
import Text.Printf
import Ouroboros.Network.Protocol.LocalTxMonitor.Type
codecLocalTxMonitor ::
forall txid tx slot m ptcl.
( MonadST m
, ptcl ~ LocalTxMonitor txid tx slot
)
=> (txid -> CBOR.Encoding)
-> (forall s. CBOR.Decoder s txid)
-> (tx -> CBOR.Encoding)
-> (forall s. CBOR.Decoder s tx)
-> (slot -> CBOR.Encoding)
-> (forall s. CBOR.Decoder s slot)
-> Codec (LocalTxMonitor txid tx slot) CBOR.DeserialiseFailure m ByteString
codecLocalTxMonitor :: (txid -> Encoding)
-> (forall s. Decoder s txid)
-> (tx -> Encoding)
-> (forall s. Decoder s tx)
-> (slot -> Encoding)
-> (forall s. Decoder s slot)
-> Codec
(LocalTxMonitor txid tx slot) DeserialiseFailure m ByteString
codecLocalTxMonitor txid -> Encoding
encodeTxId forall s. Decoder s txid
decodeTxId
tx -> Encoding
encodeTx forall s. Decoder s tx
decodeTx
slot -> Encoding
encodeSlot forall s. Decoder s slot
decodeSlot =
(forall (pr :: PeerRole) (st :: LocalTxMonitor txid tx slot)
(st' :: LocalTxMonitor txid tx slot).
PeerHasAgency pr st
-> Message (LocalTxMonitor txid tx slot) st st' -> Encoding)
-> (forall (pr :: PeerRole) (st :: LocalTxMonitor txid tx slot) s.
PeerHasAgency pr st -> Decoder s (SomeMessage st))
-> Codec
(LocalTxMonitor txid tx slot) DeserialiseFailure m ByteString
forall ps (m :: * -> *).
MonadST m =>
(forall (pr :: PeerRole) (st :: ps) (st' :: ps).
PeerHasAgency pr st -> Message ps st st' -> Encoding)
-> (forall (pr :: PeerRole) (st :: ps) s.
PeerHasAgency pr st -> Decoder s (SomeMessage st))
-> Codec ps DeserialiseFailure m ByteString
mkCodecCborLazyBS forall (pr :: PeerRole) (st :: ptcl) (st' :: ptcl).
PeerHasAgency pr st -> Message ptcl st st' -> Encoding
forall (pr :: PeerRole) (st :: LocalTxMonitor txid tx slot)
(st' :: LocalTxMonitor txid tx slot).
PeerHasAgency pr st
-> Message (LocalTxMonitor txid tx slot) st st' -> Encoding
encode forall s (pr :: PeerRole) (st :: ptcl).
PeerHasAgency pr st -> Decoder s (SomeMessage st)
forall (pr :: PeerRole) (st :: LocalTxMonitor txid tx slot) s.
PeerHasAgency pr st -> Decoder s (SomeMessage st)
decode
where
encode ::
forall (pr :: PeerRole) (st :: ptcl) (st' :: ptcl). ()
=> PeerHasAgency pr st
-> Message ptcl st st'
-> CBOR.Encoding
encode :: PeerHasAgency pr st -> Message ptcl st st' -> Encoding
encode (ClientAgency ClientHasAgency st
TokIdle) = \case
Message ptcl st st'
MsgDone ->
Word -> Encoding
CBOR.encodeListLen Word
1 Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Word -> Encoding
CBOR.encodeWord Word
0
Message ptcl st st'
MsgAcquire ->
Word -> Encoding
CBOR.encodeListLen Word
1 Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Word -> Encoding
CBOR.encodeWord Word
1
encode (ClientAgency ClientHasAgency st
TokAcquired) = \case
Message ptcl st st'
MsgAwaitAcquire ->
Word -> Encoding
CBOR.encodeListLen Word
1 Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Word -> Encoding
CBOR.encodeWord Word
1
Message ptcl st st'
MsgRelease ->
Word -> Encoding
CBOR.encodeListLen Word
1 Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Word -> Encoding
CBOR.encodeWord Word
3
Message ptcl st st'
MsgNextTx ->
Word -> Encoding
CBOR.encodeListLen Word
1 Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Word -> Encoding
CBOR.encodeWord Word
5
MsgHasTx txid ->
Word -> Encoding
CBOR.encodeListLen Word
2 Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Word -> Encoding
CBOR.encodeWord Word
7 Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> txid -> Encoding
encodeTxId txid
txid
txid
Message ptcl st st'
MsgGetSizes ->
Word -> Encoding
CBOR.encodeListLen Word
1 Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Word -> Encoding
CBOR.encodeWord Word
9
encode (ServerAgency ServerHasAgency st
TokAcquiring) = \case
MsgAcquired slot ->
Word -> Encoding
CBOR.encodeListLen Word
2 Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Word -> Encoding
CBOR.encodeWord Word
2 Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> slot -> Encoding
encodeSlot slot
slot
slot
encode (ServerAgency (TokBusy TokNextTx)) = \case
MsgReplyNextTx Nothing ->
Word -> Encoding
CBOR.encodeListLen Word
1 Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Word -> Encoding
CBOR.encodeWord Word
6
MsgReplyNextTx (Just tx) ->
Word -> Encoding
CBOR.encodeListLen Word
2 Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Word -> Encoding
CBOR.encodeWord Word
6 Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> tx -> Encoding
encodeTx tx
tx
tx
encode (ServerAgency (TokBusy TokHasTx)) = \case
MsgReplyHasTx has ->
Word -> Encoding
CBOR.encodeListLen Word
2 Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Word -> Encoding
CBOR.encodeWord Word
8 Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Bool -> Encoding
CBOR.encodeBool Bool
has
encode (ServerAgency (TokBusy TokGetSizes)) = \case
MsgReplyGetSizes sz ->
Word -> Encoding
CBOR.encodeListLen Word
2
Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Word -> Encoding
CBOR.encodeWord Word
10
Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Word -> Encoding
CBOR.encodeListLen Word
3
Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Word32 -> Encoding
CBOR.encodeWord32 (MempoolSizeAndCapacity -> Word32
capacityInBytes MempoolSizeAndCapacity
sz)
Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Word32 -> Encoding
CBOR.encodeWord32 (MempoolSizeAndCapacity -> Word32
sizeInBytes MempoolSizeAndCapacity
sz)
Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Word32 -> Encoding
CBOR.encodeWord32 (MempoolSizeAndCapacity -> Word32
numberOfTxs MempoolSizeAndCapacity
sz)
decode ::
forall s (pr :: PeerRole) (st :: ptcl). ()
=> PeerHasAgency pr st
-> CBOR.Decoder s (SomeMessage st)
decode :: PeerHasAgency pr st -> Decoder s (SomeMessage st)
decode PeerHasAgency pr st
stok = do
Int
len <- Decoder s Int
forall s. Decoder s Int
CBOR.decodeListLen
Word
key <- Decoder s Word
forall s. Decoder s Word
CBOR.decodeWord
case (PeerHasAgency pr st
stok, Int
len, Word
key) of
(ClientAgency ClientHasAgency st
TokIdle, Int
1, Word
0) ->
SomeMessage 'StIdle -> Decoder s (SomeMessage 'StIdle)
forall (m :: * -> *) a. Monad m => a -> m a
return (Message (LocalTxMonitor txid tx slot) 'StIdle 'StDone
-> SomeMessage 'StIdle
forall ps (st :: ps) (st' :: ps).
Message ps st st' -> SomeMessage st
SomeMessage Message (LocalTxMonitor txid tx slot) 'StIdle 'StDone
forall k k k (txid :: k) (tx :: k) (slot :: k).
Message (LocalTxMonitor txid tx slot) 'StIdle 'StDone
MsgDone)
(ClientAgency ClientHasAgency st
TokIdle, Int
1, Word
1) ->
SomeMessage 'StIdle -> Decoder s (SomeMessage 'StIdle)
forall (m :: * -> *) a. Monad m => a -> m a
return (Message (LocalTxMonitor txid tx slot) 'StIdle 'StAcquiring
-> SomeMessage 'StIdle
forall ps (st :: ps) (st' :: ps).
Message ps st st' -> SomeMessage st
SomeMessage Message (LocalTxMonitor txid tx slot) 'StIdle 'StAcquiring
forall k k k (txid :: k) (tx :: k) (slot :: k).
Message (LocalTxMonitor txid tx slot) 'StIdle 'StAcquiring
MsgAcquire)
(ClientAgency ClientHasAgency st
TokAcquired, Int
1, Word
1) ->
SomeMessage 'StAcquired -> Decoder s (SomeMessage 'StAcquired)
forall (m :: * -> *) a. Monad m => a -> m a
return (Message (LocalTxMonitor txid tx slot) 'StAcquired 'StAcquiring
-> SomeMessage 'StAcquired
forall ps (st :: ps) (st' :: ps).
Message ps st st' -> SomeMessage st
SomeMessage Message (LocalTxMonitor txid tx slot) 'StAcquired 'StAcquiring
forall k k k (txid :: k) (tx :: k) (slot :: k).
Message (LocalTxMonitor txid tx slot) 'StAcquired 'StAcquiring
MsgAwaitAcquire)
(ClientAgency ClientHasAgency st
TokAcquired, Int
1, Word
3) ->
SomeMessage 'StAcquired -> Decoder s (SomeMessage 'StAcquired)
forall (m :: * -> *) a. Monad m => a -> m a
return (Message (LocalTxMonitor txid tx slot) 'StAcquired 'StIdle
-> SomeMessage 'StAcquired
forall ps (st :: ps) (st' :: ps).
Message ps st st' -> SomeMessage st
SomeMessage Message (LocalTxMonitor txid tx slot) 'StAcquired 'StIdle
forall k k k (txid :: k) (tx :: k) (slot :: k).
Message (LocalTxMonitor txid tx slot) 'StAcquired 'StIdle
MsgRelease)
(ClientAgency ClientHasAgency st
TokAcquired, Int
1, Word
5) ->
SomeMessage 'StAcquired -> Decoder s (SomeMessage 'StAcquired)
forall (m :: * -> *) a. Monad m => a -> m a
return (Message (LocalTxMonitor txid tx slot) 'StAcquired ('StBusy 'NextTx)
-> SomeMessage 'StAcquired
forall ps (st :: ps) (st' :: ps).
Message ps st st' -> SomeMessage st
SomeMessage Message (LocalTxMonitor txid tx slot) 'StAcquired ('StBusy 'NextTx)
forall k k k (txid :: k) (tx :: k) (slot :: k).
Message (LocalTxMonitor txid tx slot) 'StAcquired ('StBusy 'NextTx)
MsgNextTx)
(ClientAgency ClientHasAgency st
TokAcquired, Int
2, Word
7) -> do
txid
txid <- Decoder s txid
forall s. Decoder s txid
decodeTxId
SomeMessage 'StAcquired -> Decoder s (SomeMessage 'StAcquired)
forall (m :: * -> *) a. Monad m => a -> m a
return (Message (LocalTxMonitor txid tx slot) 'StAcquired ('StBusy 'HasTx)
-> SomeMessage 'StAcquired
forall ps (st :: ps) (st' :: ps).
Message ps st st' -> SomeMessage st
SomeMessage (txid
-> Message
(LocalTxMonitor txid tx slot) 'StAcquired ('StBusy 'HasTx)
forall k k txid (tx :: k) (slot :: k).
txid
-> Message
(LocalTxMonitor txid tx slot) 'StAcquired ('StBusy 'HasTx)
MsgHasTx txid
txid))
(ClientAgency ClientHasAgency st
TokAcquired, Int
1, Word
9) ->
SomeMessage 'StAcquired -> Decoder s (SomeMessage 'StAcquired)
forall (m :: * -> *) a. Monad m => a -> m a
return (Message
(LocalTxMonitor txid tx slot) 'StAcquired ('StBusy 'GetSizes)
-> SomeMessage 'StAcquired
forall ps (st :: ps) (st' :: ps).
Message ps st st' -> SomeMessage st
SomeMessage Message
(LocalTxMonitor txid tx slot) 'StAcquired ('StBusy 'GetSizes)
forall k k k (txid :: k) (tx :: k) (slot :: k).
Message
(LocalTxMonitor txid tx slot) 'StAcquired ('StBusy 'GetSizes)
MsgGetSizes)
(ServerAgency ServerHasAgency st
TokAcquiring, Int
2, Word
2) -> do
slot
slot <- Decoder s slot
forall s. Decoder s slot
decodeSlot
SomeMessage 'StAcquiring -> Decoder s (SomeMessage 'StAcquiring)
forall (m :: * -> *) a. Monad m => a -> m a
return (Message (LocalTxMonitor txid tx slot) 'StAcquiring 'StAcquired
-> SomeMessage 'StAcquiring
forall ps (st :: ps) (st' :: ps).
Message ps st st' -> SomeMessage st
SomeMessage (slot
-> Message (LocalTxMonitor txid tx slot) 'StAcquiring 'StAcquired
forall k k slot (txid :: k) (tx :: k).
slot
-> Message (LocalTxMonitor txid tx slot) 'StAcquiring 'StAcquired
MsgAcquired slot
slot))
(ServerAgency (TokBusy TokNextTx), Int
1, Word
6) ->
SomeMessage ('StBusy 'NextTx)
-> Decoder s (SomeMessage ('StBusy 'NextTx))
forall (m :: * -> *) a. Monad m => a -> m a
return (Message (LocalTxMonitor txid tx slot) ('StBusy 'NextTx) 'StAcquired
-> SomeMessage ('StBusy 'NextTx)
forall ps (st :: ps) (st' :: ps).
Message ps st st' -> SomeMessage st
SomeMessage (Maybe tx
-> Message
(LocalTxMonitor txid tx slot) ('StBusy 'NextTx) 'StAcquired
forall k k tx (txid :: k) (slot :: k).
Maybe tx
-> Message
(LocalTxMonitor txid tx slot) ('StBusy 'NextTx) 'StAcquired
MsgReplyNextTx Maybe tx
forall a. Maybe a
Nothing))
(ServerAgency (TokBusy TokNextTx), Int
2, Word
6) -> do
tx
tx <- Decoder s tx
forall s. Decoder s tx
decodeTx
SomeMessage ('StBusy 'NextTx)
-> Decoder s (SomeMessage ('StBusy 'NextTx))
forall (m :: * -> *) a. Monad m => a -> m a
return (Message (LocalTxMonitor txid tx slot) ('StBusy 'NextTx) 'StAcquired
-> SomeMessage ('StBusy 'NextTx)
forall ps (st :: ps) (st' :: ps).
Message ps st st' -> SomeMessage st
SomeMessage (Maybe tx
-> Message
(LocalTxMonitor txid tx slot) ('StBusy 'NextTx) 'StAcquired
forall k k tx (txid :: k) (slot :: k).
Maybe tx
-> Message
(LocalTxMonitor txid tx slot) ('StBusy 'NextTx) 'StAcquired
MsgReplyNextTx (tx -> Maybe tx
forall a. a -> Maybe a
Just tx
tx)))
(ServerAgency (TokBusy TokHasTx), Int
2, Word
8) -> do
Bool
has <- Decoder s Bool
forall s. Decoder s Bool
CBOR.decodeBool
SomeMessage ('StBusy 'HasTx)
-> Decoder s (SomeMessage ('StBusy 'HasTx))
forall (m :: * -> *) a. Monad m => a -> m a
return (Message (LocalTxMonitor txid tx slot) ('StBusy 'HasTx) 'StAcquired
-> SomeMessage ('StBusy 'HasTx)
forall ps (st :: ps) (st' :: ps).
Message ps st st' -> SomeMessage st
SomeMessage (Bool
-> Message
(LocalTxMonitor txid tx slot) ('StBusy 'HasTx) 'StAcquired
forall k k k (txid :: k) (tx :: k) (slot :: k).
Bool
-> Message
(LocalTxMonitor txid tx slot) ('StBusy 'HasTx) 'StAcquired
MsgReplyHasTx Bool
has))
(ServerAgency (TokBusy TokGetSizes), Int
2, Word
10) -> do
Int
_len <- Decoder s Int
forall s. Decoder s Int
CBOR.decodeListLen
Word32
capacityInBytes <- Decoder s Word32
forall s. Decoder s Word32
CBOR.decodeWord32
Word32
sizeInBytes <- Decoder s Word32
forall s. Decoder s Word32
CBOR.decodeWord32
Word32
numberOfTxs <- Decoder s Word32
forall s. Decoder s Word32
CBOR.decodeWord32
let sizes :: MempoolSizeAndCapacity
sizes = MempoolSizeAndCapacity :: Word32 -> Word32 -> Word32 -> MempoolSizeAndCapacity
MempoolSizeAndCapacity { Word32
capacityInBytes :: Word32
capacityInBytes :: Word32
capacityInBytes, Word32
sizeInBytes :: Word32
sizeInBytes :: Word32
sizeInBytes, Word32
numberOfTxs :: Word32
numberOfTxs :: Word32
numberOfTxs }
SomeMessage ('StBusy 'GetSizes)
-> Decoder s (SomeMessage ('StBusy 'GetSizes))
forall (m :: * -> *) a. Monad m => a -> m a
return (Message
(LocalTxMonitor txid tx slot) ('StBusy 'GetSizes) 'StAcquired
-> SomeMessage ('StBusy 'GetSizes)
forall ps (st :: ps) (st' :: ps).
Message ps st st' -> SomeMessage st
SomeMessage (MempoolSizeAndCapacity
-> Message
(LocalTxMonitor txid tx slot) ('StBusy 'GetSizes) 'StAcquired
forall k k k (txid :: k) (tx :: k) (slot :: k).
MempoolSizeAndCapacity
-> Message
(LocalTxMonitor txid tx slot) ('StBusy 'GetSizes) 'StAcquired
MsgReplyGetSizes MempoolSizeAndCapacity
sizes))
(ClientAgency ClientHasAgency st
TokIdle, Int
_, Word
_) ->
String -> Decoder s (SomeMessage st)
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> String -> Word -> Int -> String
forall r. PrintfType r => String -> r
printf String
"codecLocalTxMonitor (%s) unexpected key (%d, %d)" (PeerHasAgency pr st -> String
forall a. Show a => a -> String
show PeerHasAgency pr st
stok) Word
key Int
len)
(ClientAgency ClientHasAgency st
TokAcquired, Int
_, Word
_) ->
String -> Decoder s (SomeMessage st)
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> String -> Word -> Int -> String
forall r. PrintfType r => String -> r
printf String
"codecLocalTxMonitor (%s) unexpected key (%d, %d)" (PeerHasAgency pr st -> String
forall a. Show a => a -> String
show PeerHasAgency pr st
stok) Word
key Int
len)
(ServerAgency ServerHasAgency st
TokAcquiring, Int
_, Word
_) ->
String -> Decoder s (SomeMessage st)
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> String -> Word -> Int -> String
forall r. PrintfType r => String -> r
printf String
"codecLocalTxMonitor (%s) unexpected key (%d, %d)" (PeerHasAgency pr st -> String
forall a. Show a => a -> String
show PeerHasAgency pr st
stok) Word
key Int
len)
(ServerAgency (TokBusy _), Int
_, Word
_) ->
String -> Decoder s (SomeMessage st)
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> String -> Word -> Int -> String
forall r. PrintfType r => String -> r
printf String
"codecLocalTxMonitor (%s) unexpected key (%d, %d)" (PeerHasAgency pr st -> String
forall a. Show a => a -> String
show PeerHasAgency pr st
stok) Word
key Int
len)
codecLocalTxMonitorId ::
forall txid tx slot m ptcl.
( Monad m
, ptcl ~ LocalTxMonitor txid tx slot
)
=> Codec ptcl CodecFailure m (AnyMessage ptcl)
codecLocalTxMonitorId :: Codec ptcl CodecFailure m (AnyMessage ptcl)
codecLocalTxMonitorId =
(forall (pr :: PeerRole) (st :: ptcl) (st' :: ptcl).
PeerHasAgency pr st -> Message ptcl st st' -> AnyMessage ptcl)
-> (forall (pr :: PeerRole) (st :: ptcl).
PeerHasAgency pr st
-> m (DecodeStep
(AnyMessage ptcl) CodecFailure m (SomeMessage st)))
-> Codec ptcl CodecFailure m (AnyMessage ptcl)
forall ps failure (m :: * -> *) bytes.
(forall (pr :: PeerRole) (st :: ps) (st' :: ps).
PeerHasAgency pr st -> Message ps st st' -> bytes)
-> (forall (pr :: PeerRole) (st :: ps).
PeerHasAgency pr st
-> m (DecodeStep bytes failure m (SomeMessage st)))
-> Codec ps failure m bytes
Codec forall (pr :: PeerRole) (st :: ptcl) (st' :: ptcl).
PeerHasAgency pr st -> Message ptcl st st' -> AnyMessage ptcl
encode forall (pr :: PeerRole) (st :: ptcl).
PeerHasAgency pr st
-> m (DecodeStep (AnyMessage ptcl) CodecFailure m (SomeMessage st))
decode
where
encode ::
forall (pr :: PeerRole) st st'. ()
=> PeerHasAgency pr st
-> Message ptcl st st'
-> AnyMessage ptcl
encode :: PeerHasAgency pr st -> Message ptcl st st' -> AnyMessage ptcl
encode PeerHasAgency pr st
_ =
Message ptcl st st' -> AnyMessage ptcl
forall ps (st :: ps) (st' :: ps).
Message ps st st' -> AnyMessage ps
AnyMessage
decode ::
forall (pr :: PeerRole) (st :: ptcl). ()
=> PeerHasAgency pr st
-> m (DecodeStep (AnyMessage ptcl) CodecFailure m (SomeMessage st))
decode :: PeerHasAgency pr st
-> m (DecodeStep (AnyMessage ptcl) CodecFailure m (SomeMessage st))
decode PeerHasAgency pr st
stok =
let res :: Message ptcl st st' -> m (DecodeStep bytes failure m (SomeMessage st))
res :: Message ptcl st st'
-> m (DecodeStep bytes failure m (SomeMessage st))
res Message ptcl st st'
msg = DecodeStep bytes failure m (SomeMessage st)
-> m (DecodeStep bytes failure m (SomeMessage st))
forall (m :: * -> *) a. Monad m => a -> m a
return (SomeMessage st
-> Maybe bytes -> DecodeStep bytes failure m (SomeMessage st)
forall bytes failure (m :: * -> *) a.
a -> Maybe bytes -> DecodeStep bytes failure m a
DecodeDone (Message ptcl st st' -> SomeMessage st
forall ps (st :: ps) (st' :: ps).
Message ps st st' -> SomeMessage st
SomeMessage Message ptcl st st'
msg) Maybe bytes
forall a. Maybe a
Nothing)
in DecodeStep (AnyMessage ptcl) CodecFailure m (SomeMessage st)
-> m (DecodeStep (AnyMessage ptcl) CodecFailure m (SomeMessage st))
forall (m :: * -> *) a. Monad m => a -> m a
return (DecodeStep (AnyMessage ptcl) CodecFailure m (SomeMessage st)
-> m (DecodeStep
(AnyMessage ptcl) CodecFailure m (SomeMessage st)))
-> DecodeStep (AnyMessage ptcl) CodecFailure m (SomeMessage st)
-> m (DecodeStep (AnyMessage ptcl) CodecFailure m (SomeMessage st))
forall a b. (a -> b) -> a -> b
$ (Maybe (AnyMessage ptcl)
-> m (DecodeStep
(AnyMessage ptcl) CodecFailure m (SomeMessage st)))
-> DecodeStep (AnyMessage ptcl) CodecFailure m (SomeMessage st)
forall bytes failure (m :: * -> *) a.
(Maybe bytes -> m (DecodeStep bytes failure m a))
-> DecodeStep bytes failure m a
DecodePartial ((Maybe (AnyMessage ptcl)
-> m (DecodeStep
(AnyMessage ptcl) CodecFailure m (SomeMessage st)))
-> DecodeStep (AnyMessage ptcl) CodecFailure m (SomeMessage st))
-> (Maybe (AnyMessage ptcl)
-> m (DecodeStep
(AnyMessage ptcl) CodecFailure m (SomeMessage st)))
-> DecodeStep (AnyMessage ptcl) CodecFailure m (SomeMessage st)
forall a b. (a -> b) -> a -> b
$ \Maybe (AnyMessage ptcl)
bytes -> case (PeerHasAgency pr st
stok, Maybe (AnyMessage ptcl)
bytes) of
(ClientAgency ClientHasAgency st
TokIdle, Just (AnyMessage msg@MsgAcquire{})) -> Message ptcl st 'StAcquiring
-> m (DecodeStep (AnyMessage ptcl) CodecFailure m (SomeMessage st))
forall (st' :: ptcl) bytes failure.
Message ptcl st st'
-> m (DecodeStep bytes failure m (SomeMessage st))
res Message ptcl st 'StAcquiring
Message (LocalTxMonitor txid tx slot) st st'
msg
(ClientAgency ClientHasAgency st
TokIdle, Just (AnyMessage msg@MsgDone{})) -> Message ptcl st 'StDone
-> m (DecodeStep (AnyMessage ptcl) CodecFailure m (SomeMessage st))
forall (st' :: ptcl) bytes failure.
Message ptcl st st'
-> m (DecodeStep bytes failure m (SomeMessage st))
res Message ptcl st 'StDone
Message (LocalTxMonitor txid tx slot) st st'
msg
(ClientAgency ClientHasAgency st
TokAcquired, Just (AnyMessage msg@MsgAwaitAcquire{})) -> Message ptcl st 'StAcquiring
-> m (DecodeStep (AnyMessage ptcl) CodecFailure m (SomeMessage st))
forall (st' :: ptcl) bytes failure.
Message ptcl st st'
-> m (DecodeStep bytes failure m (SomeMessage st))
res Message ptcl st 'StAcquiring
Message (LocalTxMonitor txid tx slot) st st'
msg
(ClientAgency ClientHasAgency st
TokAcquired, Just (AnyMessage msg@MsgNextTx{})) -> Message ptcl st ('StBusy 'NextTx)
-> m (DecodeStep (AnyMessage ptcl) CodecFailure m (SomeMessage st))
forall (st' :: ptcl) bytes failure.
Message ptcl st st'
-> m (DecodeStep bytes failure m (SomeMessage st))
res Message ptcl st ('StBusy 'NextTx)
Message (LocalTxMonitor txid tx slot) st st'
msg
(ClientAgency ClientHasAgency st
TokAcquired, Just (AnyMessage msg@MsgHasTx{})) -> Message ptcl st ('StBusy 'HasTx)
-> m (DecodeStep (AnyMessage ptcl) CodecFailure m (SomeMessage st))
forall (st' :: ptcl) bytes failure.
Message ptcl st st'
-> m (DecodeStep bytes failure m (SomeMessage st))
res Message ptcl st ('StBusy 'HasTx)
Message (LocalTxMonitor txid tx slot) st st'
msg
(ClientAgency ClientHasAgency st
TokAcquired, Just (AnyMessage msg@MsgRelease{})) -> Message ptcl st 'StIdle
-> m (DecodeStep (AnyMessage ptcl) CodecFailure m (SomeMessage st))
forall (st' :: ptcl) bytes failure.
Message ptcl st st'
-> m (DecodeStep bytes failure m (SomeMessage st))
res Message ptcl st 'StIdle
Message (LocalTxMonitor txid tx slot) st st'
msg
(ServerAgency ServerHasAgency st
TokAcquiring, Just (AnyMessage msg@MsgAcquired{})) -> Message ptcl st 'StAcquired
-> m (DecodeStep (AnyMessage ptcl) CodecFailure m (SomeMessage st))
forall (st' :: ptcl) bytes failure.
Message ptcl st st'
-> m (DecodeStep bytes failure m (SomeMessage st))
res Message ptcl st 'StAcquired
Message (LocalTxMonitor txid tx slot) st st'
msg
(ServerAgency (TokBusy TokNextTx), Just (AnyMessage msg@MsgReplyNextTx{})) -> Message ptcl st 'StAcquired
-> m (DecodeStep (AnyMessage ptcl) CodecFailure m (SomeMessage st))
forall (st' :: ptcl) bytes failure.
Message ptcl st st'
-> m (DecodeStep bytes failure m (SomeMessage st))
res Message ptcl st 'StAcquired
Message (LocalTxMonitor txid tx slot) st st'
msg
(ServerAgency (TokBusy TokHasTx), Just (AnyMessage msg@MsgReplyHasTx{})) -> Message ptcl st 'StAcquired
-> m (DecodeStep (AnyMessage ptcl) CodecFailure m (SomeMessage st))
forall (st' :: ptcl) bytes failure.
Message ptcl st st'
-> m (DecodeStep bytes failure m (SomeMessage st))
res Message ptcl st 'StAcquired
Message (LocalTxMonitor txid tx slot) st st'
msg
(PeerHasAgency pr st
_, Maybe (AnyMessage ptcl)
Nothing) ->
DecodeStep (AnyMessage ptcl) CodecFailure m (SomeMessage st)
-> m (DecodeStep (AnyMessage ptcl) CodecFailure m (SomeMessage st))
forall (m :: * -> *) a. Monad m => a -> m a
return (CodecFailure
-> DecodeStep (AnyMessage ptcl) CodecFailure m (SomeMessage st)
forall bytes failure (m :: * -> *) a.
failure -> DecodeStep bytes failure m a
DecodeFail CodecFailure
CodecFailureOutOfInput)
(PeerHasAgency pr st
_, Maybe (AnyMessage ptcl)
_) ->
DecodeStep (AnyMessage ptcl) CodecFailure m (SomeMessage st)
-> m (DecodeStep (AnyMessage ptcl) CodecFailure m (SomeMessage st))
forall (m :: * -> *) a. Monad m => a -> m a
return (CodecFailure
-> DecodeStep (AnyMessage ptcl) CodecFailure m (SomeMessage st)
forall bytes failure (m :: * -> *) a.
failure -> DecodeStep bytes failure m a
DecodeFail (String -> CodecFailure
CodecFailure String
"codecLocalTxMonitorId: no matching message"))