{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TypeApplications #-}

-- | Utility functions to deserialize the hexadecimal representation of a CBOR
-- encoded Cardano transaction.
--
-- To use from the repl run:
--
-- > cabal repl ouroboros-consensus-cardano:test:cardano-test
-- > import Test.Consensus.Cardano.MiniProtocol.LocalTxSubmission.ByteStringTxParser
--
module Test.Consensus.Cardano.MiniProtocol.LocalTxSubmission.ByteStringTxParser (
    cardanoCodecCfg
  , deserialiseTx
  , printDeserializedTx
  ) where

import           Cardano.Chain.Epoch.File (mainnetEpochSlots)
import           Codec.CBOR.Read (DeserialiseFailure, deserialiseFromBytes)
import           Data.ByteString.Base16.Lazy (decodeLenient)
import qualified Data.ByteString.Lazy as BL
import qualified Data.Map.Strict as Map
import           Data.Proxy (Proxy (..))
import           Ouroboros.Consensus.Byron.Ledger
import           Ouroboros.Consensus.Cardano.Block
import           Ouroboros.Consensus.Cardano.Node ()
import           Ouroboros.Consensus.Node.NetworkProtocolVersion
                     (latestReleasedNodeVersion, supportedNodeToClientVersions)
import           Ouroboros.Consensus.Node.Serialisation
                     (SerialiseNodeToClient (decodeNodeToClient))
import           Ouroboros.Consensus.Shelley.Ledger
                     (CodecConfig (ShelleyCodecConfig))
import           Ouroboros.Consensus.Shelley.Ledger.SupportsProtocol ()
import           Text.Pretty.Simple (pPrint)

cardanoCodecCfg :: CodecConfig (CardanoBlock StandardCrypto)
cardanoCodecCfg :: CodecConfig (CardanoBlock StandardCrypto)
cardanoCodecCfg =
  CodecConfig ByronBlock
-> CodecConfig
     (ShelleyBlock (TPraos StandardCrypto) (ShelleyEra StandardCrypto))
-> CodecConfig
     (ShelleyBlock (TPraos StandardCrypto) (AllegraEra StandardCrypto))
-> CodecConfig
     (ShelleyBlock (TPraos StandardCrypto) (MaryEra StandardCrypto))
-> CodecConfig
     (ShelleyBlock (TPraos StandardCrypto) (AlonzoEra StandardCrypto))
-> CodecConfig
     (ShelleyBlock (Praos StandardCrypto) (BabbageEra StandardCrypto))
-> CodecConfig
     (ShelleyBlock (Praos StandardCrypto) (ConwayEra StandardCrypto))
-> CodecConfig (CardanoBlock StandardCrypto)
forall c.
CodecConfig ByronBlock
-> CodecConfig (ShelleyBlock (TPraos c) (ShelleyEra c))
-> CodecConfig (ShelleyBlock (TPraos c) (AllegraEra c))
-> CodecConfig (ShelleyBlock (TPraos c) (MaryEra c))
-> CodecConfig (ShelleyBlock (TPraos c) (AlonzoEra c))
-> CodecConfig (ShelleyBlock (Praos c) (BabbageEra c))
-> CodecConfig (ShelleyBlock (Praos c) (ConwayEra c))
-> CardanoCodecConfig c
CardanoCodecConfig
            (EpochSlots -> CodecConfig ByronBlock
ByronCodecConfig EpochSlots
mainnetEpochSlots)
            CodecConfig
  (ShelleyBlock (TPraos StandardCrypto) (ShelleyEra StandardCrypto))
forall proto era. CodecConfig (ShelleyBlock proto era)
ShelleyCodecConfig
            CodecConfig
  (ShelleyBlock (TPraos StandardCrypto) (AllegraEra StandardCrypto))
forall proto era. CodecConfig (ShelleyBlock proto era)
ShelleyCodecConfig
            CodecConfig
  (ShelleyBlock (TPraos StandardCrypto) (MaryEra StandardCrypto))
forall proto era. CodecConfig (ShelleyBlock proto era)
ShelleyCodecConfig
            CodecConfig
  (ShelleyBlock (TPraos StandardCrypto) (AlonzoEra StandardCrypto))
forall proto era. CodecConfig (ShelleyBlock proto era)
ShelleyCodecConfig
            CodecConfig
  (ShelleyBlock (Praos StandardCrypto) (BabbageEra StandardCrypto))
forall proto era. CodecConfig (ShelleyBlock proto era)
ShelleyCodecConfig
            CodecConfig
  (ShelleyBlock (Praos StandardCrypto) (ConwayEra StandardCrypto))
forall proto era. CodecConfig (ShelleyBlock proto era)
ShelleyCodecConfig

deserialiseTx ::
     BL.ByteString
  -> Either DeserialiseFailure (BL.ByteString, GenTx (CardanoBlock StandardCrypto))
deserialiseTx :: ByteString
-> Either
     DeserialiseFailure
     (ByteString, GenTx (CardanoBlock StandardCrypto))
deserialiseTx = (forall s. Decoder s (GenTx (CardanoBlock StandardCrypto)))
-> ByteString
-> Either
     DeserialiseFailure
     (ByteString, GenTx (CardanoBlock StandardCrypto))
forall a.
(forall s. Decoder s a)
-> ByteString -> Either DeserialiseFailure (ByteString, a)
deserialiseFromBytes Decoder s (GenTx (CardanoBlock StandardCrypto))
forall s. Decoder s (GenTx (CardanoBlock StandardCrypto))
cborDecoder (ByteString
 -> Either
      DeserialiseFailure
      (ByteString, GenTx (CardanoBlock StandardCrypto)))
-> (ByteString -> ByteString)
-> ByteString
-> Either
     DeserialiseFailure
     (ByteString, GenTx (CardanoBlock StandardCrypto))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
decodeLenient
  where
    cborDecoder :: Decoder s (GenTx (CardanoBlock StandardCrypto))
cborDecoder = CodecConfig (CardanoBlock StandardCrypto)
-> BlockNodeToClientVersion (CardanoBlock StandardCrypto)
-> forall s. Decoder s (GenTx (CardanoBlock StandardCrypto))
forall blk a.
SerialiseNodeToClient blk a =>
CodecConfig blk
-> BlockNodeToClientVersion blk -> forall s. Decoder s a
decodeNodeToClient CodecConfig (CardanoBlock StandardCrypto)
cardanoCodecCfg BlockNodeToClientVersion (CardanoBlock StandardCrypto)
HardForkNodeToClientVersion
  (ByronBlock : CardanoShelleyEras StandardCrypto)
latestReleasedBlockNodeToClientVersion
    latestReleasedBlockNodeToClientVersion :: HardForkNodeToClientVersion
  (ByronBlock : CardanoShelleyEras StandardCrypto)
latestReleasedBlockNodeToClientVersion =
        case Proxy (CardanoBlock StandardCrypto)
-> (Maybe NodeToNodeVersion, Maybe NodeToClientVersion)
forall blk.
SupportedNetworkProtocolVersion blk =>
Proxy blk -> (Maybe NodeToNodeVersion, Maybe NodeToClientVersion)
latestReleasedNodeVersion Proxy (CardanoBlock StandardCrypto)
p of
          (Maybe NodeToNodeVersion
_, Just NodeToClientVersion
n2c) -> Proxy (CardanoBlock StandardCrypto)
-> Map
     NodeToClientVersion
     (BlockNodeToClientVersion (CardanoBlock StandardCrypto))
forall blk.
SupportedNetworkProtocolVersion blk =>
Proxy blk -> Map NodeToClientVersion (BlockNodeToClientVersion blk)
supportedNodeToClientVersions Proxy (CardanoBlock StandardCrypto)
p Map
  NodeToClientVersion
  (HardForkNodeToClientVersion
     (ByronBlock : CardanoShelleyEras StandardCrypto))
-> NodeToClientVersion
-> HardForkNodeToClientVersion
     (ByronBlock : CardanoShelleyEras StandardCrypto)
forall k a. Ord k => Map k a -> k -> a
Map.! NodeToClientVersion
n2c
          (Maybe NodeToNodeVersion, Maybe NodeToClientVersion)
_             -> [Char]
-> HardForkNodeToClientVersion
     (ByronBlock : CardanoShelleyEras StandardCrypto)
forall a. HasCallStack => [Char] -> a
error [Char]
"no latest released Cardano NodeToClient version"
      where
        p :: Proxy (CardanoBlock StandardCrypto)
p = forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @(CardanoBlock StandardCrypto)

printDeserializedTx :: BL.ByteString -> IO ()
printDeserializedTx :: ByteString -> IO ()
printDeserializedTx ByteString
bs =
  case ByteString
-> Either
     DeserialiseFailure
     (ByteString, GenTx (CardanoBlock StandardCrypto))
deserialiseTx ByteString
bs of
    Left  DeserialiseFailure
err             -> DeserialiseFailure -> IO ()
forall (m :: * -> *) a. (MonadIO m, Show a) => a -> m ()
pPrint DeserialiseFailure
err
    Right (ByteString
_rest, GenTx (CardanoBlock StandardCrypto)
result) -> GenTx (CardanoBlock StandardCrypto) -> IO ()
forall (m :: * -> *) a. (MonadIO m, Show a) => a -> m ()
pPrint GenTx (CardanoBlock StandardCrypto)
result