{-# LANGUAGE DataKinds           #-}
{-# LANGUAGE FlexibleContexts    #-}
{-# 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 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.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 :: forall tx reject (m :: * -> *).
MonadST m =>
(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 (st :: LocalTxSubmission tx reject)
        (st' :: LocalTxSubmission tx reject).
 (StateTokenI st, ActiveState st) =>
 Message (LocalTxSubmission tx reject) st st' -> Encoding)
-> (forall (st :: LocalTxSubmission tx reject) s.
    ActiveState st =>
    StateToken st -> Decoder s (SomeMessage st))
-> Codec
     (LocalTxSubmission tx reject) 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 Message (LocalTxSubmission tx reject) st st' -> Encoding
forall (st :: LocalTxSubmission tx reject)
       (st' :: LocalTxSubmission tx reject).
Message (LocalTxSubmission tx reject) st st' -> Encoding
forall (st :: LocalTxSubmission tx reject)
       (st' :: LocalTxSubmission tx reject).
(StateTokenI st, ActiveState st) =>
Message (LocalTxSubmission tx reject) st st' -> Encoding
encode StateToken st -> Decoder s (SomeMessage st)
forall s (st :: LocalTxSubmission tx reject).
ActiveState st =>
StateToken st -> Decoder s (SomeMessage st)
forall (st :: LocalTxSubmission tx reject) s.
ActiveState st =>
StateToken st -> Decoder s (SomeMessage st)
decode
  where
    encode :: forall st st'.
              Message (LocalTxSubmission tx reject) st st'
           -> CBOR.Encoding
    encode :: forall (st :: LocalTxSubmission tx reject)
       (st' :: LocalTxSubmission tx reject).
Message (LocalTxSubmission tx reject) st st' -> Encoding
encode (MsgSubmitTx tx
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

    encode Message (LocalTxSubmission tx reject) st st'
R:MessageLocalTxSubmissionfromto 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 (MsgRejectTx reject
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

    encode Message (LocalTxSubmission tx reject) st st'
R:MessageLocalTxSubmissionfromto 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 s (st :: LocalTxSubmission tx reject).
              ActiveState st
           => StateToken st
           -> CBOR.Decoder s (SomeMessage st)
    decode :: forall s (st :: LocalTxSubmission tx reject).
ActiveState st =>
StateToken st -> Decoder s (SomeMessage st)
decode StateToken st
stok = do
      len <- Decoder s Int
forall s. Decoder s Int
CBOR.decodeListLen
      key <- CBOR.decodeWord
      case (stok, len, key) of
        (SingLocalTxSubmission st
SingIdle, Int
2, Word
0) -> do
          tx <- Decoder s tx
forall s. Decoder s tx
decodeTx
          return (SomeMessage (MsgSubmitTx tx))

        (SingLocalTxSubmission st
SingBusy, Int
1, Word
1) ->
          SomeMessage st -> Decoder s (SomeMessage st)
forall a. a -> Decoder s a
forall (m :: * -> *) a. Monad m => a -> m a
return (Message (LocalTxSubmission tx reject) st 'StIdle -> SomeMessage st
forall ps (st :: ps) (st' :: ps).
(StateTokenI st, StateTokenI st', ActiveState st) =>
Message ps st st' -> SomeMessage st
SomeMessage Message (LocalTxSubmission tx reject) st 'StIdle
Message (LocalTxSubmission tx reject) 'StBusy 'StIdle
forall tx reject.
Message (LocalTxSubmission tx reject) 'StBusy 'StIdle
MsgAcceptTx)

        (SingLocalTxSubmission st
SingBusy, Int
2, Word
2) -> do
          reject <- Decoder s reject
forall s. Decoder s reject
decodeReject
          return (SomeMessage (MsgRejectTx reject))

        (SingLocalTxSubmission st
SingIdle, Int
1, Word
3) ->
          SomeMessage st -> Decoder s (SomeMessage st)
forall a. a -> Decoder s a
forall (m :: * -> *) a. Monad m => a -> m a
return (Message (LocalTxSubmission tx reject) st 'StDone -> SomeMessage st
forall ps (st :: ps) (st' :: ps).
(StateTokenI st, StateTokenI st', ActiveState st) =>
Message ps st st' -> SomeMessage st
SomeMessage Message (LocalTxSubmission tx reject) st 'StDone
Message (LocalTxSubmission tx reject) 'StIdle 'StDone
forall tx reject.
Message (LocalTxSubmission tx reject) 'StIdle 'StDone
MsgDone)

        (SingLocalTxSubmission 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

        (SingLocalTxSubmission st
_, Int
_, Word
_) -> String -> Decoder s (SomeMessage st)
forall a. String -> Decoder s a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> String -> String -> Word -> Int -> String
forall r. PrintfType r => String -> r
printf String
"codecLocalTxSubmission (%s, %s) unexpected key (%d, %d)"
                                  (ActiveAgency' st (StateAgency st) -> String
forall a. Show a => a -> String
show (ActiveAgency' st (StateAgency st)
forall {ps} (st :: ps) (agency :: Agency).
IsActiveState st agency =>
ActiveAgency' st agency
activeAgency :: ActiveAgency st)) (SingLocalTxSubmission st -> String
forall a. Show a => a -> String
show StateToken st
SingLocalTxSubmission st
stok) Word
key Int
len)

codecLocalTxSubmissionId
  :: forall tx reject m.
     Monad m
  => Codec (LocalTxSubmission tx reject)
            CodecFailure m
           (AnyMessage (LocalTxSubmission tx reject))
codecLocalTxSubmissionId :: forall tx reject (m :: * -> *).
Monad m =>
Codec
  (LocalTxSubmission tx reject)
  CodecFailure
  m
  (AnyMessage (LocalTxSubmission tx reject))
codecLocalTxSubmissionId =
    (forall (st :: LocalTxSubmission tx reject)
        (st' :: LocalTxSubmission tx reject).
 (StateTokenI st, ActiveState st) =>
 Message (LocalTxSubmission tx reject) st st'
 -> AnyMessage (LocalTxSubmission tx reject))
-> (forall (st :: LocalTxSubmission tx reject).
    ActiveState st =>
    StateToken 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 (st :: ps) (st' :: ps).
 (StateTokenI st, ActiveState st) =>
 Message ps st st' -> bytes)
-> (forall (st :: ps).
    ActiveState st =>
    StateToken st -> m (DecodeStep bytes failure m (SomeMessage st)))
-> Codec ps failure m bytes
Codec Message (LocalTxSubmission tx reject) st st'
-> AnyMessage (LocalTxSubmission tx reject)
forall (st :: LocalTxSubmission tx reject)
       (st' :: LocalTxSubmission tx reject).
(ActiveState st, StateTokenI st) =>
Message (LocalTxSubmission tx reject) st st'
-> AnyMessage (LocalTxSubmission tx reject)
forall (st :: LocalTxSubmission tx reject)
       (st' :: LocalTxSubmission tx reject).
(StateTokenI st, ActiveState st) =>
Message (LocalTxSubmission tx reject) st st'
-> AnyMessage (LocalTxSubmission tx reject)
encode StateToken st
-> m (DecodeStep
        (AnyMessage (LocalTxSubmission tx reject))
        CodecFailure
        m
        (SomeMessage st))
forall (st :: LocalTxSubmission tx reject).
ActiveState st =>
StateToken st
-> m (DecodeStep
        (AnyMessage (LocalTxSubmission tx reject))
        CodecFailure
        m
        (SomeMessage st))
decode
  where
    encode :: forall st st'.
              ActiveState st
           => StateTokenI st
           => Message (LocalTxSubmission tx reject) st st'
           -> AnyMessage (LocalTxSubmission tx reject)
    encode :: forall (st :: LocalTxSubmission tx reject)
       (st' :: LocalTxSubmission tx reject).
(ActiveState st, StateTokenI st) =>
Message (LocalTxSubmission tx reject) st st'
-> AnyMessage (LocalTxSubmission tx reject)
encode = Message (LocalTxSubmission tx reject) st st'
-> AnyMessage (LocalTxSubmission tx reject)
forall ps (st :: ps) (st' :: ps).
(StateTokenI st, ActiveState st) =>
Message ps st st' -> AnyMessage ps
AnyMessage

    decode :: forall (st :: LocalTxSubmission tx reject).
              ActiveState st
           => StateToken st
           -> m (DecodeStep (AnyMessage (LocalTxSubmission tx reject))
                            CodecFailure m (SomeMessage st))
    decode :: forall (st :: LocalTxSubmission tx reject).
ActiveState st =>
StateToken st
-> m (DecodeStep
        (AnyMessage (LocalTxSubmission tx reject))
        CodecFailure
        m
        (SomeMessage st))
decode StateToken st
stok = DecodeStep
  (AnyMessage (LocalTxSubmission tx reject))
  CodecFailure
  m
  (SomeMessage st)
-> m (DecodeStep
        (AnyMessage (LocalTxSubmission tx reject))
        CodecFailure
        m
        (SomeMessage st))
forall a. a -> m a
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 (StateToken st
SingLocalTxSubmission st
stok, Maybe (AnyMessage (LocalTxSubmission tx reject))
bytes) of
      (SingLocalTxSubmission st
SingIdle, Just (AnyMessage msg :: Message (LocalTxSubmission tx reject) st st'
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, StateTokenI st, StateTokenI st',
 IsActiveState st (StateAgency st)) =>
Message ps st st'
-> m (DecodeStep bytes failure m (SomeMessage st))
res Message (LocalTxSubmission tx reject) st st'
Message (LocalTxSubmission tx reject) st st'
msg
      (SingLocalTxSubmission st
SingBusy, Just (AnyMessage msg :: Message (LocalTxSubmission tx reject) st st'
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, StateTokenI st, StateTokenI st',
 IsActiveState st (StateAgency st)) =>
Message ps st st'
-> m (DecodeStep bytes failure m (SomeMessage st))
res Message (LocalTxSubmission tx reject) st st'
Message (LocalTxSubmission tx reject) st st'
msg
      (SingLocalTxSubmission st
SingBusy, Just (AnyMessage msg :: Message (LocalTxSubmission tx reject) st st'
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, StateTokenI st, StateTokenI st',
 IsActiveState st (StateAgency st)) =>
Message ps st st'
-> m (DecodeStep bytes failure m (SomeMessage st))
res Message (LocalTxSubmission tx reject) st st'
Message (LocalTxSubmission tx reject) st st'
msg
      (SingLocalTxSubmission st
SingIdle, Just (AnyMessage msg :: Message (LocalTxSubmission tx reject) st st'
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, StateTokenI st, StateTokenI st',
 IsActiveState st (StateAgency st)) =>
Message ps st st'
-> m (DecodeStep bytes failure m (SomeMessage st))
res Message (LocalTxSubmission tx reject) st st'
Message (LocalTxSubmission tx reject) st st'
msg
      (SingLocalTxSubmission st
SingDone, Maybe (AnyMessage (LocalTxSubmission tx reject))
_)                                     -> 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
      (SingLocalTxSubmission 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 a. a -> m a
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)
      (SingLocalTxSubmission 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 a. a -> m a
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 a. a -> m a
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).
(StateTokenI st, StateTokenI st', ActiveState st) =>
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"