{-# LANGUAGE DataKinds #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}

module Cardano.Api.Tx.Internal.Serialise
  ( deserialiseByronTx
  , deserialiseWitnessLedger
  , serialiseByronTx
  , serialiseTxToTextEnvelope
  , serialiseWitnessLedger
  , writeByronTxFileTextEnvelope
  , writeTxFileTextEnvelope
  , writeTxFileTextEnvelopeCanonical
  , writeTxWitnessFileTextEnvelope
  )
where

import Cardano.Api.Era
import Cardano.Api.Error
import Cardano.Api.IO
import Cardano.Api.Serialise.Cbor.Canonical
import Cardano.Api.Serialise.TextEnvelope.Internal
import Cardano.Api.Tx.Internal.Sign

import Cardano.Chain.UTxO qualified as Byron
import Cardano.Ledger.Binary qualified as CBOR

import Data.Bifunctor
import Data.ByteString (ByteString)
import Data.ByteString.Lazy qualified as LBS

-- Text envelope serialisation

deserialiseByronTx :: TextEnvelope -> Either TextEnvelopeError (Byron.ATxAux ByteString)
deserialiseByronTx :: TextEnvelope -> Either TextEnvelopeError (ATxAux ByteString)
deserialiseByronTx TextEnvelope
tec =
  (DecoderError -> TextEnvelopeError)
-> Either DecoderError (ATxAux ByteString)
-> Either TextEnvelopeError (ATxAux ByteString)
forall a b c. (a -> b) -> Either a c -> Either b c
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first DecoderError -> TextEnvelopeError
TextEnvelopeDecodeError (Either DecoderError (ATxAux ByteString)
 -> Either TextEnvelopeError (ATxAux ByteString))
-> Either DecoderError (ATxAux ByteString)
-> Either TextEnvelopeError (ATxAux ByteString)
forall a b. (a -> b) -> a -> b
$
    Version
-> Text
-> (forall s. Decoder s (ATxAux ByteSpan))
-> ByteString
-> Either DecoderError (ATxAux ByteString)
forall (f :: * -> *).
Functor f =>
Version
-> Text
-> (forall s. Decoder s (f ByteSpan))
-> ByteString
-> Either DecoderError (f ByteString)
CBOR.decodeFullAnnotatedBytes
      Version
CBOR.byronProtVer
      Text
"Byron Tx"
      Decoder s (ATxAux ByteSpan)
forall s. Decoder s (ATxAux ByteSpan)
forall a s. DecCBOR a => Decoder s a
CBOR.decCBOR
      (ByteString -> ByteString
LBS.fromStrict (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ TextEnvelope -> ByteString
teRawCBOR TextEnvelope
tec)

serialiseByronTx :: Byron.ATxAux ByteString -> TextEnvelope
serialiseByronTx :: ATxAux ByteString -> TextEnvelope
serialiseByronTx ATxAux ByteString
tx =
  TextEnvelope
    { teType :: TextEnvelopeType
teType = TextEnvelopeType
"Tx ByronEra"
    , teDescription :: TextEnvelopeDescr
teDescription = TextEnvelopeDescr
"Ledger Cddl Format"
    , teRawCBOR :: ByteString
teRawCBOR = ATxAux ByteString -> ByteString
forall t. Decoded t => t -> ByteString
CBOR.recoverBytes ATxAux ByteString
tx
    }

writeByronTxFileTextEnvelope
  :: File content Out
  -> Byron.ATxAux ByteString
  -> IO (Either (FileError ()) ())
writeByronTxFileTextEnvelope :: forall content.
File content 'Out
-> ATxAux ByteString -> IO (Either (FileError ()) ())
writeByronTxFileTextEnvelope File content 'Out
path =
  File content 'Out -> ByteString -> IO (Either (FileError ()) ())
forall (m :: * -> *) content e.
MonadIO m =>
File content 'Out -> ByteString -> m (Either (FileError e) ())
writeLazyByteStringFile File content 'Out
path
    (ByteString -> IO (Either (FileError ()) ()))
-> (ATxAux ByteString -> ByteString)
-> ATxAux ByteString
-> IO (Either (FileError ()) ())
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TextEnvelope -> ByteString
serialiseTextEnvelope
    (TextEnvelope -> ByteString)
-> (ATxAux ByteString -> TextEnvelope)
-> ATxAux ByteString
-> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ATxAux ByteString -> TextEnvelope
serialiseByronTx

serialiseTxToTextEnvelope :: ShelleyBasedEra era -> Tx era -> TextEnvelope
serialiseTxToTextEnvelope :: forall era. ShelleyBasedEra era -> Tx era -> TextEnvelope
serialiseTxToTextEnvelope ShelleyBasedEra era
era' Tx era
tx' =
  ShelleyBasedEra era
-> (ShelleyBasedEraConstraints era => TextEnvelope) -> TextEnvelope
forall era a.
ShelleyBasedEra era -> (ShelleyBasedEraConstraints era => a) -> a
shelleyBasedEraConstraints ShelleyBasedEra era
era' ((ShelleyBasedEraConstraints era => TextEnvelope) -> TextEnvelope)
-> (ShelleyBasedEraConstraints era => TextEnvelope) -> TextEnvelope
forall a b. (a -> b) -> a -> b
$ do
    Maybe TextEnvelopeDescr -> Tx era -> TextEnvelope
forall a.
HasTextEnvelope a =>
Maybe TextEnvelopeDescr -> a -> TextEnvelope
serialiseToTextEnvelope (TextEnvelopeDescr -> Maybe TextEnvelopeDescr
forall a. a -> Maybe a
Just TextEnvelopeDescr
"Ledger Cddl Format") Tx era
tx'

deserialiseWitnessLedger
  :: forall era
   . ShelleyBasedEra era
  -> TextEnvelope
  -> Either TextEnvelopeError (KeyWitness era)
deserialiseWitnessLedger :: forall era.
ShelleyBasedEra era
-> TextEnvelope -> Either TextEnvelopeError (KeyWitness era)
deserialiseWitnessLedger ShelleyBasedEra era
sbe TextEnvelope
te =
  ShelleyBasedEra era
-> (ShelleyBasedEraConstraints era =>
    Either TextEnvelopeError (KeyWitness era))
-> Either TextEnvelopeError (KeyWitness era)
forall era a.
ShelleyBasedEra era -> (ShelleyBasedEraConstraints era => a) -> a
shelleyBasedEraConstraints ShelleyBasedEra era
sbe ((ShelleyBasedEraConstraints era =>
  Either TextEnvelopeError (KeyWitness era))
 -> Either TextEnvelopeError (KeyWitness era))
-> (ShelleyBasedEraConstraints era =>
    Either TextEnvelopeError (KeyWitness era))
-> Either TextEnvelopeError (KeyWitness era)
forall a b. (a -> b) -> a -> b
$
    TextEnvelope
-> Either TextEnvelopeError (KeyWitness era)
-> Either TextEnvelopeError (KeyWitness era)
legacyDecoding TextEnvelope
te (Either TextEnvelopeError (KeyWitness era)
 -> Either TextEnvelopeError (KeyWitness era))
-> Either TextEnvelopeError (KeyWitness era)
-> Either TextEnvelopeError (KeyWitness era)
forall a b. (a -> b) -> a -> b
$
      TextEnvelope -> Either TextEnvelopeError (KeyWitness era)
forall a.
HasTextEnvelope a =>
TextEnvelope -> Either TextEnvelopeError a
deserialiseFromTextEnvelope TextEnvelope
te
 where
  -- This wrapper ensures that we can still decode the key witness
  -- that were serialized before we migrated to using 'serialiseToTextEnvelope'.
  -- Previously we were differentiating between the bootstrap key witness and the
  -- shelley key witness with CBOR tags 0 and 1. This is a deviation from the ledger's
  -- CDDL. See `legacyKeyWitnessEncode` for more details.
  legacyDecoding
    :: TextEnvelope
    -> Either TextEnvelopeError (KeyWitness era)
    -> Either TextEnvelopeError (KeyWitness era)
  legacyDecoding :: TextEnvelope
-> Either TextEnvelopeError (KeyWitness era)
-> Either TextEnvelopeError (KeyWitness era)
legacyDecoding TextEnvelope{TextEnvelopeDescr
teDescription :: TextEnvelope -> TextEnvelopeDescr
teDescription :: TextEnvelopeDescr
teDescription, ByteString
teRawCBOR :: TextEnvelope -> ByteString
teRawCBOR :: ByteString
teRawCBOR} (Left (TextEnvelopeDecodeError DecoderError
_)) =
    case TextEnvelopeDescr
teDescription of
      TextEnvelopeDescr
"Key BootstrapWitness ShelleyEra" -> do
        w <-
          (DecoderError -> TextEnvelopeError)
-> Either DecoderError BootstrapWitness
-> Either TextEnvelopeError BootstrapWitness
forall a b c. (a -> b) -> Either a c -> Either b c
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first DecoderError -> TextEnvelopeError
TextEnvelopeDecodeError (Either DecoderError BootstrapWitness
 -> Either TextEnvelopeError BootstrapWitness)
-> Either DecoderError BootstrapWitness
-> Either TextEnvelopeError BootstrapWitness
forall a b. (a -> b) -> a -> b
$
            Version
-> Text
-> (forall s. Decoder s (Annotator BootstrapWitness))
-> ByteString
-> Either DecoderError BootstrapWitness
forall a.
Version
-> Text
-> (forall s. Decoder s (Annotator a))
-> ByteString
-> Either DecoderError a
CBOR.decodeFullAnnotator
              (ShelleyBasedEra era -> Version
forall era. ShelleyBasedEra era -> Version
eraProtVerLow ShelleyBasedEra era
sbe)
              Text
"Shelley Witness"
              Decoder s (Annotator BootstrapWitness)
forall s. Decoder s (Annotator BootstrapWitness)
forall a s. DecCBOR a => Decoder s a
CBOR.decCBOR
              (ByteString -> ByteString
LBS.fromStrict ByteString
teRawCBOR)
        Right $ ShelleyBootstrapWitness sbe w
      TextEnvelopeDescr
"Key Witness ShelleyEra" -> do
        w <-
          (DecoderError -> TextEnvelopeError)
-> Either DecoderError (WitVKey 'Witness)
-> Either TextEnvelopeError (WitVKey 'Witness)
forall a b c. (a -> b) -> Either a c -> Either b c
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first DecoderError -> TextEnvelopeError
TextEnvelopeDecodeError (Either DecoderError (WitVKey 'Witness)
 -> Either TextEnvelopeError (WitVKey 'Witness))
-> Either DecoderError (WitVKey 'Witness)
-> Either TextEnvelopeError (WitVKey 'Witness)
forall a b. (a -> b) -> a -> b
$
            Version
-> Text
-> (forall s. Decoder s (Annotator (WitVKey 'Witness)))
-> ByteString
-> Either DecoderError (WitVKey 'Witness)
forall a.
Version
-> Text
-> (forall s. Decoder s (Annotator a))
-> ByteString
-> Either DecoderError a
CBOR.decodeFullAnnotator
              (ShelleyBasedEra era -> Version
forall era. ShelleyBasedEra era -> Version
eraProtVerLow ShelleyBasedEra era
sbe)
              Text
"Shelley Witness"
              Decoder s (Annotator (WitVKey 'Witness))
forall s. Decoder s (Annotator (WitVKey 'Witness))
forall a s. DecCBOR a => Decoder s a
CBOR.decCBOR
              (ByteString -> ByteString
LBS.fromStrict ByteString
teRawCBOR)
        Right $ ShelleyKeyWitness sbe w
      TextEnvelopeDescr
desc -> TextEnvelopeError -> Either TextEnvelopeError (KeyWitness era)
forall a b. a -> Either a b
Left (TextEnvelopeError -> Either TextEnvelopeError (KeyWitness era))
-> TextEnvelopeError -> Either TextEnvelopeError (KeyWitness era)
forall a b. (a -> b) -> a -> b
$ TextEnvelopeDescr -> TextEnvelopeError
TextEnvelopeUnknownKeyWitness TextEnvelopeDescr
desc
  legacyDecoding TextEnvelope
_ Either TextEnvelopeError (KeyWitness era)
v = Either TextEnvelopeError (KeyWitness era)
v

serialiseWitnessLedger :: forall era. ShelleyBasedEra era -> KeyWitness era -> TextEnvelope
serialiseWitnessLedger :: forall era. ShelleyBasedEra era -> KeyWitness era -> TextEnvelope
serialiseWitnessLedger ShelleyBasedEra era
sbe KeyWitness era
kw =
  ShelleyBasedEra era
-> (ShelleyBasedEraConstraints era => TextEnvelope) -> TextEnvelope
forall era a.
ShelleyBasedEra era -> (ShelleyBasedEraConstraints era => a) -> a
shelleyBasedEraConstraints ShelleyBasedEra era
sbe ((ShelleyBasedEraConstraints era => TextEnvelope) -> TextEnvelope)
-> (ShelleyBasedEraConstraints era => TextEnvelope) -> TextEnvelope
forall a b. (a -> b) -> a -> b
$
    Maybe TextEnvelopeDescr -> KeyWitness era -> TextEnvelope
forall a.
HasTextEnvelope a =>
Maybe TextEnvelopeDescr -> a -> TextEnvelope
serialiseToTextEnvelope (TextEnvelopeDescr -> Maybe TextEnvelopeDescr
forall a. a -> Maybe a
Just (TextEnvelopeDescr -> Maybe TextEnvelopeDescr)
-> TextEnvelopeDescr -> Maybe TextEnvelopeDescr
forall a b. (a -> b) -> a -> b
$ String -> TextEnvelopeDescr
TextEnvelopeDescr String
desc) KeyWitness era
kw
 where
  desc :: String
  desc :: String
desc = ShelleyBasedEra era
-> (ShelleyBasedEraConstraints era => String) -> String
forall era a.
ShelleyBasedEra era -> (ShelleyBasedEraConstraints era => a) -> a
shelleyBasedEraConstraints ShelleyBasedEra era
sbe ((ShelleyBasedEraConstraints era => String) -> String)
-> (ShelleyBasedEraConstraints era => String) -> String
forall a b. (a -> b) -> a -> b
$ case KeyWitness era
kw of
    ShelleyBootstrapWitness{} -> String
"Key BootstrapWitness ShelleyEra"
    ShelleyKeyWitness{} -> String
"Key Witness ShelleyEra"

writeTxFileTextEnvelope
  :: ShelleyBasedEra era
  -> File content Out
  -> Tx era
  -> IO (Either (FileError ()) ())
writeTxFileTextEnvelope :: forall era content.
ShelleyBasedEra era
-> File content 'Out -> Tx era -> IO (Either (FileError ()) ())
writeTxFileTextEnvelope ShelleyBasedEra era
sbe File content 'Out
path =
  File content 'Out -> ByteString -> IO (Either (FileError ()) ())
forall (m :: * -> *) content e.
MonadIO m =>
File content 'Out -> ByteString -> m (Either (FileError e) ())
writeLazyByteStringFile File content 'Out
path
    (ByteString -> IO (Either (FileError ()) ()))
-> (Tx era -> ByteString)
-> Tx era
-> IO (Either (FileError ()) ())
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TextEnvelope -> ByteString
serialiseTextEnvelope
    (TextEnvelope -> ByteString)
-> (Tx era -> TextEnvelope) -> Tx era -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShelleyBasedEra era -> Tx era -> TextEnvelope
forall era. ShelleyBasedEra era -> Tx era -> TextEnvelope
serialiseTxToTextEnvelope ShelleyBasedEra era
sbe

-- | Write transaction in the text envelope format. The CBOR will be in canonical format according
-- to RFC 7049. It is also a requirement of CIP-21, which is not fully implemented.
--
-- 1. RFC 7049: https://datatracker.ietf.org/doc/html/rfc7049#section-3.9
-- 2. CIP-21: https://github.com/cardano-foundation/CIPs/blob/master/CIP-0021/README.md#canonical-cbor-serialization-format
writeTxFileTextEnvelopeCanonical
  :: ShelleyBasedEra era
  -> File content Out
  -> Tx era
  -> IO (Either (FileError ()) ())
writeTxFileTextEnvelopeCanonical :: forall era content.
ShelleyBasedEra era
-> File content 'Out -> Tx era -> IO (Either (FileError ()) ())
writeTxFileTextEnvelopeCanonical ShelleyBasedEra era
sbe File content 'Out
path =
  File content 'Out -> ByteString -> IO (Either (FileError ()) ())
forall (m :: * -> *) content e.
MonadIO m =>
File content 'Out -> ByteString -> m (Either (FileError e) ())
writeLazyByteStringFile File content 'Out
path
    (ByteString -> IO (Either (FileError ()) ()))
-> (Tx era -> ByteString)
-> Tx era
-> IO (Either (FileError ()) ())
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TextEnvelope -> ByteString
serialiseTextEnvelope
    (TextEnvelope -> ByteString)
-> (Tx era -> TextEnvelope) -> Tx era -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TextEnvelope -> TextEnvelope
canonicaliseTextEnvelopeCbor
    (TextEnvelope -> TextEnvelope)
-> (Tx era -> TextEnvelope) -> Tx era -> TextEnvelope
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShelleyBasedEra era -> Tx era -> TextEnvelope
forall era. ShelleyBasedEra era -> Tx era -> TextEnvelope
serialiseTxToTextEnvelope ShelleyBasedEra era
sbe
 where
  canonicaliseTextEnvelopeCbor :: TextEnvelope -> TextEnvelope
  canonicaliseTextEnvelopeCbor :: TextEnvelope -> TextEnvelope
canonicaliseTextEnvelopeCbor TextEnvelope
te = do
    let canonicalisedTxBs :: ByteString
canonicalisedTxBs =
          (DecoderError -> ByteString)
-> (ByteString -> ByteString)
-> Either DecoderError ByteString
-> ByteString
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either
            ( \DecoderError
err ->
                String -> ByteString
forall a. HasCallStack => String -> a
error (String -> ByteString) -> String -> ByteString
forall a b. (a -> b) -> a -> b
$
                  String
"writeTxFileTextEnvelopeCanonical: Impossible - deserialisation of just serialised bytes failed "
                    String -> String -> String
forall a. Semigroup a => a -> a -> a
<> DecoderError -> String
forall a. Show a => a -> String
show DecoderError
err
            )
            ByteString -> ByteString
forall a. a -> a
id
            (Either DecoderError ByteString -> ByteString)
-> (ByteString -> Either DecoderError ByteString)
-> ByteString
-> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Either DecoderError ByteString
canonicaliseCborBs
            (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ TextEnvelope -> ByteString
teRawCBOR TextEnvelope
te
    TextEnvelope
te{teRawCBOR = canonicalisedTxBs}

writeTxWitnessFileTextEnvelope
  :: ShelleyBasedEra era
  -> File () Out
  -> KeyWitness era
  -> IO (Either (FileError ()) ())
writeTxWitnessFileTextEnvelope :: forall era.
ShelleyBasedEra era
-> File () 'Out -> KeyWitness era -> IO (Either (FileError ()) ())
writeTxWitnessFileTextEnvelope ShelleyBasedEra era
sbe File () 'Out
path =
  File () 'Out -> ByteString -> IO (Either (FileError ()) ())
forall (m :: * -> *) content e.
MonadIO m =>
File content 'Out -> ByteString -> m (Either (FileError e) ())
writeLazyByteStringFile File () 'Out
path
    (ByteString -> IO (Either (FileError ()) ()))
-> (KeyWitness era -> ByteString)
-> KeyWitness era
-> IO (Either (FileError ()) ())
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TextEnvelope -> ByteString
serialiseTextEnvelope
    (TextEnvelope -> ByteString)
-> (KeyWitness era -> TextEnvelope) -> KeyWitness era -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShelleyBasedEra era -> KeyWitness era -> TextEnvelope
forall era. ShelleyBasedEra era -> KeyWitness era -> TextEnvelope
serialiseWitnessLedger ShelleyBasedEra era
sbe