wip: Remove pointless tx type-conversions

lib/core/cardano-wallet-core.cabal

@@ -77,6 +77,8 @@ library
     , OddWord
     , ouroboros-consensus
     , ouroboros-network
+    , ouroboros-consensus-shelley
+    , ouroboros-consensus-cardano
     , path-pieces
     , persistent
     , persistent-sqlite

lib/core/src/Cardano/Wallet/Primitive/Types/Tx.hs

@@ -112,7 +112,12 @@ import GHC.Generics
     ( Generic )
 import Numeric.Natural
     ( Natural )
+import Ouroboros.Consensus.Cardano.Block
+    ( CardanoGenTx )
+import Ouroboros.Consensus.Shelley.Protocol.Crypto
+    ( StandardCrypto )
 
+import qualified Cardano.Api.Typed as Cardano
 import qualified Cardano.Wallet.Primitive.Types.TokenBundle as TokenBundle
 import qualified Cardano.Wallet.Primitive.Types.TokenMap as TokenMap
 import qualified Data.Map.Strict as Map
@@ -358,9 +363,8 @@ instance ToText Direction where
 
 -- | @SealedTx@ is a serialised transaction that is ready to be submitted
 -- to the node.
-newtype SealedTx = SealedTx { getSealedTx :: ByteString }
+newtype SealedTx = SealedTx { getSealedTx :: CardanoGenTx StandardCrypto }
     deriving stock (Show, Eq, Generic)
-    deriving newtype (ByteArrayAccess)
 
 -- | True if the given metadata refers to a pending transaction
 isPending :: TxMeta -> Bool

lib/shelley/src/Cardano/Wallet/Byron/Compatibility.hs

@@ -31,7 +31,6 @@ module Cardano.Wallet.Byron.Compatibility
 
       -- * Conversions
     , toByronHash
-    , toGenTx
     , toPoint
 
     , fromBlockNo
@@ -54,7 +53,7 @@ module Cardano.Wallet.Byron.Compatibility
 import Prelude
 
 import Cardano.Binary
-    ( fromCBOR, serialize' )
+    ( serialize' )
 import Cardano.Chain.Block
     ( ABlockOrBoundary (..), blockTxPayload )
 import Cardano.Chain.Common
@@ -66,27 +65,18 @@ import Cardano.Chain.Common
     )
 import Cardano.Chain.Genesis
     ( GenesisData (..), GenesisHash (..), GenesisNonAvvmBalances (..) )
-import Cardano.Chain.MempoolPayload
-    ( AMempoolPayload (..) )
 import Cardano.Chain.Slotting
     ( EpochSlots (..) )
 import Cardano.Chain.Update
     ( ProtocolParameters (..) )
 import Cardano.Chain.UTxO
-    ( ATxAux (..)
-    , Tx (..)
-    , TxIn (..)
-    , TxOut (..)
-    , annotateTxAux
-    , taTx
-    , unTxPayload
-    )
+    ( ATxAux (..), Tx (..), TxIn (..), TxOut (..), taTx, unTxPayload )
 import Cardano.Crypto
     ( serializeCborHash )
 import Cardano.Crypto.ProtocolMagic
     ( ProtocolMagicId, unProtocolMagicId )
 import Cardano.Wallet.Unsafe
-    ( unsafeDeserialiseCbor, unsafeFromHex )
+    ( unsafeFromHex )
 import Crypto.Hash.Utils
     ( blake2b256 )
 import Data.Coerce
@@ -97,14 +87,12 @@ import Data.Time.Clock.POSIX
     ( posixSecondsToUTCTime )
 import Data.Word
     ( Word16, Word32 )
-import GHC.Stack
-    ( HasCallStack )
 import Numeric.Natural
     ( Natural )
 import Ouroboros.Consensus.Block.Abstract
     ( headerPrevHash )
 import Ouroboros.Consensus.Byron.Ledger
-    ( ByronBlock (..), ByronHash (..), GenTx, fromMempoolPayload )
+    ( ByronBlock (..), ByronHash (..) )
 import Ouroboros.Consensus.Byron.Ledger.Config
     ( CodecConfig (..) )
 import Ouroboros.Consensus.HardFork.History.Summary
@@ -135,7 +123,6 @@ import qualified Cardano.Wallet.Primitive.Types.Hash as W
 import qualified Cardano.Wallet.Primitive.Types.TokenBundle as TokenBundle
 import qualified Cardano.Wallet.Primitive.Types.Tx as W
 import qualified Data.ByteString as BS
-import qualified Data.ByteString.Lazy as BL
 import qualified Data.List.NonEmpty as NE
 import qualified Data.Map.Strict as Map
 import qualified Ouroboros.Consensus.Block as O
@@ -270,17 +257,6 @@ toPoint genesisH (W.BlockHeader sl _ h _)
   | h == (coerce genesisH) = O.GenesisPoint
   | otherwise = O.Point $ Point.block sl (toByronHash h)
 
--- | SealedTx are the result of rightfully constructed byron transactions so, it
--- is relatively safe to unserialize them from CBOR.
-toGenTx :: HasCallStack => W.SealedTx -> GenTx ByronBlock
-toGenTx =
-    fromMempoolPayload
-    . MempoolTx
-    . annotateTxAux
-    . unsafeDeserialiseCbor fromCBOR
-    . BL.fromStrict
-    . W.getSealedTx
-
 byronCodecConfig :: W.SlottingParameters -> CodecConfig ByronBlock
 byronCodecConfig W.SlottingParameters{getEpochLength} =
     ByronCodecConfig (toEpochSlots getEpochLength)

lib/shelley/src/Cardano/Wallet/Shelley/Compatibility.hs

@@ -23,6 +23,9 @@
 -- Jörmungandr dual support.
 {-# OPTIONS_GHC -fno-warn-orphans #-}
 
+-- For IsShelleyLedger
+{-# OPTIONS_GHC -fno-warn-redundant-constraints #-}
+
 -- |
 -- Copyright: © 2020 IOHK
 -- License: Apache-2.0
@@ -52,15 +55,13 @@ module Cardano.Wallet.Shelley.Compatibility
       -- * Conversions
     , toCardanoHash
     , toEpochSize
-    , unsealShelleyTx
     , toPoint
     , toCardanoTxId
     , toCardanoTxIn
     , toShelleyTxOut
     , toAllegraTxOut
     , toMaryTxOut
     , toCardanoLovelace
-    , sealShelleyTx
     , toStakeKeyRegCert
     , toStakeKeyDeregCert
     , toStakePoolDlgCert
@@ -139,8 +140,6 @@ import Cardano.Api.Typed
     , deserialiseFromRawBytes
     , fromShelleyMetadata
     )
-import Cardano.Binary
-    ( fromCBOR, serialize' )
 import Cardano.Crypto.Hash.Class
     ( Hash (UnsafeHash), hashToBytes )
 import Cardano.Ledger.Era
@@ -154,7 +153,7 @@ import Cardano.Wallet.Api.Types
     , EncodeStakeAddress (..)
     )
 import Cardano.Wallet.Byron.Compatibility
-    ( fromByronBlock, fromTxAux, toByronBlockHeader )
+    ( fromByronBlock, toByronBlockHeader )
 import Cardano.Wallet.Primitive.AddressDerivation
     ( NetworkDiscriminant (..) )
 import Cardano.Wallet.Primitive.Types
@@ -165,7 +164,7 @@ import Cardano.Wallet.Primitive.Types
 import Cardano.Wallet.Transaction
     ( ErrDecodeSignedTx (..) )
 import Cardano.Wallet.Unsafe
-    ( unsafeDeserialiseCbor, unsafeMkPercentage )
+    ( unsafeMkPercentage )
 import Codec.Binary.Bech32
     ( dataPartFromBytes, dataPartToBytes )
 import Control.Applicative
@@ -286,7 +285,6 @@ import qualified Cardano.Wallet.Primitive.Types.Tx as W
 import qualified Codec.Binary.Bech32 as Bech32
 import qualified Codec.Binary.Bech32.TH as Bech32
 import qualified Codec.CBOR.Decoding as CBOR
-import qualified Codec.CBOR.Write as CBOR
 import qualified Data.Aeson as Aeson
 import qualified Data.ByteString as BS
 import qualified Data.ByteString.Lazy as BL
@@ -313,7 +311,7 @@ class
     , Cardano.IsShelleyBasedEra era
     ) => WalletCompatibleEra era where
     fromEraTx
-        :: SL.Tx (Cardano.ShelleyLedgerEra era)
+        :: Cardano.Tx era
         -> ( W.Tx
            , [W.DelegationCertificate]
            , [W.PoolCertificate]
@@ -345,26 +343,34 @@ decodeEraTx
 decodeEraTx proxy bytes = do
     let asType = Cardano.proxyToAsType proxy
     case Cardano.deserialiseFromCBOR (Cardano.AsTx asType) bytes of
-        Right (Cardano.ShelleyTx _era tx) -> do
-            let (walletTx, _delegCerts, _poolCerts) = fromEraTx @era tx
-            return (walletTx, W.SealedTx bytes)
+        Right tx'@(Cardano.ShelleyTx _era _tx) -> do
+            let (walletTx, _delegCerts, _poolCerts) = fromEraTx @era tx'
+            return (walletTx, W.SealedTx $ toGenTx tx')
         Right (Cardano.ByronTx _) -> do
             Left ErrDecodeSignedTxNotSupported
         Left decodeErr ->
             Left $ ErrDecodeSignedTxWrongPayload (T.pack $ show decodeErr)
 
 instance WalletCompatibleEra ShelleyEra where
-    fromEraTx = fromShelleyTx
+    fromEraTx = fromShelleyTx . shelleyLedgerTx
     toGenTx (Cardano.ShelleyTx _era tx) = GenTxShelley $ O.mkShelleyTx tx
 
 instance WalletCompatibleEra AllegraEra where
-    fromEraTx = fromAllegraTx
+    fromEraTx = fromAllegraTx . shelleyLedgerTx
     toGenTx (Cardano.ShelleyTx _era tx) = GenTxAllegra $ O.mkShelleyTx tx
 
 instance WalletCompatibleEra MaryEra where
-    fromEraTx = fromMaryTx
+    fromEraTx = fromMaryTx . shelleyLedgerTx
     toGenTx (Cardano.ShelleyTx _era tx) = GenTxMary $ O.mkShelleyTx tx
 
+shelleyLedgerTx
+    :: Cardano.IsShelleyBasedEra era
+    => Cardano.Tx era
+    -> SL.Tx (Cardano.ShelleyLedgerEra era)
+shelleyLedgerTx  (Cardano.ShelleyTx _era tx) = tx
+shelleyLedgerTx  (Cardano.ByronTx _) =
+    error "shelleyLedgerTx: impossible because of (IsShelleyBasedEra era)"
+
 type NodeVersionData =
     (NodeToClientVersionData, CodecCBORTerm Text NodeToClientVersionData)
 
@@ -1138,41 +1144,6 @@ toByronNetworkMagic pm@(W.ProtocolMagic magic) =
     else
         Byron.NetworkTestnet (fromIntegral magic)
 
--- | SealedTx are the result of rightfully constructed shelley transactions so, it
--- is relatively safe to unserialize them from CBOR.
-unsealShelleyTx
-    :: (HasCallStack, O.ShelleyBasedEra (era c))
-    => (GenTx (ShelleyBlock (era c)) -> CardanoGenTx c)
-    -> W.SealedTx
-    -> CardanoGenTx c
-unsealShelleyTx wrap = wrap
-    . unsafeDeserialiseCbor fromCBOR
-    . BL.fromStrict
-    . W.getSealedTx
-
-sealShelleyTx
-    :: forall era b c. (O.ShelleyBasedEra (Cardano.ShelleyLedgerEra era))
-    => (SL.Tx (Cardano.ShelleyLedgerEra era) -> (W.Tx, b, c))
-    -> Cardano.Tx era
-    -> (W.Tx, W.SealedTx)
-sealShelleyTx fromTx (Cardano.ShelleyTx _era tx) =
-    let
-        -- The Cardano.Tx GADT won't allow the Shelley crypto type param escape,
-        -- so we convert directly to the concrete wallet Tx type:
-        (walletTx, _, _) = fromTx tx
-        sealed = serialize' $ O.mkShelleyTx tx
-    in
-        (walletTx, W.SealedTx sealed)
-
--- Needed to compile, but in principle should never be called.
-sealShelleyTx _ (Cardano.ByronTx txaux) =
-    let
-        tx = fromTxAux txaux
-        inps = fst <$> W.resolvedInputs tx
-        outs = W.outputs tx
-    in
-        (tx, W.SealedTx $ CBOR.toStrictByteString $ CBOR.encodeTx (inps, outs))
-
 toCardanoTxId :: W.Hash "Tx" -> Cardano.TxId
 toCardanoTxId (W.Hash h) = Cardano.TxId $ UnsafeHash $ toShort h
 

lib/shelley/src/Cardano/Wallet/Shelley/Network.hs

@@ -77,7 +77,6 @@ import Cardano.Wallet.Shelley.Compatibility
     , toPoint
     , toShelleyCoin
     , toStakeCredential
-    , unsealShelleyTx
     )
 import Control.Applicative
     ( liftA3 )
@@ -261,6 +260,7 @@ import qualified Cardano.Wallet.Primitive.Types.Hash as W
 import qualified Cardano.Wallet.Primitive.Types.RewardAccount as W
 import qualified Cardano.Wallet.Primitive.Types.Tx as W
 import qualified Codec.CBOR.Term as CBOR
+import qualified Data.ByteString as BS
 import qualified Data.Map as Map
 import qualified Data.Set as Set
 import qualified Data.Text as T
@@ -471,42 +471,14 @@ withNetworkLayerBase tr np conn (versionData, _) action = do
     _currentNodeEra nodeEraVar =
         atomically (readTVar nodeEraVar)
 
-    -- NOTE1: only shelley transactions can be submitted like this, because they
-    -- are deserialised as shelley transactions before submitting.
-    --
-    -- NOTE2: It is not ideal to query the current era again here because we
-    -- should in practice use the same era as the one used to construct the
-    -- transaction. However, when turning transactions to 'SealedTx', we loose
-    -- all form of type-level indicator about the era. The 'SealedTx' type
-    -- shouldn't be needed anymore since we've dropped jormungandr, so we could
-    -- instead carry a transaction from cardano-api types with proper typing.
-    _postTx localTxSubmissionQ nodeEraVar tx = do
-        era <- liftIO $ atomically $ readTVar nodeEraVar
+    -- FIXME: _nodeEraVar is no longer needed!
+    _postTx localTxSubmissionQ _nodeEraVar tx = do
         liftIO $ traceWith tr $ MsgPostTx tx
-        case era of
-            AnyCardanoEra ByronEra ->
-                throwE $ ErrPostTxProtocolFailure "Invalid era: Byron"
-
-            AnyCardanoEra ShelleyEra -> do
-                let cmd = CmdSubmitTx $ unsealShelleyTx GenTxShelley tx
-                result <- liftIO $ localTxSubmissionQ `send` cmd
-                case result of
-                    SubmitSuccess -> pure ()
-                    SubmitFail err -> throwE $ ErrPostTxBadRequest $ T.pack (show err)
-
-            AnyCardanoEra AllegraEra -> do
-                let cmd = CmdSubmitTx $ unsealShelleyTx GenTxAllegra tx
-                result <- liftIO $ localTxSubmissionQ `send` cmd
-                case result of
-                    SubmitSuccess -> pure ()
-                    SubmitFail err -> throwE $ ErrPostTxBadRequest $ T.pack (show err)
-
-            AnyCardanoEra MaryEra -> do
-                let cmd = CmdSubmitTx $ unsealShelleyTx GenTxMary tx
-                result <- liftIO $ localTxSubmissionQ `send` cmd
-                case result of
-                    SubmitSuccess -> pure ()
-                    SubmitFail err -> throwE $ ErrPostTxBadRequest $ T.pack (show err)
+        let cmd = CmdSubmitTx $ W.getSealedTx tx
+        result <- liftIO $ localTxSubmissionQ `send` cmd
+        case result of
+            SubmitSuccess -> pure ()
+            SubmitFail err -> throwE $ ErrPostTxBadRequest $ T.pack (show err)
 
     _stakeDistribution queue eraVar bh coin = do
         liftIO $ traceWith tr $ MsgWillQueryRewardsForStake coin
@@ -1364,10 +1336,15 @@ instance ToText NetworkLayerLog where
             ]
         MsgIntersectionFound point -> T.unwords
             [ "Intersection found:", pretty point ]
-        MsgPostTx (W.SealedTx bytes) -> T.unwords
-            [ "Posting transaction, serialized as:"
-            , T.decodeUtf8 $ convertToBase Base16 bytes
-            ]
+        MsgPostTx (W.SealedTx tx) ->
+            -- FIXME: Figure out how to convert GenTx to bytes
+            -- Probably: https://github.com/input-output-hk/ouroboros-network/blob/77766750051f672f43c5d070b7fcf41e13e7a191/ouroboros-consensus/src/Ouroboros/Consensus/Node/Serialisation.hs#L73
+            -- encodeNodeToClient
+            let bytes = "" :: BS.ByteString -- serialize' tx
+            in T.unwords
+                [ "Posting transaction, serialized as:"
+                , T.decodeUtf8 $ convertToBase Base16 bytes
+                ]
         MsgLocalStateQuery client msg ->
             T.pack (show client <> " " <> show msg)
         MsgNodeTip bh -> T.unwords