Skip to content

Commit

Permalink
Fix some warnings mostly in Shelley.TransactionSpec
Browse files Browse the repository at this point in the history
  • Loading branch information
@Anviking @erikd
Anviking authored and erikd committed Mar 16, 2023
1 parent 6092b70 commit 7fa8135
Show file tree
Hide file tree
Showing 3 changed files with 90 additions and 37 deletions.
12 changes: 4 additions & 8 deletions lib/wallet/src/Cardano/Wallet/Write/Tx.hs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -753,6 +753,7 @@ txBody
:: RecentEra era
-> Core.Tx (ShelleyLedgerEra era)
-> Core.TxBody (ShelleyLedgerEra era)
txBody RecentEraConway = Alonzo.body
txBody RecentEraBabbage = Alonzo.body -- same type for babbage
txBody RecentEraAlonzo = Alonzo.body

Expand All @@ -761,6 +762,7 @@ outputs
:: RecentEra era
-> Core.TxBody (ShelleyLedgerEra era)
-> [TxOut (ShelleyLedgerEra era)]
outputs RecentEraConway = map sizedValue . toList . Babbage.outputs
outputs RecentEraBabbage = map sizedValue . toList . Babbage.outputs
outputs RecentEraAlonzo = toList . Alonzo.outputs

Expand Down Expand Up @@ -821,21 +823,14 @@ toCardanoUTxO
:: forall era. IsRecentEra era
=> Shelley.UTxO (ShelleyLedgerEra era)
-> Cardano.UTxO era
toCardanoUTxO = withConstraints $
toCardanoUTxO = withStandardCryptoConstraint (recentEra @era) $
Cardano.UTxO
. Map.mapKeys Cardano.fromShelleyTxIn
. Map.map (Cardano.fromShelleyTxOut (shelleyBasedEra @era))
. unUTxO
where
unUTxO (Shelley.UTxO m) = m

withConstraints
:: ((Crypto (Cardano.ShelleyLedgerEra era) ~ StandardCrypto) => a)
-> a
withConstraints a = case recentEra @era of
RecentEraBabbage -> a
RecentEraAlonzo -> a

fromCardanoUTxO
:: forall era. IsRecentEra era
=> Cardano.UTxO era
Expand All @@ -853,6 +848,7 @@ toCardanoValue
=> Core.Value (ShelleyLedgerEra era)
-> Cardano.Value
toCardanoValue = case recentEra @era of
RecentEraConway -> Cardano.fromMaryValue
RecentEraBabbage -> Cardano.fromMaryValue
RecentEraAlonzo -> Cardano.fromMaryValue

Expand Down
2 changes: 1 addition & 1 deletion lib/wallet/test/unit/Cardano/Wallet/DB/StateMachine.hs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -305,7 +305,7 @@ newtype MWid = MWid String
unMockWid :: MWid -> WalletId
unMockWid (MWid wid) = WalletId m
where
Just m = digestFromByteString spliced
m = fromJust $ digestFromByteString spliced
spliced = wid' <> B8.drop (B8.length wid') hashed
hashed = BA.convert (hash wid' :: Digest Blake2b_160)
wid' = B8.pack wid
Expand Down
113 changes: 85 additions & 28 deletions lib/wallet/test/unit/Cardano/Wallet/Shelley/TransactionSpec.hs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -1496,6 +1496,7 @@ feeEstimationRegressionSpec = describe "Regression tests" $ do
binaryCalculationsSpec :: AnyRecentEra -> Spec
binaryCalculationsSpec (AnyRecentEra era) =
case era of
RecentEraConway -> binaryCalculationsSpec' @Cardano.ConwayEra era
RecentEraAlonzo -> binaryCalculationsSpec' @Cardano.AlonzoEra era
RecentEraBabbage -> binaryCalculationsSpec' @Cardano.BabbageEra era

Expand Down Expand Up @@ -1543,6 +1544,21 @@ binaryCalculationsSpec' era = describe ("calculateBinary - "+||era||+"") $ do
[ TxOut (dummyAddress 2) (coinToBundle amtChange)
]
let binary = case era of
RecentEraConway -> mconcat
[ "84a400818258200000000000000000000000000000000000000000"
, "000000000000000000000000000182a20058390101010101010101"
, "010101010101010101010101010101010101010101010101010101"
, "01010101010101010101010101010101010101010101011a001e84"
, "80a200583901020202020202020202020202020202020202020202"
, "020202020202020202020202020202020202020202020202020202"
, "0202020202020202011a0078175c021a0001faa403191e46a10281"
, "845820010000000000000000000000000000000000000000000000"
, "000000000000000058407154db81463825f150bb3b9b0824caf151"
, "3716f73498afe61d917a5621912a2b3df252bea14683a9ee56710d"
, "483a53a5aa35247e0d2b80e6300f7bdec763a20458200000000000"
, "000000000000000000000000000000000000000000000000000000"
, "41a0f5f6"
]
RecentEraBabbage -> mconcat
[ "84a400818258200000000000000000000000000000000000000000"
, "000000000000000000000000000182a20058390101010101010101"
Expand Down Expand Up @@ -1597,6 +1613,30 @@ binaryCalculationsSpec' era = describe ("calculateBinary - "+||era||+"") $ do
[ TxOut (dummyAddress 4) (coinToBundle amtChange)
]
let binary = case era of
RecentEraConway -> mconcat
[ "84a400828258200000000000000000000000000000000000000000"
, "000000000000000000000000008258200000000000000000000000"
, "000000000000000000000000000000000000000000010183a20058"
, "390102020202020202020202020202020202020202020202020202"
, "020202020202020202020202020202020202020202020202020202"
, "02020202011a005b8d80a200583901030303030303030303030303"
, "030303030303030303030303030303030303030303030303030303"
, "0303030303030303030303030303030303011a005b8d80a2005839"
, "010404040404040404040404040404040404040404040404040404"
, "040404040404040404040404040404040404040404040404040404"
, "040404011a007801e0021a0002102003191e46a102828458200100"
, "000000000000000000000000000000000000000000000000000000"
, "00000058401a8667d2d0af4e24d4d385443002f1e9036063bdb7c6"
, "2d45447a2e176ded81a11683bd944c6d7db6e5fd886840025f6319"
, "2a382e526f4150e2b336ee9ed80808582000000000000000000000"
, "0000000000000000000000000000000000000000000041a0845820"
, "130ae82201d7072e6fbfc0a1884fb54636554d14945b799125cf7c"
, "e38d477f515840320ed7d1513b0f1b61381f7942a07b627b246c85"
, "a13b2623e4868ea82488c778a7760124f3a17f924c08d425c0717d"
, "f6cd898eb4ab8439a16e08befdc415120e58200101010101010101"
, "01010101010101010101010101010101010101010101010141a0f5"
, "f6"
]
RecentEraBabbage -> mconcat
[ "84a400828258200000000000000000000000000000000000000000"
, "000000000000000000000000008258200000000000000000000000"
Expand Down Expand Up @@ -1666,6 +1706,21 @@ binaryCalculationsSpec' era = describe ("calculateBinary - "+||era||+"") $ do
[ TxOut (dummyAddress 2) (coinToBundle amtChange)
]
let binary = case era of
RecentEraConway -> mconcat
[ "84a400818258200000000000000000000000000000000000000000"
, "000000000000000000000000000182a20058390101010101010101"
, "010101010101010101010101010101010101010101010101010101"
, "01010101010101010101010101010101010101010101011a001e84"
, "80a200583901020202020202020202020202020202020202020202"
, "020202020202020202020202020202020202020202020202020202"
, "0202020202020202011a0078175c021a0001faa403191e46a10281"
, "845820010000000000000000000000000000000000000000000000"
, "000000000000000058407154db81463825f150bb3b9b0824caf151"
, "3716f73498afe61d917a5621912a2b3df252bea14683a9ee56710d"
, "483a53a5aa35247e0d2b80e6300f7bdec763a20458200000000000"
, "000000000000000000000000000000000000000000000000000000"
, "44a1024100f5f6"
]
RecentEraBabbage -> mconcat
[ "84a400818258200000000000000000000000000000000000000000"
, "000000000000000000000000000182a20058390101010101010101"
Expand Down Expand Up @@ -1721,30 +1776,6 @@ binaryCalculationsSpec' era = describe ("calculateBinary - "+||era||+"") $ do
[ TxOut (dummyAddress 4) (coinToBundle amtChange)
]
let binary = case era of
RecentEraBabbage -> mconcat
[ "84a400828258200000000000000000000000000000000000000000"
, "000000000000000000000000008258200000000000000000000000"
, "000000000000000000000000000000000000000000010183a20058"
, "390102020202020202020202020202020202020202020202020202"
, "020202020202020202020202020202020202020202020202020202"
, "02020202011a005b8d80a200583901030303030303030303030303"
, "030303030303030303030303030303030303030303030303030303"
, "0303030303030303030303030303030303011a005b8d80a2005839"
, "010404040404040404040404040404040404040404040404040404"
, "040404040404040404040404040404040404040404040404040404"
, "040404011a007801e0021a0002102003191e46a10282845820130a"
, "e82201d7072e6fbfc0a1884fb54636554d14945b799125cf7ce38d"
, "477f515840320ed7d1513b0f1b61381f7942a07b627b246c85a13b"
, "2623e4868ea82488c778a7760124f3a17f924c08d425c0717df6cd"
, "898eb4ab8439a16e08befdc415120e582001010101010101010101"
, "0101010101010101010101010101010101010101010144a1024100"
, "845820010000000000000000000000000000000000000000000000"
, "000000000000000058401a8667d2d0af4e24d4d385443002f1e903"
, "6063bdb7c62d45447a2e176ded81a11683bd944c6d7db6e5fd8868"
, "40025f63192a382e526f4150e2b336ee9ed8080858200000000000"
, "000000000000000000000000000000000000000000000000000000"
, "44a1024100f5f6"
]
RecentEraAlonzo -> mconcat
[ "84a400828258200000000000000000000000000000000000000000"
, "000000000000000000000000008258200000000000000000000000"
Expand All @@ -1769,6 +1800,30 @@ binaryCalculationsSpec' era = describe ("calculateBinary - "+||era||+"") $ do
, "00000000000000000000000000000000000000000044a1024100f5"
, "f6"
]
_ -> mconcat
[ "84a400828258200000000000000000000000000000000000000000"
, "000000000000000000000000008258200000000000000000000000"
, "000000000000000000000000000000000000000000010183a20058"
, "390102020202020202020202020202020202020202020202020202"
, "020202020202020202020202020202020202020202020202020202"
, "02020202011a005b8d80a200583901030303030303030303030303"
, "030303030303030303030303030303030303030303030303030303"
, "0303030303030303030303030303030303011a005b8d80a2005839"
, "010404040404040404040404040404040404040404040404040404"
, "040404040404040404040404040404040404040404040404040404"
, "040404011a007801e0021a0002102003191e46a10282845820130a"
, "e82201d7072e6fbfc0a1884fb54636554d14945b799125cf7ce38d"
, "477f515840320ed7d1513b0f1b61381f7942a07b627b246c85a13b"
, "2623e4868ea82488c778a7760124f3a17f924c08d425c0717df6cd"
, "898eb4ab8439a16e08befdc415120e582001010101010101010101"
, "0101010101010101010101010101010101010101010144a1024100"
, "845820010000000000000000000000000000000000000000000000"
, "000000000000000058401a8667d2d0af4e24d4d385443002f1e903"
, "6063bdb7c62d45447a2e176ded81a11683bd944c6d7db6e5fd8868"
, "40025f63192a382e526f4150e2b336ee9ed8080858200000000000"
, "000000000000000000000000000000000000000000000000000000"
, "44a1024100f5f6"
]
calculateBinary net utxo outs chgs pairs `shouldBe` binary

where
Expand All @@ -1782,7 +1837,7 @@ binaryCalculationsSpec' era = describe ("calculateBinary - "+||era||+"") $ do
mkByronWitness @era unsignedTx net addr
addrWits = zipWith (mkByronWitness' unsigned) inps pairs
fee = toCardanoLovelace $ selectionDelta TxOut.coin cs
Right unsigned =
unsigned = either (error . show) id $
mkUnsignedTx (shelleyBasedEraFromRecentEra era)
(Nothing, slotNo) (Right cs) md mempty [] fee
TokenMap.empty TokenMap.empty Map.empty Map.empty
Expand Down Expand Up @@ -1873,7 +1928,7 @@ makeShelleyTx era testCase = Cardano.makeSignedTransaction addrWits unsigned
DecodeSetup utxo outs md slotNo pairs _netwk = testCase
inps = Map.toList $ unUTxO utxo
fee = toCardanoLovelace $ selectionDelta TxOut.coin cs
Right unsigned =
unsigned = either (error . show) id $
mkUnsignedTx era (Nothing, slotNo) (Right cs) md mempty [] fee
TokenMap.empty TokenMap.empty Map.empty Map.empty
addrWits = map (mkShelleyWitness unsigned) pairs
Expand Down Expand Up @@ -3073,8 +3128,10 @@ prop_distributeSurplus_onSuccess_increasesValuesByDelta =
prop_distributeSurplus_onSuccess $ \policy surplus
(TxFeeAndChange feeOriginal changeOriginal)
(TxFeeAndChange feeModified changeModified) ->
let Right (TxFeeAndChange feeDelta changeDeltas) =
distributeSurplusDelta policy surplus $ TxFeeAndChange
let (TxFeeAndChange feeDelta changeDeltas) =
either (error . show) id
$ distributeSurplusDelta policy surplus
$ TxFeeAndChange
(feeOriginal)
(TxOut.coin <$> changeOriginal)
in
Expand Down

0 comments on commit 7fa8135

Please sign in to comment.