{-# 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 tx1
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
tx1
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 reject1
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
reject1
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 {k} {k1} (tx :: k) (reject :: k1).
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 {k} {k1} (tx :: k) (reject :: k1).
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 {k} {k1} (tx :: k) (reject :: k1) (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"