{-# LANGUAGE DataKinds           #-}
{-# LANGUAGE FlexibleContexts    #-}
{-# LANGUAGE GADTs               #-}
{-# LANGUAGE NamedFieldPuns      #-}
{-# LANGUAGE PolyKinds           #-}
{-# LANGUAGE RankNTypes          #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeFamilies        #-}

module Ouroboros.Network.Protocol.TxSubmission2.Codec
  ( codecTxSubmission2
  , codecTxSubmission2Id
  , encodeTxSubmission2
  , decodeTxSubmission2
  , byteLimitsTxSubmission2
  , timeLimitsTxSubmission2
  ) where

import Control.Monad.Class.MonadST
import Control.Monad.Class.MonadTime.SI
import Data.List.NonEmpty qualified as NonEmpty

import Codec.CBOR.Decoding qualified as CBOR
import Codec.CBOR.Encoding qualified as CBOR
import Codec.CBOR.Read qualified as CBOR
import Data.ByteString.Lazy (ByteString)
import Text.Printf

import Network.TypedProtocol.Codec.CBOR

import Ouroboros.Network.Protocol.Limits
import Ouroboros.Network.Protocol.TxSubmission2.Type

-- | Byte Limits.
byteLimitsTxSubmission2 :: forall bytes txid tx.
                           (bytes -> Word)
                        -> ProtocolSizeLimits (TxSubmission2 txid tx) bytes
byteLimitsTxSubmission2 :: forall {k} {k1} bytes (txid :: k) (tx :: k1).
(bytes -> Word) -> ProtocolSizeLimits (TxSubmission2 txid tx) bytes
byteLimitsTxSubmission2 = (forall (st :: TxSubmission2 txid tx).
 ActiveState st =>
 StateToken st -> Word)
-> (bytes -> Word)
-> ProtocolSizeLimits (TxSubmission2 txid tx) bytes
forall ps bytes.
(forall (st :: ps). ActiveState st => StateToken st -> Word)
-> (bytes -> Word) -> ProtocolSizeLimits ps bytes
ProtocolSizeLimits StateToken st -> Word
forall (st :: TxSubmission2 txid tx).
ActiveState st =>
StateToken st -> Word
stateToLimit
  where
    stateToLimit :: forall (st :: TxSubmission2 txid tx).
                    ActiveState st => StateToken st -> Word
    stateToLimit :: forall (st :: TxSubmission2 txid tx).
ActiveState st =>
StateToken st -> Word
stateToLimit StateToken st
SingTxSubmission st
SingInit                    = Word
smallByteLimit
    stateToLimit (SingTxIds SingBlockingStyle stBlocking
SingBlocking)    = Word
largeByteLimit
    stateToLimit (SingTxIds SingBlockingStyle stBlocking
SingNonBlocking) = Word
largeByteLimit
    stateToLimit StateToken st
SingTxSubmission st
SingTxs                     = Word
largeByteLimit
    stateToLimit StateToken st
SingTxSubmission st
SingIdle                    = Word
smallByteLimit
    stateToLimit a :: StateToken st
a@StateToken st
SingTxSubmission st
SingDone                  = StateToken 'StDone -> forall a. a
forall ps (st :: ps).
(StateAgency st ~ 'NobodyAgency, ActiveState st) =>
StateToken st -> forall a. a
notActiveState StateToken st
StateToken 'StDone
a


-- | Time Limits.
--
-- `SingTxIds SingBlocking` No timeout
-- `SingTxIds SingNonBlocking` `shortWait` timeout
-- `SingTxs` `shortWait` timeout
-- `SingIdle` `shortWait` timeout
timeLimitsTxSubmission2 :: forall txid tx. ProtocolTimeLimits (TxSubmission2 txid tx)
timeLimitsTxSubmission2 :: forall {k} {k1} (txid :: k) (tx :: k1).
ProtocolTimeLimits (TxSubmission2 txid tx)
timeLimitsTxSubmission2 = (forall (st :: TxSubmission2 txid tx).
 ActiveState st =>
 StateToken st -> Maybe DiffTime)
-> ProtocolTimeLimits (TxSubmission2 txid tx)
forall ps.
(forall (st :: ps).
 ActiveState st =>
 StateToken st -> Maybe DiffTime)
-> ProtocolTimeLimits ps
ProtocolTimeLimits StateToken st -> Maybe DiffTime
forall (st :: TxSubmission2 txid tx).
ActiveState st =>
StateToken st -> Maybe DiffTime
stateToLimit
  where
    stateToLimit :: forall (st :: TxSubmission2 txid tx).
                    ActiveState st => StateToken st -> Maybe DiffTime
    stateToLimit :: forall (st :: TxSubmission2 txid tx).
ActiveState st =>
StateToken st -> Maybe DiffTime
stateToLimit StateToken st
SingTxSubmission st
SingInit                    = Maybe DiffTime
waitForever
    stateToLimit (SingTxIds SingBlockingStyle stBlocking
SingBlocking)    = Maybe DiffTime
waitForever
    stateToLimit (SingTxIds SingBlockingStyle stBlocking
SingNonBlocking) = Maybe DiffTime
shortWait
    stateToLimit StateToken st
SingTxSubmission st
SingTxs                     = Maybe DiffTime
shortWait
    stateToLimit StateToken st
SingTxSubmission st
SingIdle                    = Maybe DiffTime
waitForever
    stateToLimit a :: StateToken st
a@StateToken st
SingTxSubmission st
SingDone                  = StateToken 'StDone -> forall a. a
forall ps (st :: ps).
(StateAgency st ~ 'NobodyAgency, ActiveState st) =>
StateToken st -> forall a. a
notActiveState StateToken st
StateToken 'StDone
a


codecTxSubmission2
  :: forall txid tx m.
     MonadST m
  => (txid -> CBOR.Encoding)
  -> (forall s . CBOR.Decoder s txid)
  -> (tx -> CBOR.Encoding)
  -> (forall s . CBOR.Decoder s tx)
  -> Codec (TxSubmission2 txid tx) CBOR.DeserialiseFailure m ByteString
codecTxSubmission2 :: forall txid tx (m :: * -> *).
MonadST m =>
(txid -> Encoding)
-> (forall s. Decoder s txid)
-> (tx -> Encoding)
-> (forall s. Decoder s tx)
-> Codec (TxSubmission2 txid tx) DeserialiseFailure m ByteString
codecTxSubmission2 txid -> Encoding
encodeTxId forall s. Decoder s txid
decodeTxId
                   tx -> Encoding
encodeTx   forall s. Decoder s tx
decodeTx =
    (forall (st :: TxSubmission2 txid tx)
        (st' :: TxSubmission2 txid tx).
 (StateTokenI st, ActiveState st) =>
 Message (TxSubmission2 txid tx) st st' -> Encoding)
-> (forall (st :: TxSubmission2 txid tx) s.
    ActiveState st =>
    StateToken st -> Decoder s (SomeMessage st))
-> Codec (TxSubmission2 txid tx) DeserialiseFailure m ByteString
forall ps (m :: * -> *).
MonadST m =>
(forall (st :: ps) (st' :: ps).
 (StateTokenI st, ActiveState st) =>
 Message ps st st' -> Encoding)
-> (forall (st :: ps) s.
    ActiveState st =>
    StateToken st -> Decoder s (SomeMessage st))
-> Codec ps DeserialiseFailure m ByteString
mkCodecCborLazyBS
      ((txid -> Encoding)
-> (tx -> Encoding)
-> forall (st :: TxSubmission2 txid tx)
          (st' :: TxSubmission2 txid tx).
   Message (TxSubmission2 txid tx) st st' -> Encoding
forall txid tx.
(txid -> Encoding)
-> (tx -> Encoding)
-> forall (st :: TxSubmission2 txid tx)
          (st' :: TxSubmission2 txid tx).
   Message (TxSubmission2 txid tx) st st' -> Encoding
encodeTxSubmission2 txid -> Encoding
encodeTxId tx -> Encoding
encodeTx)
      StateToken st -> Decoder s (SomeMessage st)
StateToken st -> forall s. Decoder s (SomeMessage st)
forall (st :: TxSubmission2 txid tx).
ActiveState st =>
StateToken st -> forall s. Decoder s (SomeMessage st)
forall (st :: TxSubmission2 txid tx) s.
ActiveState st =>
StateToken st -> Decoder s (SomeMessage st)
decode
  where
    decode :: forall (st :: TxSubmission2 txid tx).
              ActiveState st
           => StateToken st
           -> forall s. CBOR.Decoder s (SomeMessage st)
    decode :: forall (st :: TxSubmission2 txid tx).
ActiveState st =>
StateToken st -> forall s. Decoder s (SomeMessage st)
decode StateToken st
stok = do
      len <- Decoder s Int
forall s. Decoder s Int
CBOR.decodeListLen
      key <- CBOR.decodeWord
      decodeTxSubmission2 decodeTxId decodeTx stok len key

encodeTxSubmission2
    :: forall txid tx.
       (txid -> CBOR.Encoding)
    -> (tx -> CBOR.Encoding)
    -> (forall (st :: TxSubmission2 txid tx) (st' :: TxSubmission2 txid tx).
               Message (TxSubmission2 txid tx) st st'
            -> CBOR.Encoding)
encodeTxSubmission2 :: forall txid tx.
(txid -> Encoding)
-> (tx -> Encoding)
-> forall (st :: TxSubmission2 txid tx)
          (st' :: TxSubmission2 txid tx).
   Message (TxSubmission2 txid tx) st st' -> Encoding
encodeTxSubmission2 txid -> Encoding
encodeTxId tx -> Encoding
encodeTx = Message (TxSubmission2 txid tx) st st' -> Encoding
forall (st :: TxSubmission2 txid tx)
       (st' :: TxSubmission2 txid tx).
Message (TxSubmission2 txid tx) st st' -> Encoding
encode
  where
    encode :: forall st st'.
              Message (TxSubmission2 txid tx) st st'
           -> CBOR.Encoding
    encode :: forall (st :: TxSubmission2 txid tx)
       (st' :: TxSubmission2 txid tx).
Message (TxSubmission2 txid tx) st st' -> Encoding
encode Message (TxSubmission2 txid tx) st st'
R:MessageTxSubmission2fromto (*) (*) txid tx st st'
MsgInit =
        Word -> Encoding
CBOR.encodeListLen Word
1
     Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Word -> Encoding
CBOR.encodeWord Word
6
    encode (MsgRequestTxIds SingBlockingStyle blocking
blocking (NumTxIdsToAck Word16
ackNo) (NumTxIdsToReq Word16
reqNo)) =
        Word -> Encoding
CBOR.encodeListLen Word
4
     Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Word -> Encoding
CBOR.encodeWord Word
0
     Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Bool -> Encoding
CBOR.encodeBool (case SingBlockingStyle blocking
blocking of
                           SingBlockingStyle blocking
SingBlocking    -> Bool
True
                           SingBlockingStyle blocking
SingNonBlocking -> Bool
False)
     Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Word16 -> Encoding
CBOR.encodeWord16 Word16
ackNo
     Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Word16 -> Encoding
CBOR.encodeWord16 Word16
reqNo

    encode (MsgReplyTxIds BlockingReplyList blocking (txid1, SizeInBytes)
txids) =
        Word -> Encoding
CBOR.encodeListLen Word
2
     Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Word -> Encoding
CBOR.encodeWord Word
1
     Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Encoding
CBOR.encodeListLenIndef
     Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> ((txid, SizeInBytes) -> Encoding -> Encoding)
-> Encoding -> [(txid, SizeInBytes)] -> Encoding
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\(txid
txid, SizeInBytes Word32
sz) Encoding
r ->
                                Word -> Encoding
CBOR.encodeListLen Word
2
                             Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> txid -> Encoding
encodeTxId txid
txid
                             Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Word32 -> Encoding
CBOR.encodeWord32 Word32
sz
                             Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Encoding
r)
              Encoding
CBOR.encodeBreak
              [(txid, SizeInBytes)]
txids'
      where
        txids' :: [(txid, SizeInBytes)]
        txids' :: [(txid, SizeInBytes)]
txids' = case BlockingReplyList blocking (txid1, SizeInBytes)
txids of
                   BlockingReply    NonEmpty (txid1, SizeInBytes)
xs -> NonEmpty (txid, SizeInBytes) -> [(txid, SizeInBytes)]
forall a. NonEmpty a -> [a]
NonEmpty.toList NonEmpty (txid, SizeInBytes)
NonEmpty (txid1, SizeInBytes)
xs
                   NonBlockingReply [(txid1, SizeInBytes)]
xs -> [(txid, SizeInBytes)]
[(txid1, SizeInBytes)]
xs

    encode (MsgRequestTxs [txid1]
txids) =
        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
<> Encoding
CBOR.encodeListLenIndef
     Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> (txid -> Encoding -> Encoding) -> Encoding -> [txid] -> Encoding
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\txid
txid Encoding
r -> txid -> Encoding
encodeTxId txid
txid Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Encoding
r) Encoding
CBOR.encodeBreak [txid]
[txid1]
txids

    encode (MsgReplyTxs [tx1]
txs) =
        Word -> Encoding
CBOR.encodeListLen Word
2
     Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Word -> Encoding
CBOR.encodeWord Word
3
     Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Encoding
CBOR.encodeListLenIndef
     Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> (tx -> Encoding -> Encoding) -> Encoding -> [tx] -> Encoding
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\tx
txid Encoding
r -> tx -> Encoding
encodeTx tx
txid Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Encoding
r) Encoding
CBOR.encodeBreak [tx]
[tx1]
txs

    encode Message (TxSubmission2 txid tx) st st'
R:MessageTxSubmission2fromto (*) (*) txid tx st st'
MsgDone =
        Word -> Encoding
CBOR.encodeListLen Word
1
     Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Word -> Encoding
CBOR.encodeWord Word
4


decodeTxSubmission2
    :: forall txid tx.
       (forall s . CBOR.Decoder s txid)
    -> (forall s . CBOR.Decoder s tx)
    -> (forall (st :: TxSubmission2 txid tx) s.
               ActiveState st
            => StateToken st
            -> Int
            -> Word
            -> CBOR.Decoder s (SomeMessage st))
decodeTxSubmission2 :: forall txid tx.
(forall s. Decoder s txid)
-> (forall s. Decoder s tx)
-> forall (st :: TxSubmission2 txid tx) s.
   ActiveState st =>
   StateToken st -> Int -> Word -> Decoder s (SomeMessage st)
decodeTxSubmission2 forall s. Decoder s txid
decodeTxId forall s. Decoder s tx
decodeTx = StateToken st -> Int -> Word -> Decoder s (SomeMessage st)
forall s (st :: TxSubmission2 txid tx).
ActiveState st =>
StateToken st -> Int -> Word -> Decoder s (SomeMessage st)
decode
  where
    decode :: forall s (st :: TxSubmission2 txid tx).
              ActiveState st
           => StateToken st
           -> Int
           -> Word
           -> CBOR.Decoder s (SomeMessage st)
    decode :: forall s (st :: TxSubmission2 txid tx).
ActiveState st =>
StateToken st -> Int -> Word -> Decoder s (SomeMessage st)
decode StateToken st
stok Int
len Word
key = do
      case (StateToken st
SingTxSubmission st
stok, Int
len, Word
key) of
        (SingTxSubmission st
SingInit,       Int
1, Word
6) ->
          SomeMessage st -> Decoder s (SomeMessage st)
forall a. a -> Decoder s a
forall (m :: * -> *) a. Monad m => a -> m a
return (Message (TxSubmission2 txid tx) st 'StIdle -> SomeMessage st
forall ps (st :: ps) (st' :: ps).
(StateTokenI st, StateTokenI st', ActiveState st) =>
Message ps st st' -> SomeMessage st
SomeMessage Message (TxSubmission2 txid tx) st 'StIdle
Message (TxSubmission2 txid tx) 'StInit 'StIdle
forall {k} {k1} (txid :: k) (tx :: k1).
Message (TxSubmission2 txid tx) 'StInit 'StIdle
MsgInit)
        (SingTxSubmission st
SingIdle,       Int
4, Word
0) -> do
          blocking <- Decoder s Bool
forall s. Decoder s Bool
CBOR.decodeBool
          ackNo    <- NumTxIdsToAck <$> CBOR.decodeWord16
          reqNo    <- NumTxIdsToReq <$> CBOR.decodeWord16
          return $! case blocking of
            Bool
True  -> Message (TxSubmission2 txid tx) st ('StTxIds 'StBlocking)
-> SomeMessage st
forall ps (st :: ps) (st' :: ps).
(StateTokenI st, StateTokenI st', ActiveState st) =>
Message ps st st' -> SomeMessage st
SomeMessage (SingBlockingStyle 'StBlocking
-> NumTxIdsToAck
-> NumTxIdsToReq
-> Message (TxSubmission2 txid tx) 'StIdle ('StTxIds 'StBlocking)
forall {k} {k1} (blocking :: StBlockingStyle) (txid :: k)
       (tx :: k1).
SingBlockingStyle blocking
-> NumTxIdsToAck
-> NumTxIdsToReq
-> Message (TxSubmission2 txid tx) 'StIdle ('StTxIds blocking)
MsgRequestTxIds SingBlockingStyle 'StBlocking
SingBlocking    NumTxIdsToAck
ackNo NumTxIdsToReq
reqNo)
            Bool
False -> Message (TxSubmission2 txid tx) st ('StTxIds 'StNonBlocking)
-> SomeMessage st
forall ps (st :: ps) (st' :: ps).
(StateTokenI st, StateTokenI st', ActiveState st) =>
Message ps st st' -> SomeMessage st
SomeMessage (SingBlockingStyle 'StNonBlocking
-> NumTxIdsToAck
-> NumTxIdsToReq
-> Message
     (TxSubmission2 txid tx) 'StIdle ('StTxIds 'StNonBlocking)
forall {k} {k1} (blocking :: StBlockingStyle) (txid :: k)
       (tx :: k1).
SingBlockingStyle blocking
-> NumTxIdsToAck
-> NumTxIdsToReq
-> Message (TxSubmission2 txid tx) 'StIdle ('StTxIds blocking)
MsgRequestTxIds SingBlockingStyle 'StNonBlocking
SingNonBlocking NumTxIdsToAck
ackNo NumTxIdsToReq
reqNo)

        (SingTxIds SingBlockingStyle stBlocking
b,  Int
2, Word
1) -> do
          Decoder s ()
forall s. Decoder s ()
CBOR.decodeListLenIndef
          txids <- ([(txid, SizeInBytes)]
 -> (txid, SizeInBytes) -> [(txid, SizeInBytes)])
-> [(txid, SizeInBytes)]
-> ([(txid, SizeInBytes)] -> [(txid, SizeInBytes)])
-> Decoder s (txid, SizeInBytes)
-> Decoder s [(txid, SizeInBytes)]
forall r a r' s.
(r -> a -> r) -> r -> (r -> r') -> Decoder s a -> Decoder s r'
CBOR.decodeSequenceLenIndef
                     (((txid, SizeInBytes)
 -> [(txid, SizeInBytes)] -> [(txid, SizeInBytes)])
-> [(txid, SizeInBytes)]
-> (txid, SizeInBytes)
-> [(txid, SizeInBytes)]
forall a b c. (a -> b -> c) -> b -> a -> c
flip (:)) [] [(txid, SizeInBytes)] -> [(txid, SizeInBytes)]
forall a. [a] -> [a]
reverse
                     (do Int -> Decoder s ()
forall s. Int -> Decoder s ()
CBOR.decodeListLenOf Int
2
                         txid <- Decoder s txid
forall s. Decoder s txid
decodeTxId
                         sz   <- CBOR.decodeWord32
                         return (txid, SizeInBytes sz))
          case (b, txids) of
            (SingBlockingStyle stBlocking
SingBlocking, (txid, SizeInBytes)
t:[(txid, SizeInBytes)]
ts) ->
              SomeMessage st -> Decoder s (SomeMessage st)
forall a. a -> Decoder s a
forall (m :: * -> *) a. Monad m => a -> m a
return (SomeMessage st -> Decoder s (SomeMessage st))
-> SomeMessage st -> Decoder s (SomeMessage st)
forall a b. (a -> b) -> a -> b
$
                Message (TxSubmission2 txid tx) st 'StIdle -> SomeMessage st
forall ps (st :: ps) (st' :: ps).
(StateTokenI st, StateTokenI st', ActiveState st) =>
Message ps st st' -> SomeMessage st
SomeMessage (BlockingReplyList 'StBlocking (txid, SizeInBytes)
-> Message (TxSubmission2 txid tx) ('StTxIds 'StBlocking) 'StIdle
forall {k1} (blocking :: StBlockingStyle) txid1 (tx :: k1).
BlockingReplyList blocking (txid1, SizeInBytes)
-> Message (TxSubmission2 txid1 tx) ('StTxIds blocking) 'StIdle
MsgReplyTxIds (NonEmpty (txid, SizeInBytes)
-> BlockingReplyList 'StBlocking (txid, SizeInBytes)
forall a. NonEmpty a -> BlockingReplyList 'StBlocking a
BlockingReply ((txid, SizeInBytes)
t (txid, SizeInBytes)
-> [(txid, SizeInBytes)] -> NonEmpty (txid, SizeInBytes)
forall a. a -> [a] -> NonEmpty a
NonEmpty.:| [(txid, SizeInBytes)]
ts)))

            (SingBlockingStyle stBlocking
SingNonBlocking, [(txid, SizeInBytes)]
ts) ->
              SomeMessage st -> Decoder s (SomeMessage st)
forall a. a -> Decoder s a
forall (m :: * -> *) a. Monad m => a -> m a
return (SomeMessage st -> Decoder s (SomeMessage st))
-> SomeMessage st -> Decoder s (SomeMessage st)
forall a b. (a -> b) -> a -> b
$
                Message (TxSubmission2 txid tx) st 'StIdle -> SomeMessage st
forall ps (st :: ps) (st' :: ps).
(StateTokenI st, StateTokenI st', ActiveState st) =>
Message ps st st' -> SomeMessage st
SomeMessage (BlockingReplyList 'StNonBlocking (txid, SizeInBytes)
-> Message
     (TxSubmission2 txid tx) ('StTxIds 'StNonBlocking) 'StIdle
forall {k1} (blocking :: StBlockingStyle) txid1 (tx :: k1).
BlockingReplyList blocking (txid1, SizeInBytes)
-> Message (TxSubmission2 txid1 tx) ('StTxIds blocking) 'StIdle
MsgReplyTxIds ([(txid, SizeInBytes)]
-> BlockingReplyList 'StNonBlocking (txid, SizeInBytes)
forall a. [a] -> BlockingReplyList 'StNonBlocking a
NonBlockingReply [(txid, SizeInBytes)]
ts))

            (SingBlockingStyle stBlocking
SingBlocking, []) ->
              String -> Decoder s (SomeMessage st)
forall a. String -> Decoder s a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"codecTxSubmission: MsgReplyTxIds: empty list not permitted"


        (SingTxSubmission st
SingIdle,       Int
2, Word
2) -> do
          Decoder s ()
forall s. Decoder s ()
CBOR.decodeListLenIndef
          txids <- ([txid] -> txid -> [txid])
-> [txid]
-> ([txid] -> [txid])
-> Decoder s txid
-> Decoder s [txid]
forall r a r' s.
(r -> a -> r) -> r -> (r -> r') -> Decoder s a -> Decoder s r'
CBOR.decodeSequenceLenIndef ((txid -> [txid] -> [txid]) -> [txid] -> txid -> [txid]
forall a b c. (a -> b -> c) -> b -> a -> c
flip (:)) [] [txid] -> [txid]
forall a. [a] -> [a]
reverse Decoder s txid
forall s. Decoder s txid
decodeTxId
          return (SomeMessage (MsgRequestTxs txids))

        (SingTxSubmission st
SingTxs,     Int
2, Word
3) -> do
          Decoder s ()
forall s. Decoder s ()
CBOR.decodeListLenIndef
          txids <- ([tx] -> tx -> [tx])
-> [tx] -> ([tx] -> [tx]) -> Decoder s tx -> Decoder s [tx]
forall r a r' s.
(r -> a -> r) -> r -> (r -> r') -> Decoder s a -> Decoder s r'
CBOR.decodeSequenceLenIndef ((tx -> [tx] -> [tx]) -> [tx] -> tx -> [tx]
forall a b c. (a -> b -> c) -> b -> a -> c
flip (:)) [] [tx] -> [tx]
forall a. [a] -> [a]
reverse Decoder s tx
forall s. Decoder s tx
decodeTx
          return (SomeMessage (MsgReplyTxs txids))

        (SingTxIds SingBlockingStyle stBlocking
SingBlocking, Int
1, Word
4) ->
          SomeMessage st -> Decoder s (SomeMessage st)
forall a. a -> Decoder s a
forall (m :: * -> *) a. Monad m => a -> m a
return (Message (TxSubmission2 txid tx) st 'StDone -> SomeMessage st
forall ps (st :: ps) (st' :: ps).
(StateTokenI st, StateTokenI st', ActiveState st) =>
Message ps st st' -> SomeMessage st
SomeMessage Message (TxSubmission2 txid tx) st 'StDone
Message (TxSubmission2 txid tx) ('StTxIds 'StBlocking) 'StDone
forall {k} {k1} (txid :: k) (tx :: k1).
Message (TxSubmission2 txid tx) ('StTxIds 'StBlocking) 'StDone
MsgDone)

        (SingTxSubmission st
SingDone, Int
_, Word
_) -> StateToken 'StDone -> forall a. a
forall ps (st :: ps).
(StateAgency st ~ 'NobodyAgency, ActiveState st) =>
StateToken st -> forall a. a
notActiveState StateToken st
StateToken 'StDone
stok

        --
        -- failures per protocol state
        --

        (SingTxSubmission st
SingInit, Int
_, Word
_) ->
            String -> Decoder s (SomeMessage st)
forall a. String -> Decoder s a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> String -> Word -> Int -> String
forall r. PrintfType r => String -> r
printf String
"codecTxSubmission (%s) unexpected key (%d, %d)" (SingTxSubmission 'StInit -> String
forall a. Show a => a -> String
show StateToken st
SingTxSubmission 'StInit
stok) Word
key Int
len)
        (SingTxIds SingBlockingStyle stBlocking
SingBlocking, Int
_, Word
_) ->
            String -> Decoder s (SomeMessage st)
forall a. String -> Decoder s a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> String -> Word -> Int -> String
forall r. PrintfType r => String -> r
printf String
"codecTxSubmission (%s) unexpected key (%d, %d)" (SingTxSubmission ('StTxIds 'StBlocking) -> String
forall a. Show a => a -> String
show StateToken st
SingTxSubmission ('StTxIds 'StBlocking)
stok) Word
key Int
len)
        (SingTxIds SingBlockingStyle stBlocking
SingNonBlocking, Int
_, Word
_) ->
            String -> Decoder s (SomeMessage st)
forall a. String -> Decoder s a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> String -> Word -> Int -> String
forall r. PrintfType r => String -> r
printf String
"codecTxSubmission (%s) unexpected key (%d, %d)" (SingTxSubmission ('StTxIds 'StNonBlocking) -> String
forall a. Show a => a -> String
show StateToken st
SingTxSubmission ('StTxIds 'StNonBlocking)
stok) Word
key Int
len)
        (SingTxSubmission st
SingTxs, Int
_, Word
_) ->
            String -> Decoder s (SomeMessage st)
forall a. String -> Decoder s a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> String -> Word -> Int -> String
forall r. PrintfType r => String -> r
printf String
"codecTxSubmission (%s) unexpected key (%d, %d)" (SingTxSubmission 'StTxs -> String
forall a. Show a => a -> String
show StateToken st
SingTxSubmission 'StTxs
stok) Word
key Int
len)
        (SingTxSubmission st
SingIdle, Int
_, Word
_) ->
            String -> Decoder s (SomeMessage st)
forall a. String -> Decoder s a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> String -> Word -> Int -> String
forall r. PrintfType r => String -> r
printf String
"codecTxSubmission (%s) unexpected key (%d, %d)" (SingTxSubmission 'StIdle -> String
forall a. Show a => a -> String
show StateToken st
SingTxSubmission 'StIdle
stok) Word
key Int
len)

codecTxSubmission2Id
  :: forall txid tx m. Monad m
  => Codec (TxSubmission2 txid tx) CodecFailure m (AnyMessage (TxSubmission2 txid tx))
codecTxSubmission2Id :: forall {k} {k1} (txid :: k) (tx :: k1) (m :: * -> *).
Monad m =>
Codec
  (TxSubmission2 txid tx)
  CodecFailure
  m
  (AnyMessage (TxSubmission2 txid tx))
codecTxSubmission2Id = Codec { Message (TxSubmission2 txid tx) st st'
-> AnyMessage (TxSubmission2 txid tx)
forall (st :: TxSubmission2 txid tx)
       (st' :: TxSubmission2 txid tx).
(ActiveState st, StateTokenI st) =>
Message (TxSubmission2 txid tx) st st'
-> AnyMessage (TxSubmission2 txid tx)
forall (st :: TxSubmission2 txid tx)
       (st' :: TxSubmission2 txid tx).
(StateTokenI st, ActiveState st) =>
Message (TxSubmission2 txid tx) st st'
-> AnyMessage (TxSubmission2 txid tx)
encode :: forall (st :: TxSubmission2 txid tx)
       (st' :: TxSubmission2 txid tx).
(ActiveState st, StateTokenI st) =>
Message (TxSubmission2 txid tx) st st'
-> AnyMessage (TxSubmission2 txid tx)
encode :: forall (st :: TxSubmission2 txid tx)
       (st' :: TxSubmission2 txid tx).
(StateTokenI st, ActiveState st) =>
Message (TxSubmission2 txid tx) st st'
-> AnyMessage (TxSubmission2 txid tx)
encode, StateToken st
-> m (DecodeStep
        (AnyMessage (TxSubmission2 txid tx))
        CodecFailure
        m
        (SomeMessage st))
forall (st :: TxSubmission2 txid tx).
ActiveState st =>
StateToken st
-> m (DecodeStep
        (AnyMessage (TxSubmission2 txid tx))
        CodecFailure
        m
        (SomeMessage st))
decode :: forall (st :: TxSubmission2 txid tx).
ActiveState st =>
StateToken st
-> m (DecodeStep
        (AnyMessage (TxSubmission2 txid tx))
        CodecFailure
        m
        (SomeMessage st))
decode :: forall (st :: TxSubmission2 txid tx).
ActiveState st =>
StateToken st
-> m (DecodeStep
        (AnyMessage (TxSubmission2 txid tx))
        CodecFailure
        m
        (SomeMessage st))
decode }
 where
  encode :: forall st st'.
            ActiveState st
         => StateTokenI st
         => Message (TxSubmission2 txid tx) st st'
         -> AnyMessage (TxSubmission2 txid tx)
  encode :: forall (st :: TxSubmission2 txid tx)
       (st' :: TxSubmission2 txid tx).
(ActiveState st, StateTokenI st) =>
Message (TxSubmission2 txid tx) st st'
-> AnyMessage (TxSubmission2 txid tx)
encode = Message (TxSubmission2 txid tx) st st'
-> AnyMessage (TxSubmission2 txid tx)
forall ps (st :: ps) (st' :: ps).
(StateTokenI st, ActiveState st) =>
Message ps st st' -> AnyMessage ps
AnyMessage

  decode :: forall (st :: TxSubmission2 txid tx).
            ActiveState st
         => StateToken st
         -> m (DecodeStep (AnyMessage (TxSubmission2 txid tx))
                          CodecFailure m (SomeMessage st))
  decode :: forall (st :: TxSubmission2 txid tx).
ActiveState st =>
StateToken st
-> m (DecodeStep
        (AnyMessage (TxSubmission2 txid tx))
        CodecFailure
        m
        (SomeMessage st))
decode StateToken st
stok = DecodeStep
  (AnyMessage (TxSubmission2 txid tx))
  CodecFailure
  m
  (SomeMessage st)
-> m (DecodeStep
        (AnyMessage (TxSubmission2 txid tx))
        CodecFailure
        m
        (SomeMessage st))
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (DecodeStep
   (AnyMessage (TxSubmission2 txid tx))
   CodecFailure
   m
   (SomeMessage st)
 -> m (DecodeStep
         (AnyMessage (TxSubmission2 txid tx))
         CodecFailure
         m
         (SomeMessage st)))
-> DecodeStep
     (AnyMessage (TxSubmission2 txid tx))
     CodecFailure
     m
     (SomeMessage st)
-> m (DecodeStep
        (AnyMessage (TxSubmission2 txid tx))
        CodecFailure
        m
        (SomeMessage st))
forall a b. (a -> b) -> a -> b
$ (Maybe (AnyMessage (TxSubmission2 txid tx))
 -> m (DecodeStep
         (AnyMessage (TxSubmission2 txid tx))
         CodecFailure
         m
         (SomeMessage st)))
-> DecodeStep
     (AnyMessage (TxSubmission2 txid tx))
     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 (TxSubmission2 txid tx))
  -> m (DecodeStep
          (AnyMessage (TxSubmission2 txid tx))
          CodecFailure
          m
          (SomeMessage st)))
 -> DecodeStep
      (AnyMessage (TxSubmission2 txid tx))
      CodecFailure
      m
      (SomeMessage st))
-> (Maybe (AnyMessage (TxSubmission2 txid tx))
    -> m (DecodeStep
            (AnyMessage (TxSubmission2 txid tx))
            CodecFailure
            m
            (SomeMessage st)))
-> DecodeStep
     (AnyMessage (TxSubmission2 txid tx))
     CodecFailure
     m
     (SomeMessage st)
forall a b. (a -> b) -> a -> b
$ \Maybe (AnyMessage (TxSubmission2 txid tx))
bytes -> DecodeStep
  (AnyMessage (TxSubmission2 txid tx))
  CodecFailure
  m
  (SomeMessage st)
-> m (DecodeStep
        (AnyMessage (TxSubmission2 txid tx))
        CodecFailure
        m
        (SomeMessage st))
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (DecodeStep
   (AnyMessage (TxSubmission2 txid tx))
   CodecFailure
   m
   (SomeMessage st)
 -> m (DecodeStep
         (AnyMessage (TxSubmission2 txid tx))
         CodecFailure
         m
         (SomeMessage st)))
-> DecodeStep
     (AnyMessage (TxSubmission2 txid tx))
     CodecFailure
     m
     (SomeMessage st)
-> m (DecodeStep
        (AnyMessage (TxSubmission2 txid tx))
        CodecFailure
        m
        (SomeMessage st))
forall a b. (a -> b) -> a -> b
$ case (StateToken st
SingTxSubmission st
stok, Maybe (AnyMessage (TxSubmission2 txid tx))
bytes) of
    (SingTxSubmission st
SingInit,      Just (AnyMessage msg :: Message (TxSubmission2 txid tx) st st'
msg@Message (TxSubmission2 txid tx) st st'
R:MessageTxSubmission2fromto k k1 txid tx st st'
MsgInit))              -> SomeMessage st
-> Maybe (AnyMessage (TxSubmission2 txid tx))
-> DecodeStep
     (AnyMessage (TxSubmission2 txid tx))
     CodecFailure
     m
     (SomeMessage st)
forall bytes failure (m :: * -> *) a.
a -> Maybe bytes -> DecodeStep bytes failure m a
DecodeDone (Message (TxSubmission2 txid tx) st st' -> SomeMessage st
forall ps (st :: ps) (st' :: ps).
(StateTokenI st, StateTokenI st', ActiveState st) =>
Message ps st st' -> SomeMessage st
SomeMessage Message (TxSubmission2 txid tx) st st'
Message (TxSubmission2 txid tx) st st'
msg) Maybe (AnyMessage (TxSubmission2 txid tx))
forall a. Maybe a
Nothing
    (SingTxSubmission st
SingIdle,      Just (AnyMessage msg :: Message (TxSubmission2 txid tx) st st'
msg@(MsgRequestTxIds SingBlockingStyle blocking
SingBlocking NumTxIdsToAck
_ NumTxIdsToReq
_)))    -> SomeMessage st
-> Maybe (AnyMessage (TxSubmission2 txid tx))
-> DecodeStep
     (AnyMessage (TxSubmission2 txid tx))
     CodecFailure
     m
     (SomeMessage st)
forall bytes failure (m :: * -> *) a.
a -> Maybe bytes -> DecodeStep bytes failure m a
DecodeDone (Message (TxSubmission2 txid tx) st st' -> SomeMessage st
forall ps (st :: ps) (st' :: ps).
(StateTokenI st, StateTokenI st', ActiveState st) =>
Message ps st st' -> SomeMessage st
SomeMessage Message (TxSubmission2 txid tx) st st'
Message (TxSubmission2 txid tx) st st'
msg) Maybe (AnyMessage (TxSubmission2 txid tx))
forall a. Maybe a
Nothing
    (SingTxSubmission st
SingIdle,      Just (AnyMessage msg :: Message (TxSubmission2 txid tx) st st'
msg@(MsgRequestTxIds SingBlockingStyle blocking
SingNonBlocking NumTxIdsToAck
_ NumTxIdsToReq
_))) -> SomeMessage st
-> Maybe (AnyMessage (TxSubmission2 txid tx))
-> DecodeStep
     (AnyMessage (TxSubmission2 txid tx))
     CodecFailure
     m
     (SomeMessage st)
forall bytes failure (m :: * -> *) a.
a -> Maybe bytes -> DecodeStep bytes failure m a
DecodeDone (Message (TxSubmission2 txid tx) st st' -> SomeMessage st
forall ps (st :: ps) (st' :: ps).
(StateTokenI st, StateTokenI st', ActiveState st) =>
Message ps st st' -> SomeMessage st
SomeMessage Message (TxSubmission2 txid tx) st st'
Message (TxSubmission2 txid tx) st st'
msg) Maybe (AnyMessage (TxSubmission2 txid tx))
forall a. Maybe a
Nothing
    (SingTxSubmission st
SingIdle,      Just (AnyMessage msg :: Message (TxSubmission2 txid tx) st st'
msg@(MsgRequestTxs {})))   -> SomeMessage st
-> Maybe (AnyMessage (TxSubmission2 txid tx))
-> DecodeStep
     (AnyMessage (TxSubmission2 txid tx))
     CodecFailure
     m
     (SomeMessage st)
forall bytes failure (m :: * -> *) a.
a -> Maybe bytes -> DecodeStep bytes failure m a
DecodeDone (Message (TxSubmission2 txid tx) st st' -> SomeMessage st
forall ps (st :: ps) (st' :: ps).
(StateTokenI st, StateTokenI st', ActiveState st) =>
Message ps st st' -> SomeMessage st
SomeMessage Message (TxSubmission2 txid tx) st st'
Message (TxSubmission2 txid tx) st st'
msg) Maybe (AnyMessage (TxSubmission2 txid tx))
forall a. Maybe a
Nothing
    (SingTxSubmission st
SingTxs,       Just (AnyMessage msg :: Message (TxSubmission2 txid tx) st st'
msg@(MsgReplyTxs {})))     -> SomeMessage st
-> Maybe (AnyMessage (TxSubmission2 txid tx))
-> DecodeStep
     (AnyMessage (TxSubmission2 txid tx))
     CodecFailure
     m
     (SomeMessage st)
forall bytes failure (m :: * -> *) a.
a -> Maybe bytes -> DecodeStep bytes failure m a
DecodeDone (Message (TxSubmission2 txid tx) st st' -> SomeMessage st
forall ps (st :: ps) (st' :: ps).
(StateTokenI st, StateTokenI st', ActiveState st) =>
Message ps st st' -> SomeMessage st
SomeMessage Message (TxSubmission2 txid tx) st st'
Message (TxSubmission2 txid tx) st st'
msg) Maybe (AnyMessage (TxSubmission2 txid tx))
forall a. Maybe a
Nothing
    (SingTxIds SingBlockingStyle stBlocking
b, Just (AnyMessage Message (TxSubmission2 txid tx) st st'
msg)) -> case (SingBlockingStyle stBlocking
b, Message (TxSubmission2 txid tx) st st'
msg) of
      (SingBlockingStyle stBlocking
SingBlocking,    MsgReplyTxIds (BlockingReply {}))    -> SomeMessage st
-> Maybe (AnyMessage (TxSubmission2 txid tx))
-> DecodeStep
     (AnyMessage (TxSubmission2 txid tx))
     CodecFailure
     m
     (SomeMessage st)
forall bytes failure (m :: * -> *) a.
a -> Maybe bytes -> DecodeStep bytes failure m a
DecodeDone (Message (TxSubmission2 txid tx) st st' -> SomeMessage st
forall ps (st :: ps) (st' :: ps).
(StateTokenI st, StateTokenI st', ActiveState st) =>
Message ps st st' -> SomeMessage st
SomeMessage Message (TxSubmission2 txid tx) st st'
Message (TxSubmission2 txid tx) st st'
msg) Maybe (AnyMessage (TxSubmission2 txid tx))
forall a. Maybe a
Nothing
      (SingBlockingStyle stBlocking
SingNonBlocking, MsgReplyTxIds (NonBlockingReply {})) -> SomeMessage st
-> Maybe (AnyMessage (TxSubmission2 txid tx))
-> DecodeStep
     (AnyMessage (TxSubmission2 txid tx))
     CodecFailure
     m
     (SomeMessage st)
forall bytes failure (m :: * -> *) a.
a -> Maybe bytes -> DecodeStep bytes failure m a
DecodeDone (Message (TxSubmission2 txid tx) st st' -> SomeMessage st
forall ps (st :: ps) (st' :: ps).
(StateTokenI st, StateTokenI st', ActiveState st) =>
Message ps st st' -> SomeMessage st
SomeMessage Message (TxSubmission2 txid tx) st st'
Message (TxSubmission2 txid tx) st st'
msg) Maybe (AnyMessage (TxSubmission2 txid tx))
forall a. Maybe a
Nothing
      (SingBlockingStyle stBlocking
SingBlocking,    MsgDone {})                          -> SomeMessage st
-> Maybe (AnyMessage (TxSubmission2 txid tx))
-> DecodeStep
     (AnyMessage (TxSubmission2 txid tx))
     CodecFailure
     m
     (SomeMessage st)
forall bytes failure (m :: * -> *) a.
a -> Maybe bytes -> DecodeStep bytes failure m a
DecodeDone (Message (TxSubmission2 txid tx) st st' -> SomeMessage st
forall ps (st :: ps) (st' :: ps).
(StateTokenI st, StateTokenI st', ActiveState st) =>
Message ps st st' -> SomeMessage st
SomeMessage Message (TxSubmission2 txid tx) st st'
Message (TxSubmission2 txid tx) st st'
msg) Maybe (AnyMessage (TxSubmission2 txid tx))
forall a. Maybe a
Nothing
      (SingBlockingStyle stBlocking
_, Message (TxSubmission2 txid tx) st st'
_) -> CodecFailure
-> DecodeStep
     (AnyMessage (TxSubmission2 txid tx))
     CodecFailure
     m
     (SomeMessage st)
forall bytes failure (m :: * -> *) a.
failure -> DecodeStep bytes failure m a
DecodeFail (String -> CodecFailure
CodecFailure String
"codecTxSubmissionId: no matching message")
    (SingTxSubmission st
SingDone, Maybe (AnyMessage (TxSubmission2 txid tx))
_) -> StateToken 'StDone -> forall a. a
forall ps (st :: ps).
(StateAgency st ~ 'NobodyAgency, ActiveState st) =>
StateToken st -> forall a. a
notActiveState StateToken st
StateToken 'StDone
stok
    (SingTxSubmission st
_, Maybe (AnyMessage (TxSubmission2 txid tx))
_) -> CodecFailure
-> DecodeStep
     (AnyMessage (TxSubmission2 txid tx))
     CodecFailure
     m
     (SomeMessage st)
forall bytes failure (m :: * -> *) a.
failure -> DecodeStep bytes failure m a
DecodeFail (String -> CodecFailure
CodecFailure String
"codecTxSubmissionId: no matching message")