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

module Ouroboros.Network.Protocol.LocalTxSubmission.Codec
  ( codecLocalTxSubmission
  , codecLocalTxSubmissionId
  ) where

import           Control.Monad.Class.MonadST

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.Protocol.LocalTxSubmission.Type


codecLocalTxSubmission
  :: forall tx reject m.
     MonadST m
  => (tx -> CBOR.Encoding)
  -> (forall s . CBOR.Decoder s tx)
  -> (reject -> CBOR.Encoding)
  -> (forall s . CBOR.Decoder s reject)
  -> Codec (LocalTxSubmission tx reject) CBOR.DeserialiseFailure m ByteString
codecLocalTxSubmission :: (tx -> Encoding)
-> (forall s. Decoder s tx)
-> (reject -> Encoding)
-> (forall s. Decoder s reject)
-> Codec
     (LocalTxSubmission tx reject) DeserialiseFailure m ByteString
codecLocalTxSubmission tx -> Encoding
encodeTx forall s. Decoder s tx
decodeTx reject -> Encoding
encodeReject forall s. Decoder s reject
decodeReject =
    (forall (pr :: PeerRole) (st :: LocalTxSubmission tx reject)
        (st' :: LocalTxSubmission tx reject).
 PeerHasAgency pr st
 -> Message (LocalTxSubmission tx reject) st st' -> Encoding)
-> (forall (pr :: PeerRole) (st :: LocalTxSubmission tx reject) s.
    PeerHasAgency pr st -> Decoder s (SomeMessage st))
-> Codec
     (LocalTxSubmission tx reject) 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 :: LocalTxSubmission tx reject)
       (st' :: LocalTxSubmission tx reject).
PeerHasAgency pr st
-> Message (LocalTxSubmission tx reject) st st' -> Encoding
encode forall (pr :: PeerRole) s (st :: LocalTxSubmission tx reject).
PeerHasAgency pr st -> Decoder s (SomeMessage st)
forall (pr :: PeerRole) (st :: LocalTxSubmission tx reject) s.
PeerHasAgency pr st -> Decoder s (SomeMessage st)
decode
  where
    encode :: forall (pr :: PeerRole) st st'.
              PeerHasAgency pr st
           -> Message (LocalTxSubmission tx reject) st st'
           -> CBOR.Encoding
    encode :: PeerHasAgency pr st
-> Message (LocalTxSubmission tx reject) st st' -> Encoding
encode (ClientAgency ClientHasAgency st
TokIdle) (MsgSubmitTx tx) =
        Word -> Encoding
CBOR.encodeListLen Word
2
     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
<> tx -> Encoding
encodeTx tx
tx
tx

    encode (ServerAgency ServerHasAgency st
TokBusy) Message (LocalTxSubmission tx reject) st st'
MsgAcceptTx =
        Word -> Encoding
CBOR.encodeListLen Word
1
     Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Word -> Encoding
CBOR.encodeWord Word
1

    encode (ServerAgency ServerHasAgency st
TokBusy) (MsgRejectTx reject) =
        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
<> reject -> Encoding
encodeReject reject
reject
reject

    encode (ClientAgency ClientHasAgency st
TokIdle) Message (LocalTxSubmission tx reject) st st'
MsgDone =
        Word -> Encoding
CBOR.encodeListLen Word
1
     Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Word -> Encoding
CBOR.encodeWord Word
3


    decode :: forall (pr :: PeerRole) s (st :: LocalTxSubmission tx reject).
              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
2, Word
0) -> do
          tx
tx <- Decoder s tx
forall s. Decoder s tx
decodeTx
          SomeMessage 'StIdle -> Decoder s (SomeMessage 'StIdle)
forall (m :: * -> *) a. Monad m => a -> m a
return (Message (LocalTxSubmission tx reject) 'StIdle 'StBusy
-> SomeMessage 'StIdle
forall ps (st :: ps) (st' :: ps).
Message ps st st' -> SomeMessage st
SomeMessage (tx -> Message (LocalTxSubmission tx reject) 'StIdle 'StBusy
forall k tx (reject :: k).
tx -> Message (LocalTxSubmission tx reject) 'StIdle 'StBusy
MsgSubmitTx tx
tx))

        (ServerAgency ServerHasAgency st
TokBusy, Int
1, Word
1) ->
          SomeMessage 'StBusy -> Decoder s (SomeMessage 'StBusy)
forall (m :: * -> *) a. Monad m => a -> m a
return (Message (LocalTxSubmission tx reject) 'StBusy 'StIdle
-> SomeMessage 'StBusy
forall ps (st :: ps) (st' :: ps).
Message ps st st' -> SomeMessage st
SomeMessage Message (LocalTxSubmission tx reject) 'StBusy 'StIdle
forall k k (tx :: k) (reject :: k).
Message (LocalTxSubmission tx reject) 'StBusy 'StIdle
MsgAcceptTx)

        (ServerAgency ServerHasAgency st
TokBusy, Int
2, Word
2) -> do
          reject
reject <- Decoder s reject
forall s. Decoder s reject
decodeReject
          SomeMessage 'StBusy -> Decoder s (SomeMessage 'StBusy)
forall (m :: * -> *) a. Monad m => a -> m a
return (Message (LocalTxSubmission tx reject) 'StBusy 'StIdle
-> SomeMessage 'StBusy
forall ps (st :: ps) (st' :: ps).
Message ps st st' -> SomeMessage st
SomeMessage (reject -> Message (LocalTxSubmission tx reject) 'StBusy 'StIdle
forall k reject (tx :: k).
reject -> Message (LocalTxSubmission tx reject) 'StBusy 'StIdle
MsgRejectTx reject
reject))

        (ClientAgency ClientHasAgency st
TokIdle, Int
1, Word
3) ->
          SomeMessage 'StIdle -> Decoder s (SomeMessage 'StIdle)
forall (m :: * -> *) a. Monad m => a -> m a
return (Message (LocalTxSubmission tx reject) 'StIdle 'StDone
-> SomeMessage 'StIdle
forall ps (st :: ps) (st' :: ps).
Message ps st st' -> SomeMessage st
SomeMessage Message (LocalTxSubmission tx reject) 'StIdle 'StDone
forall k k (tx :: k) (reject :: k).
Message (LocalTxSubmission tx reject) 'StIdle 'StDone
MsgDone)

        (PeerHasAgency pr st, 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
"codecLocalTxSubmission (%s) unexpected key (%d, %d)" (PeerHasAgency pr st -> String
forall a. Show a => a -> String
show PeerHasAgency pr st
stok) Word
key Int
len)

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

    decode :: forall (pr :: PeerRole) (st :: LocalTxSubmission tx reject).
              PeerHasAgency pr st
           -> m (DecodeStep (AnyMessage (LocalTxSubmission tx reject))
                            CodecFailure m (SomeMessage st))
    decode :: PeerHasAgency pr st
-> m (DecodeStep
        (AnyMessage (LocalTxSubmission tx reject))
        CodecFailure
        m
        (SomeMessage st))
decode PeerHasAgency pr st
stok = DecodeStep
  (AnyMessage (LocalTxSubmission tx reject))
  CodecFailure
  m
  (SomeMessage st)
-> m (DecodeStep
        (AnyMessage (LocalTxSubmission tx reject))
        CodecFailure
        m
        (SomeMessage st))
forall (m :: * -> *) a. Monad m => a -> m a
return (DecodeStep
   (AnyMessage (LocalTxSubmission tx reject))
   CodecFailure
   m
   (SomeMessage st)
 -> m (DecodeStep
         (AnyMessage (LocalTxSubmission tx reject))
         CodecFailure
         m
         (SomeMessage st)))
-> DecodeStep
     (AnyMessage (LocalTxSubmission tx reject))
     CodecFailure
     m
     (SomeMessage st)
-> m (DecodeStep
        (AnyMessage (LocalTxSubmission tx reject))
        CodecFailure
        m
        (SomeMessage st))
forall a b. (a -> b) -> a -> b
$ (Maybe (AnyMessage (LocalTxSubmission tx reject))
 -> m (DecodeStep
         (AnyMessage (LocalTxSubmission tx reject))
         CodecFailure
         m
         (SomeMessage st)))
-> DecodeStep
     (AnyMessage (LocalTxSubmission tx reject))
     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 (LocalTxSubmission tx reject))
  -> m (DecodeStep
          (AnyMessage (LocalTxSubmission tx reject))
          CodecFailure
          m
          (SomeMessage st)))
 -> DecodeStep
      (AnyMessage (LocalTxSubmission tx reject))
      CodecFailure
      m
      (SomeMessage st))
-> (Maybe (AnyMessage (LocalTxSubmission tx reject))
    -> m (DecodeStep
            (AnyMessage (LocalTxSubmission tx reject))
            CodecFailure
            m
            (SomeMessage st)))
-> DecodeStep
     (AnyMessage (LocalTxSubmission tx reject))
     CodecFailure
     m
     (SomeMessage st)
forall a b. (a -> b) -> a -> b
$ \Maybe (AnyMessage (LocalTxSubmission tx reject))
bytes -> case (PeerHasAgency pr st
stok, Maybe (AnyMessage (LocalTxSubmission tx reject))
bytes) of
      (ClientAgency ClientHasAgency st
TokIdle, Just (AnyMessage msg@(MsgSubmitTx{}))) -> Message (LocalTxSubmission tx reject) st st'
-> m (DecodeStep
        (AnyMessage (LocalTxSubmission tx reject))
        CodecFailure
        m
        (SomeMessage st))
forall ps (m :: * -> *) (st :: ps) (st' :: ps) bytes failure
       (m :: * -> *).
Monad m =>
Message ps st st'
-> m (DecodeStep bytes failure m (SomeMessage st))
res Message (LocalTxSubmission tx reject) st st'
msg
      (ServerAgency ServerHasAgency st
TokBusy, Just (AnyMessage msg@(MsgAcceptTx{}))) -> Message (LocalTxSubmission tx reject) st st'
-> m (DecodeStep
        (AnyMessage (LocalTxSubmission tx reject))
        CodecFailure
        m
        (SomeMessage st))
forall ps (m :: * -> *) (st :: ps) (st' :: ps) bytes failure
       (m :: * -> *).
Monad m =>
Message ps st st'
-> m (DecodeStep bytes failure m (SomeMessage st))
res Message (LocalTxSubmission tx reject) st st'
msg
      (ServerAgency ServerHasAgency st
TokBusy, Just (AnyMessage msg@(MsgRejectTx{}))) -> Message (LocalTxSubmission tx reject) st st'
-> m (DecodeStep
        (AnyMessage (LocalTxSubmission tx reject))
        CodecFailure
        m
        (SomeMessage st))
forall ps (m :: * -> *) (st :: ps) (st' :: ps) bytes failure
       (m :: * -> *).
Monad m =>
Message ps st st'
-> m (DecodeStep bytes failure m (SomeMessage st))
res Message (LocalTxSubmission tx reject) st st'
msg
      (ClientAgency ClientHasAgency st
TokIdle, Just (AnyMessage msg@(MsgDone{})))     -> Message (LocalTxSubmission tx reject) st st'
-> m (DecodeStep
        (AnyMessage (LocalTxSubmission tx reject))
        CodecFailure
        m
        (SomeMessage st))
forall ps (m :: * -> *) (st :: ps) (st' :: ps) bytes failure
       (m :: * -> *).
Monad m =>
Message ps st st'
-> m (DecodeStep bytes failure m (SomeMessage st))
res Message (LocalTxSubmission tx reject) st st'
msg
      (PeerHasAgency pr st
_, Maybe (AnyMessage (LocalTxSubmission tx reject))
Nothing) -> DecodeStep
  (AnyMessage (LocalTxSubmission tx reject))
  CodecFailure
  m
  (SomeMessage st)
-> m (DecodeStep
        (AnyMessage (LocalTxSubmission tx reject))
        CodecFailure
        m
        (SomeMessage st))
forall (m :: * -> *) a. Monad m => a -> m a
return (CodecFailure
-> DecodeStep
     (AnyMessage (LocalTxSubmission tx reject))
     CodecFailure
     m
     (SomeMessage st)
forall bytes failure (m :: * -> *) a.
failure -> DecodeStep bytes failure m a
DecodeFail CodecFailure
CodecFailureOutOfInput)
      (PeerHasAgency pr st
_, Maybe (AnyMessage (LocalTxSubmission tx reject))
_)       -> DecodeStep
  (AnyMessage (LocalTxSubmission tx reject))
  CodecFailure
  m
  (SomeMessage st)
-> m (DecodeStep
        (AnyMessage (LocalTxSubmission tx reject))
        CodecFailure
        m
        (SomeMessage st))
forall (m :: * -> *) a. Monad m => a -> m a
return (CodecFailure
-> DecodeStep
     (AnyMessage (LocalTxSubmission tx reject))
     CodecFailure
     m
     (SomeMessage st)
forall bytes failure (m :: * -> *) a.
failure -> DecodeStep bytes failure m a
DecodeFail (String -> CodecFailure
CodecFailure String
failmsg))
    res :: Message ps st st'
-> m (DecodeStep bytes failure m (SomeMessage st))
res Message ps 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 ps st st' -> SomeMessage st
forall ps (st :: ps) (st' :: ps).
Message ps st st' -> SomeMessage st
SomeMessage Message ps st st'
msg) Maybe bytes
forall a. Maybe a
Nothing)
    failmsg :: String
failmsg = String
"codecLocalTxSubmissionId: no matching message"