{-# 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"