fixups

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

@@ -1465,11 +1465,12 @@ toCardanoUTxO era = Cardano.UTxO
     . Map.toList
     . W.unUTxO
 
-fromCardanoUTxO :: IsCardanoEra era => Cardano.UTxO era -> W.UTxO
-fromCardanoUTxO (Cardano.UTxO map) = W.UTxO
+fromCardanoUTxO
+    :: (IsCardanoEra era, Typeable era) => Cardano.UTxO era -> W.UTxO
+fromCardanoUTxO (Cardano.UTxO u) = W.UTxO
     . Map.mapKeys fromCardanoTxIn
     . Map.map fromCardanoTxOut
-    $ map
+    $ u
 
 toCardanoTxOut :: ShelleyBasedEra era -> W.TxOut -> Cardano.TxOut ctx era
 toCardanoTxOut era = case era of

lib/wallet/src/Cardano/Wallet/Write/Tx/Gen.hs

@@ -19,6 +19,10 @@ import Prelude
 
 import Cardano.Ledger.Alonzo.Data
     ( Data (..), dataToBinaryData )
+import Cardano.Ledger.BaseTypes
+    ( StrictMaybe (..) )
+import Cardano.Ledger.Coin
+    ( Coin (..) )
 import Cardano.Wallet.Write.Tx
     ( BinaryData
     , Datum (..)
@@ -62,10 +66,7 @@ import qualified Cardano.Api.Gen as Cardano
 import qualified Cardano.Api.Shelley as Cardano
 import qualified Cardano.Ledger.Alonzo.TxBody as Alonzo
 import qualified Cardano.Ledger.Babbage.TxBody as Babbage
-import Cardano.Ledger.BaseTypes
-    ( StrictMaybe (..) )
-import Cardano.Ledger.Coin
-    ( Coin (..) )
+import qualified Cardano.Ledger.Conway.TxBody as Conway
 import qualified Data.ByteString as BS
 import qualified PlutusLedgerApi.V1 as PV1
 
@@ -93,7 +94,7 @@ genBinaryData = dataToBinaryData . Data <$> scale (`div` 10) (sized gendata)
         ]
     gendata _ = oneof [PV1.I <$> arbitrary, PV1.B <$> genByteString]
 
-shrinkDatum :: Datum LatestLedgerEra -> [Datum LatestLedgerEra]
+shrinkDatum :: Datum era -> [Datum era]
 shrinkDatum (Datum x) = NoDatum : map Datum (shrinkBinaryData x)
 shrinkDatum (DatumHash _) = [NoDatum]
 shrinkDatum NoDatum = []
@@ -121,39 +122,42 @@ genTxOut era = Cardano.toShelleyTxOut (shelleyBasedEraFromRecentEra era)
     <$> Cardano.genTxOut (cardanoEraFromRecentEra era)
 
 shrinkValue
-    :: RecentEra era
-    -> Value (Cardano.ShelleyLedgerEra era)
-    -> [Value (Cardano.ShelleyLedgerEra era)]
-shrinkValue era v = withStandardCryptoConstraint era $ tail
+    :: Value StandardCrypto
+    -> [Value StandardCrypto]
+shrinkValue v = tail
     [ modifyCoin (const c') v
-    | c' <- prepend shrinkCoin (coin v)
+    | c' <- withOriginal shrinkCoin (coin v)
     ]
   where
-    prepend shrinker = \x -> x : shrinker x
     shrinkCoin (Coin c) = map Coin $ shrink c
 
 shrinkTxOut
     :: RecentEra era
     -> TxOut (Cardano.ShelleyLedgerEra era)
     -> [TxOut (Cardano.ShelleyLedgerEra era)]
-shrinkTxOut era@RecentEraBabbage (Babbage.TxOut addr value datum script) = tail
-    [ Babbage.TxOut addr' value' datum' script'
-    | addr' <- prepend (const []) addr
-    , value' <- prepend (shrinkValue era) value
-    , datum' <- prepend shrinkDatum datum
-    , script' <- prepend shrinkStrictMaybe script
+shrinkTxOut RecentEraConway (Conway.BabbageTxOut addr value datum script) = tail
+    [ Conway.BabbageTxOut addr' value' datum' script'
+    | addr' <- withOriginal (const []) addr
+    , value' <- withOriginal shrinkValue value
+    , datum' <- withOriginal shrinkDatum datum
+    , script' <- withOriginal shrinkStrictMaybe script
     ]
-  where
-    prepend shrinker = \x -> x : shrinker x
-shrinkTxOut era@RecentEraAlonzo (Alonzo.TxOut addr value datum) = tail
-    [ Alonzo.TxOut addr' value' datum'
-    | addr' <- prepend (const []) addr
-    , value' <- prepend (shrinkValue era) value
-    , datum' <- prepend shrinkStrictMaybe datum
+shrinkTxOut RecentEraBabbage (Babbage.BabbageTxOut addr value datum script) = tail
+    [ Babbage.BabbageTxOut addr' value' datum' script'
+    | addr' <- withOriginal (const []) addr
+    , value' <- withOriginal shrinkValue value
+    , datum' <- withOriginal shrinkDatum datum
+    , script' <- withOriginal shrinkStrictMaybe script
+    ]
+shrinkTxOut RecentEraAlonzo (Alonzo.AlonzoTxOut addr value datum) = tail
+    [ Alonzo.AlonzoTxOut addr' value' datum'
+    | addr' <- withOriginal (const []) addr
+    , value' <- withOriginal shrinkValue value
+    , datum' <- withOriginal shrinkStrictMaybe datum
     ]
-  where
-    prepend shrinker = \x -> x : shrinker x
 
+withOriginal :: (a -> [a]) -> (a -> [a])
+withOriginal shrinker x = x : shrinker x
 
 shrinkStrictMaybe :: StrictMaybe a -> [StrictMaybe a]
 shrinkStrictMaybe x = case x of