{-# LANGUAGE PolyKinds  #-}
{-# LANGUAGE RankNTypes #-}

-- | The codec for the local message submission miniprotocol
--
module DMQ.Protocol.LocalMsgSubmission.Codec where

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

import Cardano.KESAgent.KES.Crypto (Crypto (..))

import DMQ.Protocol.LocalMsgSubmission.Type
import DMQ.Protocol.SigSubmission.Codec qualified as SigSubmission
import DMQ.Protocol.SigSubmission.Type (Sig (..))

import Network.TypedProtocol.Codec.CBOR
import Ouroboros.Network.Protocol.LocalTxSubmission.Codec qualified as LTX

codecLocalMsgSubmission
  :: forall crypto m.
     ( MonadST m
     , Crypto crypto
     )
  => (SigMempoolFail -> CBOR.Encoding)
  -> (forall s. CBOR.Decoder s SigMempoolFail)
  -> AnnotatedCodec (LocalMsgSubmission (Sig crypto)) CBOR.DeserialiseFailure m ByteString
codecLocalMsgSubmission :: forall crypto (m :: * -> *).
(MonadST m, Crypto crypto) =>
(SigMempoolFail -> Encoding)
-> (forall s. Decoder s SigMempoolFail)
-> AnnotatedCodec
     (LocalMsgSubmission (Sig crypto)) DeserialiseFailure m ByteString
codecLocalMsgSubmission =
  (ByteString -> SigRawWithSignedBytes crypto -> Sig crypto)
-> (Sig crypto -> Encoding)
-> (forall s.
    Decoder s (ByteString -> SigRawWithSignedBytes crypto))
-> (SigMempoolFail -> Encoding)
-> (forall s. Decoder s SigMempoolFail)
-> AnnotatedCodec
     (LocalTxSubmission (Sig crypto) SigMempoolFail)
     DeserialiseFailure
     m
     ByteString
forall tx reject txWithBytes (m :: * -> *).
MonadST m =>
(ByteString -> tx -> txWithBytes)
-> (txWithBytes -> Encoding)
-> (forall s. Decoder s (ByteString -> tx))
-> (reject -> Encoding)
-> (forall s. Decoder s reject)
-> AnnotatedCodec
     (LocalTxSubmission txWithBytes reject)
     DeserialiseFailure
     m
     ByteString
LTX.anncodecLocalTxSubmission' ByteString -> SigRawWithSignedBytes crypto -> Sig crypto
forall crypto.
ByteString -> SigRawWithSignedBytes crypto -> Sig crypto
SigWithBytes Sig crypto -> Encoding
forall crypto. Sig crypto -> Encoding
SigSubmission.encodeSig Decoder s (ByteString -> SigRawWithSignedBytes crypto)
forall s. Decoder s (ByteString -> SigRawWithSignedBytes crypto)
forall crypto s.
Crypto crypto =>
Decoder s (ByteString -> SigRawWithSignedBytes crypto)
SigSubmission.decodeSig

encodeReject :: SigMempoolFail -> CBOR.Encoding
encodeReject :: SigMempoolFail -> Encoding
encodeReject = \case
  SigInvalid Text
reason -> 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
<> Text -> Encoding
CBOR.encodeString Text
reason
  SigMempoolFail
SigDuplicate      -> Word -> Encoding
CBOR.encodeListLen Word
1 Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Word -> Encoding
CBOR.encodeWord Word
1
  SigMempoolFail
SigExpired        -> Word -> Encoding
CBOR.encodeListLen Word
1 Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Word -> Encoding
CBOR.encodeWord Word
2
  SigResultOther Text
reason
                    -> 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
<> Text -> Encoding
CBOR.encodeString Text
reason

decodeReject :: CBOR.Decoder s SigMempoolFail
decodeReject :: forall s. Decoder s SigMempoolFail
decodeReject = do
  len <- Decoder s Int
forall s. Decoder s Int
CBOR.decodeListLen
  tag <- CBOR.decodeWord
  case (tag, len) of
    (Word
0, Int
2)     -> Text -> SigMempoolFail
SigInvalid (Text -> SigMempoolFail)
-> Decoder s Text -> Decoder s SigMempoolFail
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s Text
forall s. Decoder s Text
CBOR.decodeString
    (Word
1, Int
1)     -> SigMempoolFail -> Decoder s SigMempoolFail
forall a. a -> Decoder s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure SigMempoolFail
SigDuplicate
    (Word
2, Int
1)     -> SigMempoolFail -> Decoder s SigMempoolFail
forall a. a -> Decoder s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure SigMempoolFail
SigExpired
    (Word
3, Int
2)     -> Text -> SigMempoolFail
SigResultOther (Text -> SigMempoolFail)
-> Decoder s Text -> Decoder s SigMempoolFail
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s Text
forall s. Decoder s Text
CBOR.decodeString
    (Word, Int)
_otherwise -> String -> Decoder s SigMempoolFail
forall a. String -> Decoder s a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Decoder s SigMempoolFail)
-> String -> Decoder s SigMempoolFail
forall a b. (a -> b) -> a -> b
$ String -> Word -> Int -> String
forall r. PrintfType r => String -> r
printf String
"unrecognized (tag,len) = (%d, %d)" Word
tag Int
len