Merge #3509

3509: [ADP-1963] move TxCBOR to the Read hierarchy r=paolino a=paolino




<!--
Detail in a few bullet points the work accomplished in this PR.

Before you submit, don't forget to:

* Make sure the GitHub PR fields are correct:
   ✓ Set a good Title for your PR.
   ✓ Assign yourself to the PR.
   ✓ Assign one or more reviewer(s).
   ✓ Link to a Jira issue, and/or other GitHub issues or PRs.
   ✓ In the PR description delete any empty sections
     and all text commented in <!--, so that this text does not appear
     in merge commit messages.

* Don't waste reviewers' time:
   ✓ If it's a draft, select the Create Draft PR option.
   ✓ Self-review your changes to make sure nothing unexpected slipped through.

* Try to make your intent clear:
   ✓ Write a good Description that explains what this PR is meant to do.
   ✓ Jira will detect and link to this PR once created, but you can also
     link this PR in the description of the corresponding Jira ticket.
   ✓ Highlight what Testing you have done.
   ✓ Acknowledge any changes required to the Documentation.
-->


- [x] redefine `Read.Tx` as `EraValue`
- [x] redefine `TxBOR` as `EraValue` , just to carry the era of the tx
- [x] redefine TxCBOR codecs to `Tx` as `EraFun`s

### Comments

<!-- Additional comments, links, or screenshots to attach, if any. -->

### Issue Number

<!-- Reference the Jira/GitHub issue that this PR relates to, and which requirements it tackles.
  Note: Jira issues of the form ADP- will be auto-linked. -->


Co-authored-by: paolo veronelli <paolo.veronelli@gmail.com>

lib/wallet/src/Cardano/Wallet.hs

@@ -455,7 +455,7 @@ import Cardano.Wallet.Primitive.Types.UTxOIndex
 import Cardano.Wallet.Primitive.Types.UTxOSelection
     ( UTxOSelection )
 import Cardano.Wallet.Read.Tx.CBOR
-    ( TxCBOR (..) )
+    ( TxCBOR )
 import Cardano.Wallet.Transaction
     ( DelegationAction (..)
     , ErrAssignRedeemers (..)
@@ -515,12 +515,8 @@ import Control.Tracer
     ( Tracer, contramap, traceWith )
 import Crypto.Hash
     ( Blake2b_256, hash )
-import Data.ByteArray.Encoding
-    ( Base (..), convertToBase )
 import Data.ByteString
     ( ByteString )
-import Data.ByteString.Lazy
-    ( toStrict )
 import Data.DBVar
     ( modifyDBMaybe )
 import Data.Either
@@ -561,8 +557,6 @@ import Data.Text
     ( Text )
 import Data.Text.Class
     ( ToText (..) )
-import Data.Text.Encoding
-    ( decodeUtf8 )
 import Data.Time.Clock
     ( NominalDiffTime, UTCTime )
 import Data.Type.Equality
@@ -4009,10 +4003,9 @@ instance ToText WalletFollowLog where
             "discovered " <> pretty (length txs) <> " new transaction(s)"
         MsgDiscoveredTxsContent txs ->
             "transactions: " <> pretty (blockListF (snd <$> txs))
-        MsgStoringCBOR TxCBOR{..} ->
+        MsgStoringCBOR txCBOR ->
             "store new cbor for "
-                <> pretty (show txEra) <> ": "
-                <> (decodeUtf8 . convertToBase Base16 $ toStrict txCBOR)
+                <> toText txCBOR
 
 instance ToText WalletLog where
     toText = \case

lib/wallet/src/Cardano/Wallet/DB/Store/CBOR/Store.hs

@@ -1,7 +1,10 @@
 
+{-# LANGUAGE DataKinds #-}
 {-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE RankNTypes #-}
 {-# LANGUAGE RecordWildCards #-}
 {-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TupleSections #-}
 {-# LANGUAGE TypeFamilies #-}
 
 {- |
@@ -16,20 +19,35 @@ module Cardano.Wallet.DB.Store.CBOR.Store ( mkStoreCBOR ) where
 
 import Prelude
 
+import Cardano.Wallet.DB.Sqlite.Schema
+    ( CBOR (..), EntityField (..) )
 import Cardano.Wallet.DB.Sqlite.Types
     ( TxId (..) )
 import Cardano.Wallet.DB.Store.CBOR.Model
     ( DeltaTxCBOR (..), TxCBORHistory (..) )
+import Cardano.Wallet.Read.Eras
 import Cardano.Wallet.Read.Tx.CBOR
-    ( TxCBOR (..) )
+    ( TxCBOR )
+import Control.Arrow
+    ( (***) )
+import Control.Exception
+    ( Exception, SomeException (..) )
+import Data.Bifunctor
+    ( bimap, first )
+import Data.ByteString
+    ( ByteString )
 import Data.ByteString.Lazy.Char8
     ( fromStrict, toStrict )
 import Data.DBVar
     ( Store (..) )
 import Data.Generics.Internal.VL
-    ( Iso', fromIso, iso, view )
+    ( Iso', build, fromIso, iso, match, (^.) )
 import Data.Maybe
     ( fromJust )
+import Data.Typeable
+    ( Typeable )
+import Data.Word
+    ( Word16 )
 import Database.Persist
     ( PersistEntity (keyFromRecordM)
     , PersistQueryWrite (deleteWhere)
@@ -41,39 +59,45 @@ import Database.Persist
 import Database.Persist.Sql
     ( SqlPersistT )
 
-import qualified Cardano.Wallet.DB.Sqlite.Schema as Schema
-    ( CBOR (..), EntityField (..) )
+import qualified Data.ByteString.Lazy as BL
 import qualified Data.Map.Strict as Map
 
-txCBORiso :: Iso' (TxId, TxCBOR) Schema.CBOR
-txCBORiso = iso f g
-  where
-    f :: (TxId, TxCBOR) -> Schema.CBOR
-    f (id',TxCBOR{..}) =
-        Schema.CBOR id' (toStrict txCBOR) (fromIntegral $ fromEnum txEra)
-    g :: Schema.CBOR -> (TxId, TxCBOR)
-    g Schema.CBOR{..} =
-        ( cborTxId
-        , TxCBOR (fromStrict cborTxCBOR) (toEnum $ fromIntegral cborTxEra)
-        )
+type TxCBORRaw = (BL.ByteString, Int)
+
+i :: Iso' (BL.ByteString, Int) (ByteString, Word16)
+i = iso (toStrict *** fromIntegral) (fromStrict *** fromIntegral)
+
+toTxCBOR :: (TxId, TxCBOR) -> (CBOR, TxCBORRaw)
+toTxCBOR (id', tx) =
+    let r = build eraValueSerialize tx
+    in (uncurry (CBOR id') $ r ^. i, r)
+
+fromTxCBOR :: CBOR -> Either (CBOR, TxCBORRaw ) (TxId, TxCBOR)
+fromTxCBOR s@(CBOR {..}) = bimap (s ,) (cborTxId ,) $
+    match eraValueSerialize $ (cborTxCBOR, cborTxEra) ^. fromIso i
 
 repsertCBORs :: TxCBORHistory -> SqlPersistT IO ()
 repsertCBORs (TxCBORHistory txs) =
     repsertMany
         [(fromJust keyFromRecordM x, x)
-        | x <- view txCBORiso <$> Map.assocs txs
+        | x <- fst . toTxCBOR <$> Map.assocs txs
         ]
 
+newtype  CBOROutOfEra = CBOROutOfEra TxCBORRaw
+    deriving (Show, Typeable)
+
+instance Exception CBOROutOfEra
+
 mkStoreCBOR :: Store (SqlPersistT IO) DeltaTxCBOR
 mkStoreCBOR = Store
-    { loadS = Right
-          . TxCBORHistory
-          . Map.fromList
-          . fmap (view (fromIso txCBORiso) . entityVal)
-          <$> selectList [] []
+    { loadS = do
+        cbors <- selectList [] []
+        pure $ first (SomeException . CBOROutOfEra . snd) $ do
+            ps <- mapM (fromTxCBOR . entityVal) cbors
+            pure . TxCBORHistory . Map.fromList $ ps
     , writeS = \txs -> do
           repsertCBORs txs
     , updateS = \_ -> \case
           Append addendum -> repsertCBORs addendum
-          DeleteTx tid -> deleteWhere [Schema.CborTxId ==. tid ]
+          DeleteTx tid -> deleteWhere [CborTxId ==. tid ]
     }

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

@@ -31,7 +31,7 @@ module Cardano.Wallet.Primitive.Types.Tx
     , LocalTxSubmissionStatus (..)
     , TxScriptValidity(..)
     , ScriptWitnessIndex (..)
-    , TxCBOR (..)
+    , TxCBOR
 
     -- * Serialisation
     , SealedTx (serialisedTx)
@@ -145,7 +145,7 @@ import Cardano.Wallet.Primitive.Types.Tx.Tx
 import Cardano.Wallet.Primitive.Types.Tx.TxMeta
     ( Direction (..), TxMeta (..), TxStatus (..), isPending )
 import Cardano.Wallet.Read.Tx.CBOR
-    ( TxCBOR (..) )
+    ( TxCBOR )
 import Data.Word
     ( Word64 )
 import GHC.Generics

lib/wallet/src/Cardano/Wallet/Read/Eras/EraFun.hs

@@ -124,8 +124,13 @@ infixr 9 *.**
 
 -- | Compose 2 EraFunI as a category, jumping the outer functorial layer in the
 -- output of the first one.
-(*.**) :: Functor w => EraFunI g h -> EraFunI f (w :.: g) -> EraFunI f (w :.: h)
-(*.**) = composeEraFunWith $ \f' g' -> Comp . fmap f' . unComp . g'
+(*.**) :: Functor w => EraFun g h -> EraFun f (w :.: g) -> EraFun f (w :.: h)
+f *.** g
+  = toEraFun
+  $ composeEraFunWith
+      (\f' g' -> Comp . fmap f' . unComp . g')
+      (fromEraFun f)
+      (fromEraFun g)
 
 -- | Compose 2 EraFunI as a category, keeping the outer layer in the
 -- output of the first one.

lib/wallet/src/Cardano/Wallet/Read/Primitive/Tx/Allegra.hs

@@ -11,10 +11,6 @@
 {-# LANGUAGE TypeFamilies #-}
 {-# LANGUAGE UndecidableInstances #-}
 
--- Orphan instances for {Encode,Decode}Address until we get rid of the
--- Jörmungandr dual support.
-{-# OPTIONS_GHC -fno-warn-orphans #-}
-
 -- |
 -- Copyright: © 2020 IOHK
 -- License: Apache-2.0
@@ -27,7 +23,9 @@ module Cardano.Wallet.Read.Primitive.Tx.Allegra
 import Prelude
 
 import Cardano.Api
-    ( AllegraEra, CardanoEra (..) )
+    ( AllegraEra )
+import Cardano.Wallet.Read.Eras
+    ( allegra, inject )
 import Cardano.Wallet.Read.Primitive.Tx.Shelley
     ( fromShelleyCert
     , fromShelleyCoin
@@ -39,7 +37,7 @@ import Cardano.Wallet.Read.Primitive.Tx.Shelley
 import Cardano.Wallet.Read.Tx
     ( Tx (..) )
 import Cardano.Wallet.Read.Tx.CBOR
-    ( getTxCBOR )
+    ( renderTxToCBOR )
 import Cardano.Wallet.Read.Tx.Hash
     ( shelleyTxHash )
 import Cardano.Wallet.Transaction
@@ -79,7 +77,7 @@ fromAllegraTx tx =
         { txId =
             shelleyTxHash tx
         , txCBOR =
-            Just $ getTxCBOR $ Tx AllegraEra tx
+            Just $ renderTxToCBOR $ inject allegra $ Tx tx
         , fee =
             Just $ fromShelleyCoin fee
         , resolvedInputs =

lib/wallet/src/Cardano/Wallet/Read/Primitive/Tx/Alonzo.hs

@@ -18,13 +18,15 @@ import Prelude
 import Cardano.Address.Script
     ( KeyRole (..) )
 import Cardano.Api
-    ( AlonzoEra, CardanoEra (..) )
+    ( AlonzoEra )
 import Cardano.Ledger.Era
     ( Era (..) )
 import Cardano.Ledger.Shelley.TxBody
     ( EraIndependentTxBody )
 import Cardano.Wallet.Primitive.Types.TokenPolicy
     ( TokenPolicyId )
+import Cardano.Wallet.Read.Eras
+    ( alonzo, inject )
 import Cardano.Wallet.Read.Primitive.Tx.Allegra
     ( fromLedgerTxValidity )
 import Cardano.Wallet.Read.Primitive.Tx.Mary
@@ -40,7 +42,7 @@ import Cardano.Wallet.Read.Primitive.Tx.Shelley
 import Cardano.Wallet.Read.Tx
     ( Tx (..) )
 import Cardano.Wallet.Read.Tx.CBOR
-    ( getTxCBOR )
+    ( renderTxToCBOR )
 import Cardano.Wallet.Read.Tx.Hash
     ( fromShelleyTxId )
 import Cardano.Wallet.Shelley.Compatibility.Ledger
@@ -105,7 +107,7 @@ fromAlonzoTx tx@(Alonzo.ValidatedTx bod wits (Alonzo.IsValid isValid) aux) =
         { txId =
             alonzoTxHash tx
         , txCBOR =
-            Just $ getTxCBOR $ Tx AlonzoEra tx
+            Just $ renderTxToCBOR $ inject alonzo $ Tx tx
         , fee =
             Just $ fromShelleyCoin fee
         , resolvedInputs =

lib/wallet/src/Cardano/Wallet/Read/Primitive/Tx/Babbage.hs

@@ -17,7 +17,7 @@ import Prelude
 import Cardano.Address.Script
     ( KeyRole (..) )
 import Cardano.Api
-    ( BabbageEra, CardanoEra (..) )
+    ( BabbageEra )
 import Cardano.Ledger.Era
     ( Era (..) )
 import Cardano.Ledger.Serialization
@@ -26,6 +26,8 @@ import Cardano.Ledger.Shelley.API
     ( StrictMaybe (SJust, SNothing) )
 import Cardano.Wallet.Primitive.Types.TokenPolicy
     ( TokenPolicyId )
+import Cardano.Wallet.Read.Eras
+    ( babbage, inject )
 import Cardano.Wallet.Read.Primitive.Tx.Allegra
     ( fromLedgerTxValidity )
 import Cardano.Wallet.Read.Primitive.Tx.Alonzo
@@ -43,7 +45,7 @@ import Cardano.Wallet.Read.Primitive.Tx.Shelley
 import Cardano.Wallet.Read.Tx
     ( Tx (..) )
 import Cardano.Wallet.Read.Tx.CBOR
-    ( getTxCBOR )
+    ( renderTxToCBOR )
 import Cardano.Wallet.Shelley.Compatibility.Ledger
     ( toWalletScript, toWalletTokenPolicyId )
 import Cardano.Wallet.Transaction
@@ -89,7 +91,7 @@ fromBabbageTx tx@(Alonzo.ValidatedTx bod wits (Alonzo.IsValid isValid) aux) =
         { txId =
             alonzoTxHash tx
         , txCBOR =
-            Just $ getTxCBOR $ Tx BabbageEra tx
+            Just $ renderTxToCBOR $ inject babbage $ Tx tx
         , fee =
             Just $ fromShelleyCoin fee
         , resolvedInputs =

lib/wallet/src/Cardano/Wallet/Read/Primitive/Tx/Byron.hs

@@ -5,29 +5,29 @@
 -- Copyright: © 2020 IOHK
 -- License: Apache-2.0
 --
--- Conversion functions and static chain settings for Byron.
 
 module Cardano.Wallet.Read.Primitive.Tx.Byron
     (
     fromTxAux
     , fromTxIn
     , fromTxOut
-    ) where
+    )
+    where
 
 import Prelude
 
-import Cardano.Api
-    ( CardanoEra (ByronEra) )
 import Cardano.Binary
     ( serialize' )
 import Cardano.Chain.Common
     ( unsafeGetLovelace )
 import Cardano.Chain.UTxO
     ( ATxAux (..), Tx (..), TxIn (..), TxOut (..), taTx )
+import Cardano.Wallet.Read.Eras
+    ( byron, inject )
 import Cardano.Wallet.Read.Tx
     ( Tx (..) )
 import Cardano.Wallet.Read.Tx.CBOR
-    ( getTxCBOR )
+    ( renderTxToCBOR )
 import Cardano.Wallet.Read.Tx.Hash
     ( byronTxHash )
 
@@ -45,7 +45,7 @@ fromTxAux txAux = case taTx txAux of
     UnsafeTx inputs outputs _attributes -> W.Tx
         { txId = byronTxHash txAux
 
-        , txCBOR = Just $ getTxCBOR $ Tx ByronEra $ () <$ txAux
+        , txCBOR = Just $ renderTxToCBOR $ inject byron $ Tx $ () <$ txAux
 
         , fee = Nothing
 

lib/wallet/src/Cardano/Wallet/Read/Primitive/Tx/Mary.hs

@@ -17,13 +17,15 @@ import Prelude
 import Cardano.Address.Script
     ( KeyRole (..) )
 import Cardano.Api
-    ( CardanoEra (..), MaryEra )
+    ( MaryEra )
 import Cardano.Ledger.Era
     ( Era (..) )
 import Cardano.Wallet.Primitive.Types.TokenMap
     ( TokenMap, toNestedList )
 import Cardano.Wallet.Primitive.Types.TokenPolicy
     ( TokenPolicyId )
+import Cardano.Wallet.Read.Eras
+    ( inject, mary )
 import Cardano.Wallet.Read.Primitive.Tx.Allegra
     ( fromLedgerTxValidity )
 import Cardano.Wallet.Read.Primitive.Tx.Shelley
@@ -37,7 +39,7 @@ import Cardano.Wallet.Read.Primitive.Tx.Shelley
 import Cardano.Wallet.Read.Tx
     ( Tx (..) )
 import Cardano.Wallet.Read.Tx.CBOR
-    ( getTxCBOR )
+    ( renderTxToCBOR )
 import Cardano.Wallet.Read.Tx.Hash
     ( shelleyTxHash )
 import Cardano.Wallet.Shelley.Compatibility.Ledger
@@ -99,7 +101,7 @@ fromMaryTx tx =
         { txId =
             shelleyTxHash tx
         , txCBOR =
-            Just $ getTxCBOR $ Tx MaryEra tx
+            Just $ renderTxToCBOR $ inject mary $ Tx tx
         , fee =
             Just $ fromShelleyCoin fee
         , resolvedInputs =