{-# LANGUAGE DataKinds           #-}
{-# 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
import qualified Data.List.NonEmpty as NonEmpty

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

import           Network.TypedProtocol.Codec.CBOR

import           Ouroboros.Network.Driver.Limits
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 :: (bytes -> Word) -> ProtocolSizeLimits (TxSubmission2 txid tx) bytes
byteLimitsTxSubmission2 = (forall (pr :: PeerRole) (st :: TxSubmission2 txid tx).
 PeerHasAgency pr st -> Word)
-> (bytes -> Word)
-> ProtocolSizeLimits (TxSubmission2 txid tx) bytes
forall ps bytes.
(forall (pr :: PeerRole) (st :: ps). PeerHasAgency pr st -> Word)
-> (bytes -> Word) -> ProtocolSizeLimits ps bytes
ProtocolSizeLimits forall (pr :: PeerRole) (st :: TxSubmission2 txid tx).
PeerHasAgency pr st -> Word
stateToLimit
  where
    stateToLimit :: forall (pr :: PeerRole) (st :: TxSubmission2 txid tx).
                    PeerHasAgency pr st -> Word
    stateToLimit :: PeerHasAgency pr st -> Word
stateToLimit (ClientAgency ClientHasAgency st
TokInit)                   = Word
smallByteLimit
    stateToLimit (ClientAgency (TokTxIds TokBlocking))    = Word
largeByteLimit
    stateToLimit (ClientAgency (TokTxIds TokNonBlocking)) = Word
largeByteLimit
    stateToLimit (ClientAgency ClientHasAgency st
TokTxs)                    = Word
largeByteLimit
    stateToLimit (ServerAgency ServerHasAgency st
TokIdle)                   = Word
smallByteLimit


-- | Time Limits.
--
-- `TokTxIds TokBlocking` No timeout
-- `TokTxIds TokNonBlocking` `shortWait` timeout
-- `TokTxs` `shortWait` timeout
-- `TokIdle` `shortWait` timeout
timeLimitsTxSubmission2 :: forall txid tx. ProtocolTimeLimits (TxSubmission2 txid tx)
timeLimitsTxSubmission2 :: ProtocolTimeLimits (TxSubmission2 txid tx)
timeLimitsTxSubmission2 = (forall (pr :: PeerRole) (st :: TxSubmission2 txid tx).
 PeerHasAgency pr st -> Maybe DiffTime)
-> ProtocolTimeLimits (TxSubmission2 txid tx)
forall ps.
(forall (pr :: PeerRole) (st :: ps).
 PeerHasAgency pr st -> Maybe DiffTime)
-> ProtocolTimeLimits ps
ProtocolTimeLimits forall (pr :: PeerRole) (st :: TxSubmission2 txid tx).
PeerHasAgency pr st -> Maybe DiffTime
stateToLimit
  where
    stateToLimit :: forall (pr :: PeerRole) (st :: TxSubmission2 txid tx).
                    PeerHasAgency pr st -> Maybe DiffTime
    stateToLimit :: PeerHasAgency pr st -> Maybe DiffTime
stateToLimit (ClientAgency ClientHasAgency st
TokInit)                   = Maybe DiffTime
waitForever
    stateToLimit (ClientAgency (TokTxIds TokBlocking))    = Maybe DiffTime
waitForever
    stateToLimit (ClientAgency (TokTxIds TokNonBlocking)) = Maybe DiffTime
shortWait
    stateToLimit (ClientAgency ClientHasAgency st
TokTxs)                    = Maybe DiffTime
shortWait
    stateToLimit (ServerAgency ServerHasAgency st
TokIdle)                   = Maybe DiffTime
waitForever


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 :: (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 (pr :: PeerRole) (st :: TxSubmission2 txid tx)
        (st' :: TxSubmission2 txid tx).
 PeerHasAgency pr st
 -> Message (TxSubmission2 txid tx) st st' -> Encoding)
-> (forall (pr :: PeerRole) (st :: TxSubmission2 txid tx) s.
    PeerHasAgency pr st -> Decoder s (SomeMessage st))
-> Codec (TxSubmission2 txid tx) 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
      ((txid -> Encoding)
-> (tx -> Encoding)
-> forall (pr :: PeerRole) (st :: TxSubmission2 txid tx)
          (st' :: TxSubmission2 txid tx).
   PeerHasAgency pr st
   -> Message (TxSubmission2 txid tx) st st' -> Encoding
forall txid tx.
(txid -> Encoding)
-> (tx -> Encoding)
-> forall (pr :: PeerRole) (st :: TxSubmission2 txid tx)
          (st' :: TxSubmission2 txid tx).
   PeerHasAgency pr st
   -> Message (TxSubmission2 txid tx) st st' -> Encoding
encodeTxSubmission2 txid -> Encoding
encodeTxId tx -> Encoding
encodeTx)
      forall (pr :: PeerRole) (st :: TxSubmission2 txid tx).
PeerHasAgency pr st -> forall s. Decoder s (SomeMessage st)
forall (pr :: PeerRole) (st :: TxSubmission2 txid tx) s.
PeerHasAgency pr st -> Decoder s (SomeMessage st)
decode
  where
    decode :: forall (pr :: PeerRole) (st :: TxSubmission2 txid tx).
              PeerHasAgency pr st
           -> forall s. CBOR.Decoder s (SomeMessage st)
    decode :: PeerHasAgency pr st -> forall s. 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
      (forall s. Decoder s txid)
-> (forall s. Decoder s tx)
-> PeerHasAgency pr st
-> Int
-> Word
-> Decoder s (SomeMessage st)
forall txid tx.
(forall s. Decoder s txid)
-> (forall s. Decoder s tx)
-> forall (pr :: PeerRole) (st :: TxSubmission2 txid tx) s.
   PeerHasAgency pr st -> Int -> Word -> Decoder s (SomeMessage st)
decodeTxSubmission2 forall s. Decoder s txid
decodeTxId forall s. Decoder s tx
decodeTx PeerHasAgency pr st
stok Int
len Word
key

encodeTxSubmission2
    :: forall txid tx.
       (txid -> CBOR.Encoding)
    -> (tx -> CBOR.Encoding)
    -> (forall (pr :: PeerRole) (st :: TxSubmission2 txid tx) (st' :: TxSubmission2 txid tx).
               PeerHasAgency pr st
            -> Message (TxSubmission2 txid tx) st st'
            -> CBOR.Encoding)
encodeTxSubmission2 :: (txid -> Encoding)
-> (tx -> Encoding)
-> forall (pr :: PeerRole) (st :: TxSubmission2 txid tx)
          (st' :: TxSubmission2 txid tx).
   PeerHasAgency pr st
   -> Message (TxSubmission2 txid tx) st st' -> Encoding
encodeTxSubmission2 txid -> Encoding
encodeTxId tx -> Encoding
encodeTx = PeerHasAgency pr st
-> Message (TxSubmission2 txid tx) st st' -> Encoding
forall (pr :: PeerRole) (st :: TxSubmission2 txid tx)
       (st' :: TxSubmission2 txid tx).
PeerHasAgency pr st
-> Message (TxSubmission2 txid tx) st st' -> Encoding
encode
  where
    encode :: forall (pr :: PeerRole) st st'.
              PeerHasAgency pr st
           -> Message (TxSubmission2 txid tx) st st'
           -> CBOR.Encoding
    encode :: PeerHasAgency pr st
-> Message (TxSubmission2 txid tx) st st' -> Encoding
encode (ClientAgency ClientHasAgency st
TokInit)  Message (TxSubmission2 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 (ServerAgency ServerHasAgency st
TokIdle) (MsgRequestTxIds blocking ackNo 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 TokBlockingStyle blocking
blocking of
                           TokBlockingStyle blocking
TokBlocking    -> Bool
True
                           TokBlockingStyle blocking
TokNonBlocking -> 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 (ClientAgency (TokTxIds _)) (MsgReplyTxIds 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, Word32) -> Encoding -> Encoding)
-> Encoding -> [(txid, Word32)] -> Encoding
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\(txid
txid, 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, Word32)]
txids'
      where
        txids' :: [(txid, TxSizeInBytes)]
        txids' :: [(txid, Word32)]
txids' = case BlockingReplyList blocking (txid, Word32)
txids of
                   BlockingReply    NonEmpty (txid, Word32)
xs -> NonEmpty (txid, Word32) -> [(txid, Word32)]
forall a. NonEmpty a -> [a]
NonEmpty.toList NonEmpty (txid, Word32)
xs
                   NonBlockingReply [(txid, Word32)]
xs -> [(txid, Word32)]
[(txid, Word32)]
xs

    encode (ServerAgency ServerHasAgency st
TokIdle) (MsgRequestTxs 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 (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]
[txid]
txids

    encode (ClientAgency ClientHasAgency st
TokTxs)  (MsgReplyTxs 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 (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]
[tx]
txs

    encode (ClientAgency (TokTxIds TokBlocking)) Message (TxSubmission2 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 (pr :: PeerRole) (st :: TxSubmission2 txid tx) s.
               PeerHasAgency pr st
            -> Int
            -> Word
            -> CBOR.Decoder s (SomeMessage st))
decodeTxSubmission2 :: (forall s. Decoder s txid)
-> (forall s. Decoder s tx)
-> forall (pr :: PeerRole) (st :: TxSubmission2 txid tx) s.
   PeerHasAgency pr st -> Int -> Word -> Decoder s (SomeMessage st)
decodeTxSubmission2 forall s. Decoder s txid
decodeTxId forall s. Decoder s tx
decodeTx = PeerHasAgency pr st -> Int -> Word -> Decoder s (SomeMessage st)
forall (pr :: PeerRole) s (st :: TxSubmission2 txid tx).
PeerHasAgency pr st -> Int -> Word -> Decoder s (SomeMessage st)
decode
  where
    decode :: forall (pr :: PeerRole) s (st :: TxSubmission2 txid tx).
              PeerHasAgency pr st
           -> Int
           -> Word
           -> CBOR.Decoder s (SomeMessage st)
    decode :: PeerHasAgency pr st -> Int -> Word -> Decoder s (SomeMessage st)
decode PeerHasAgency pr st
stok Int
len Word
key = do
      case (PeerHasAgency pr st
stok, Int
len, Word
key) of
        (ClientAgency ClientHasAgency st
TokInit,       Int
1, Word
6) ->
          SomeMessage 'StInit -> Decoder s (SomeMessage 'StInit)
forall (m :: * -> *) a. Monad m => a -> m a
return (Message (TxSubmission2 txid tx) 'StInit 'StIdle
-> SomeMessage 'StInit
forall ps (st :: ps) (st' :: ps).
Message ps st st' -> SomeMessage st
SomeMessage Message (TxSubmission2 txid tx) 'StInit 'StIdle
forall k k (txid :: k) (tx :: k).
Message (TxSubmission2 txid tx) 'StInit 'StIdle
MsgInit)
        (ServerAgency ServerHasAgency st
TokIdle,       Int
4, Word
0) -> do
          Bool
blocking <- Decoder s Bool
forall s. Decoder s Bool
CBOR.decodeBool
          Word16
ackNo    <- Decoder s Word16
forall s. Decoder s Word16
CBOR.decodeWord16
          Word16
reqNo    <- Decoder s Word16
forall s. Decoder s Word16
CBOR.decodeWord16
          SomeMessage 'StIdle -> Decoder s (SomeMessage 'StIdle)
forall (m :: * -> *) a. Monad m => a -> m a
return (SomeMessage 'StIdle -> Decoder s (SomeMessage 'StIdle))
-> SomeMessage 'StIdle -> Decoder s (SomeMessage 'StIdle)
forall a b. (a -> b) -> a -> b
$! case Bool
blocking of
            Bool
True  -> Message (TxSubmission2 txid tx) 'StIdle ('StTxIds 'StBlocking)
-> SomeMessage 'StIdle
forall ps (st :: ps) (st' :: ps).
Message ps st st' -> SomeMessage st
SomeMessage (TokBlockingStyle 'StBlocking
-> Word16
-> Word16
-> Message (TxSubmission2 txid tx) 'StIdle ('StTxIds 'StBlocking)
forall k k (blocking :: StBlockingStyle) (txid :: k) (tx :: k).
TokBlockingStyle blocking
-> Word16
-> Word16
-> Message (TxSubmission2 txid tx) 'StIdle ('StTxIds blocking)
MsgRequestTxIds TokBlockingStyle 'StBlocking
TokBlocking    Word16
ackNo Word16
reqNo)
            Bool
False -> Message (TxSubmission2 txid tx) 'StIdle ('StTxIds 'StNonBlocking)
-> SomeMessage 'StIdle
forall ps (st :: ps) (st' :: ps).
Message ps st st' -> SomeMessage st
SomeMessage (TokBlockingStyle 'StNonBlocking
-> Word16
-> Word16
-> Message
     (TxSubmission2 txid tx) 'StIdle ('StTxIds 'StNonBlocking)
forall k k (blocking :: StBlockingStyle) (txid :: k) (tx :: k).
TokBlockingStyle blocking
-> Word16
-> Word16
-> Message (TxSubmission2 txid tx) 'StIdle ('StTxIds blocking)
MsgRequestTxIds TokBlockingStyle 'StNonBlocking
TokNonBlocking Word16
ackNo Word16
reqNo)

        (ClientAgency (TokTxIds b),  Int
2, Word
1) -> do
          Decoder s ()
forall s. Decoder s ()
CBOR.decodeListLenIndef
          [(txid, Word32)]
txids <- ([(txid, Word32)] -> (txid, Word32) -> [(txid, Word32)])
-> [(txid, Word32)]
-> ([(txid, Word32)] -> [(txid, Word32)])
-> Decoder s (txid, Word32)
-> Decoder s [(txid, Word32)]
forall r a r' s.
(r -> a -> r) -> r -> (r -> r') -> Decoder s a -> Decoder s r'
CBOR.decodeSequenceLenIndef
                     (((txid, Word32) -> [(txid, Word32)] -> [(txid, Word32)])
-> [(txid, Word32)] -> (txid, Word32) -> [(txid, Word32)]
forall a b c. (a -> b -> c) -> b -> a -> c
flip (:)) [] [(txid, Word32)] -> [(txid, Word32)]
forall a. [a] -> [a]
reverse
                     (do Int -> Decoder s ()
forall s. Int -> Decoder s ()
CBOR.decodeListLenOf Int
2
                         txid
txid <- Decoder s txid
forall s. Decoder s txid
decodeTxId
                         Word32
sz   <- Decoder s Word32
forall s. Decoder s Word32
CBOR.decodeWord32
                         (txid, Word32) -> Decoder s (txid, Word32)
forall (m :: * -> *) a. Monad m => a -> m a
return (txid
txid, Word32
sz))
          case (TokBlockingStyle b
b, [(txid, Word32)]
txids) of
            (TokBlockingStyle b
TokBlocking, (txid, Word32)
t:[(txid, Word32)]
ts) ->
              SomeMessage ('StTxIds 'StBlocking)
-> Decoder s (SomeMessage ('StTxIds 'StBlocking))
forall (m :: * -> *) a. Monad m => a -> m a
return (SomeMessage ('StTxIds 'StBlocking)
 -> Decoder s (SomeMessage ('StTxIds 'StBlocking)))
-> SomeMessage ('StTxIds 'StBlocking)
-> Decoder s (SomeMessage ('StTxIds 'StBlocking))
forall a b. (a -> b) -> a -> b
$
                Message (TxSubmission2 txid tx) ('StTxIds 'StBlocking) 'StIdle
-> SomeMessage ('StTxIds 'StBlocking)
forall ps (st :: ps) (st' :: ps).
Message ps st st' -> SomeMessage st
SomeMessage (BlockingReplyList 'StBlocking (txid, Word32)
-> Message (TxSubmission2 txid tx) ('StTxIds 'StBlocking) 'StIdle
forall k (blocking :: StBlockingStyle) txid (tx :: k).
BlockingReplyList blocking (txid, Word32)
-> Message (TxSubmission2 txid tx) ('StTxIds blocking) 'StIdle
MsgReplyTxIds (NonEmpty (txid, Word32)
-> BlockingReplyList 'StBlocking (txid, Word32)
forall a. NonEmpty a -> BlockingReplyList 'StBlocking a
BlockingReply ((txid, Word32)
t (txid, Word32) -> [(txid, Word32)] -> NonEmpty (txid, Word32)
forall a. a -> [a] -> NonEmpty a
NonEmpty.:| [(txid, Word32)]
ts)))

            (TokBlockingStyle b
TokNonBlocking, [(txid, Word32)]
ts) ->
              SomeMessage ('StTxIds 'StNonBlocking)
-> Decoder s (SomeMessage ('StTxIds 'StNonBlocking))
forall (m :: * -> *) a. Monad m => a -> m a
return (SomeMessage ('StTxIds 'StNonBlocking)
 -> Decoder s (SomeMessage ('StTxIds 'StNonBlocking)))
-> SomeMessage ('StTxIds 'StNonBlocking)
-> Decoder s (SomeMessage ('StTxIds 'StNonBlocking))
forall a b. (a -> b) -> a -> b
$
                Message (TxSubmission2 txid tx) ('StTxIds 'StNonBlocking) 'StIdle
-> SomeMessage ('StTxIds 'StNonBlocking)
forall ps (st :: ps) (st' :: ps).
Message ps st st' -> SomeMessage st
SomeMessage (BlockingReplyList 'StNonBlocking (txid, Word32)
-> Message
     (TxSubmission2 txid tx) ('StTxIds 'StNonBlocking) 'StIdle
forall k (blocking :: StBlockingStyle) txid (tx :: k).
BlockingReplyList blocking (txid, Word32)
-> Message (TxSubmission2 txid tx) ('StTxIds blocking) 'StIdle
MsgReplyTxIds ([(txid, Word32)] -> BlockingReplyList 'StNonBlocking (txid, Word32)
forall a. [a] -> BlockingReplyList 'StNonBlocking a
NonBlockingReply [(txid, Word32)]
ts))

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


        (ServerAgency ServerHasAgency st
TokIdle,       Int
2, Word
2) -> do
          Decoder s ()
forall s. Decoder s ()
CBOR.decodeListLenIndef
          [txid]
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
          SomeMessage 'StIdle -> Decoder s (SomeMessage 'StIdle)
forall (m :: * -> *) a. Monad m => a -> m a
return (Message (TxSubmission2 txid tx) 'StIdle 'StTxs
-> SomeMessage 'StIdle
forall ps (st :: ps) (st' :: ps).
Message ps st st' -> SomeMessage st
SomeMessage ([txid] -> Message (TxSubmission2 txid tx) 'StIdle 'StTxs
forall k txid (tx :: k).
[txid] -> Message (TxSubmission2 txid tx) 'StIdle 'StTxs
MsgRequestTxs [txid]
txids))

        (ClientAgency ClientHasAgency st
TokTxs,     Int
2, Word
3) -> do
          Decoder s ()
forall s. Decoder s ()
CBOR.decodeListLenIndef
          [tx]
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
          SomeMessage 'StTxs -> Decoder s (SomeMessage 'StTxs)
forall (m :: * -> *) a. Monad m => a -> m a
return (Message (TxSubmission2 txid tx) 'StTxs 'StIdle
-> SomeMessage 'StTxs
forall ps (st :: ps) (st' :: ps).
Message ps st st' -> SomeMessage st
SomeMessage ([tx] -> Message (TxSubmission2 txid tx) 'StTxs 'StIdle
forall k tx (txid :: k).
[tx] -> Message (TxSubmission2 txid tx) 'StTxs 'StIdle
MsgReplyTxs [tx]
txids))

        (ClientAgency (TokTxIds TokBlocking), Int
1, Word
4) ->
          SomeMessage ('StTxIds 'StBlocking)
-> Decoder s (SomeMessage ('StTxIds 'StBlocking))
forall (m :: * -> *) a. Monad m => a -> m a
return (Message (TxSubmission2 txid tx) ('StTxIds 'StBlocking) 'StDone
-> SomeMessage ('StTxIds 'StBlocking)
forall ps (st :: ps) (st' :: ps).
Message ps st st' -> SomeMessage st
SomeMessage Message (TxSubmission2 txid tx) ('StTxIds 'StBlocking) 'StDone
forall k k (txid :: k) (tx :: k).
Message (TxSubmission2 txid tx) ('StTxIds 'StBlocking) 'StDone
MsgDone)

        --
        -- failures per protocol state
        --

        (ClientAgency ClientHasAgency st
TokInit, 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
"codecTxSubmission (%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 (TokTxIds TokBlocking), 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
"codecTxSubmission (%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 (TokTxIds TokNonBlocking), 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
"codecTxSubmission (%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
TokTxs, 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
"codecTxSubmission (%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
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
"codecTxSubmission (%s) unexpected key (%d, %d)" (PeerHasAgency pr st -> String
forall a. Show a => a -> String
show PeerHasAgency pr st
stok) Word
key Int
len)

codecTxSubmission2Id
  :: forall txid tx m. Monad m
  => Codec (TxSubmission2 txid tx) CodecFailure m (AnyMessage (TxSubmission2 txid tx))
codecTxSubmission2Id :: Codec
  (TxSubmission2 txid tx)
  CodecFailure
  m
  (AnyMessage (TxSubmission2 txid tx))
codecTxSubmission2Id = (forall (pr :: PeerRole) (st :: TxSubmission2 txid tx)
        (st' :: TxSubmission2 txid tx).
 PeerHasAgency pr st
 -> Message (TxSubmission2 txid tx) st st'
 -> AnyMessage (TxSubmission2 txid tx))
-> (forall (pr :: PeerRole) (st :: TxSubmission2 txid tx).
    PeerHasAgency pr st
    -> m (DecodeStep
            (AnyMessage (TxSubmission2 txid tx))
            CodecFailure
            m
            (SomeMessage st)))
-> Codec
     (TxSubmission2 txid tx)
     CodecFailure
     m
     (AnyMessage (TxSubmission2 txid tx))
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 :: TxSubmission2 txid tx)
       (st' :: TxSubmission2 txid tx).
PeerHasAgency pr st
-> Message (TxSubmission2 txid tx) st st'
-> AnyMessage (TxSubmission2 txid tx)
encode forall (pr :: PeerRole) (st :: TxSubmission2 txid tx).
PeerHasAgency pr st
-> m (DecodeStep
        (AnyMessage (TxSubmission2 txid tx))
        CodecFailure
        m
        (SomeMessage st))
decode
 where
  encode :: forall (pr :: PeerRole) st st'.
            PeerHasAgency pr st
         -> Message (TxSubmission2 txid tx) st st'
         -> AnyMessage (TxSubmission2 txid tx)
  encode :: PeerHasAgency pr st
-> Message (TxSubmission2 txid tx) st st'
-> AnyMessage (TxSubmission2 txid tx)
encode PeerHasAgency pr st
_ = Message (TxSubmission2 txid tx) st st'
-> AnyMessage (TxSubmission2 txid tx)
forall ps (st :: ps) (st' :: ps).
Message ps st st' -> AnyMessage ps
AnyMessage

  decode :: forall (pr :: PeerRole) (st :: TxSubmission2 txid tx).
            PeerHasAgency pr st
         -> m (DecodeStep (AnyMessage (TxSubmission2 txid tx))
                          CodecFailure m (SomeMessage st))
  decode :: PeerHasAgency pr st
-> m (DecodeStep
        (AnyMessage (TxSubmission2 txid tx))
        CodecFailure
        m
        (SomeMessage st))
decode PeerHasAgency pr st
stok = DecodeStep
  (AnyMessage (TxSubmission2 txid tx))
  CodecFailure
  m
  (SomeMessage st)
-> m (DecodeStep
        (AnyMessage (TxSubmission2 txid tx))
        CodecFailure
        m
        (SomeMessage st))
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 (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 (PeerHasAgency pr st
stok, Maybe (AnyMessage (TxSubmission2 txid tx))
bytes) of
    (ClientAgency ClientHasAgency st
TokInit,      Just (AnyMessage msg@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).
Message ps st st' -> SomeMessage st
SomeMessage Message (TxSubmission2 txid tx) st st'
msg) Maybe (AnyMessage (TxSubmission2 txid tx))
forall a. Maybe a
Nothing
    (ServerAgency ServerHasAgency st
TokIdle,      Just (AnyMessage msg@(MsgRequestTxIds {}))) -> 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).
Message ps st st' -> SomeMessage st
SomeMessage Message (TxSubmission2 txid tx) st st'
msg) Maybe (AnyMessage (TxSubmission2 txid tx))
forall a. Maybe a
Nothing
    (ServerAgency ServerHasAgency st
TokIdle,      Just (AnyMessage 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).
Message ps st st' -> SomeMessage st
SomeMessage Message (TxSubmission2 txid tx) st st'
msg) Maybe (AnyMessage (TxSubmission2 txid tx))
forall a. Maybe a
Nothing
    (ClientAgency ClientHasAgency st
TokTxs,       Just (AnyMessage 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).
Message ps st st' -> SomeMessage st
SomeMessage Message (TxSubmission2 txid tx) st st'
msg) Maybe (AnyMessage (TxSubmission2 txid tx))
forall a. Maybe a
Nothing
    (ClientAgency (TokTxIds b), Just (AnyMessage msg)) -> case (TokBlockingStyle b
b, Message (TxSubmission2 txid tx) st st'
msg) of
      (TokBlockingStyle b
TokBlocking,    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).
Message ps st st' -> SomeMessage st
SomeMessage Message (TxSubmission2 txid tx) st st'
msg) Maybe (AnyMessage (TxSubmission2 txid tx))
forall a. Maybe a
Nothing
      (TokBlockingStyle b
TokNonBlocking, 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).
Message ps st st' -> SomeMessage st
SomeMessage Message (TxSubmission2 txid tx) st st'
msg) Maybe (AnyMessage (TxSubmission2 txid tx))
forall a. Maybe a
Nothing
      (TokBlockingStyle b
TokBlocking,    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).
Message ps st st' -> SomeMessage st
SomeMessage Message (TxSubmission2 txid tx) st st'
msg) Maybe (AnyMessage (TxSubmission2 txid tx))
forall a. Maybe a
Nothing
      (TokBlockingStyle b
_, Message (TxSubmission2 txid tx) st st'
_) -> CodecFailure
-> DecodeStep
     (AnyMessage (TxSubmission2 txid tx))
     CodecFailure
     m
     (SomeMessage ('StTxIds b))
forall bytes failure (m :: * -> *) a.
failure -> DecodeStep bytes failure m a
DecodeFail (String -> CodecFailure
CodecFailure String
"codecTxSubmissionId: no matching message")
    (PeerHasAgency pr 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")