From b90ee76c14abb8d68c670fd7777322e683bc0f9f Mon Sep 17 00:00:00 2001 From: Rodney Lorrimar Date: Fri, 10 Jul 2020 22:08:27 +1000 Subject: [PATCH 1/9] hydra: Prevent caching of shelley integration test failures Causes integration tests to be re-run whenever the git revision changes, even if everything else is identical. Since these tests tend to fail a lot, we don't want to cache false failures. Also increase the minimum severity for integration test logging, because debug level produces quite a lot of output. --- default.nix | 2 +- nix/haskell.nix | 15 +++++++++++---- 2 files changed, 12 insertions(+), 5 deletions(-) diff --git a/default.nix b/default.nix index 3ffc6750046..65d80292c3d 100644 --- a/default.nix +++ b/default.nix @@ -70,7 +70,7 @@ let haskellPackages = import ./nix/haskell.nix { inherit config lib stdenv pkgs buildPackages; inherit (pkgs) haskell-nix; - inherit src pr; + inherit src pr gitrev; }; filterCardanoPackages = lib.filterAttrs (_: package: isCardanoWallet package); diff --git a/nix/haskell.nix b/nix/haskell.nix index 15f445ebe0d..05fa402f0e0 100644 --- a/nix/haskell.nix +++ b/nix/haskell.nix @@ -13,13 +13,13 @@ , src # GitHub PR number (when building on Hydra) , pr ? null +# Git revision of sources +, gitrev ? null }: let haskell = pkgs.haskell-nix; jmPkgs = pkgs.jmPkgs; - # commonLib = (import ./default.nix {}).commonLib; # option a - shorter - inherit (import ./default.nix {}) commonLib; # option b - even shorter # our packages stack-pkgs = import ./.stack.nix/default.nix; @@ -100,8 +100,15 @@ let integration.preCheck = lib.optionalString stdenv.isDarwin '' export TMPDIR=/tmp '' + '' - export CARDANO_WALLET_TRACING_MIN_SEVERITY=debug - export CARDANO_NODE_TRACING_MIN_SEVERITY=info + # Variables picked up by integration tests + export CARDANO_WALLET_TRACING_MIN_SEVERITY=info + export CARDANO_NODE_TRACING_MIN_SEVERITY=notice + + # Causes integration tests to be re-run whenever the git revision + # changes, even if everything else is identical. + # Since these tests tend to fail a lot, we don't want + # to cache false failures. + echo "Git revision is ${toString gitrev}" ''; # provide cardano-node & cardano-cli to tests From 50ac04636bea108ead72b235613269fc1a0f7b7a Mon Sep 17 00:00:00 2001 From: KtorZ Date: Wed, 8 Jul 2020 17:34:30 +0200 Subject: [PATCH 2/9] factor out common code in database migration Turns out that adding column is a pretty common and straighfordward migration. I originally intended to add a new column to the TxMeta table, hence the refactor. In the end, I've used a different table for withdrawals, but the refactor is still worth it as it is IMO. --- lib/core/src/Cardano/Wallet/DB/Sqlite.hs | 61 +++++++++++------------- 1 file changed, 27 insertions(+), 34 deletions(-) diff --git a/lib/core/src/Cardano/Wallet/DB/Sqlite.hs b/lib/core/src/Cardano/Wallet/DB/Sqlite.hs index be59e864895..85a89eca10c 100644 --- a/lib/core/src/Cardano/Wallet/DB/Sqlite.hs +++ b/lib/core/src/Cardano/Wallet/DB/Sqlite.hs @@ -420,25 +420,9 @@ migrateManually tr defaultFieldValues = -- it is missing. -- addActiveSlotCoefficientIfMissing :: Sqlite.Connection -> IO () - addActiveSlotCoefficientIfMissing conn = do - isFieldPresent conn activeSlotCoeff >>= \case - TableMissing -> - traceWith tr $ MsgManualMigrationNotNeeded activeSlotCoeff - ColumnMissing -> do - traceWith tr $ MsgManualMigrationNeeded activeSlotCoeff value - addColumn <- Sqlite.prepare conn $ T.unwords - [ "ALTER TABLE", tableName activeSlotCoeff - , "ADD COLUMN", fieldName activeSlotCoeff - , fieldType activeSlotCoeff, "NOT NULL", "DEFAULT", value - , ";" - ] - _ <- Sqlite.step addColumn - Sqlite.finalize addColumn - ColumnPresent -> - traceWith tr $ MsgManualMigrationNotNeeded activeSlotCoeff - + addActiveSlotCoefficientIfMissing conn = + addColumn conn (DBField CheckpointActiveSlotCoeff) value where - activeSlotCoeff = DBField CheckpointActiveSlotCoeff value = toText $ W.unActiveSlotCoefficient $ defaultActiveSlotCoefficient defaultFieldValues @@ -448,23 +432,8 @@ migrateManually tr defaultFieldValues = -- addDesiredPoolNumberIfMissing :: Sqlite.Connection -> IO () addDesiredPoolNumberIfMissing conn = do - isFieldPresent conn desiredPoolNumber >>= \case - TableMissing -> - traceWith tr $ MsgManualMigrationNotNeeded desiredPoolNumber - ColumnMissing -> do - traceWith tr $ MsgManualMigrationNeeded desiredPoolNumber value - addColumn <- Sqlite.prepare conn $ T.unwords - [ "ALTER TABLE", tableName desiredPoolNumber - , "ADD COLUMN", fieldName desiredPoolNumber - , fieldType desiredPoolNumber, "NOT NULL", "DEFAULT", value - , ";" - ] - _ <- Sqlite.step addColumn - Sqlite.finalize addColumn - ColumnPresent -> - traceWith tr $ MsgManualMigrationNotNeeded desiredPoolNumber + addColumn conn (DBField ProtocolParametersDesiredNumberOfPools) value where - desiredPoolNumber = DBField ProtocolParametersDesiredNumberOfPools value = T.pack $ show $ defaultDesiredNumberOfPool defaultFieldValues -- | This table became @protocol_parameters@. @@ -491,6 +460,30 @@ migrateManually tr defaultFieldValues = | otherwise -> ColumnMissing _ -> TableMissing + -- | A migration for adding a non-existing column to a table. Factor out as + -- it's a common use-case. + addColumn + :: Sqlite.Connection + -> DBField + -> Text + -> IO () + addColumn conn field value = do + isFieldPresent conn field >>= \case + TableMissing -> + traceWith tr $ MsgManualMigrationNotNeeded field + ColumnMissing -> do + traceWith tr $ MsgManualMigrationNeeded field value + query <- Sqlite.prepare conn $ T.unwords + [ "ALTER TABLE", tableName field + , "ADD COLUMN", fieldName field + , fieldType field, "NOT NULL", "DEFAULT", value + , ";" + ] + _ <- Sqlite.step query + Sqlite.finalize query + ColumnPresent -> + traceWith tr $ MsgManualMigrationNotNeeded field + -- | A set of default field values that can be consulted when performing a -- database migration. -- From 3f9005aa29ccf76cb5bcc0ffe49833ebbdc4a45f Mon Sep 17 00:00:00 2001 From: KtorZ Date: Wed, 8 Jul 2020 17:35:06 +0200 Subject: [PATCH 3/9] add withdrawals to API & core transaction data types Still to be done: withdrawals must be discovered when processing blocks --- lib/core/src/Cardano/Wallet/Api/Server.hs | 31 ++- lib/core/src/Cardano/Wallet/Api/Types.hs | 60 ++++- lib/core/src/Cardano/Wallet/DB/Model.hs | 2 + lib/core/src/Cardano/Wallet/DB/Sqlite.hs | 84 ++++-- lib/core/src/Cardano/Wallet/DB/Sqlite/TH.hs | 12 + .../src/Cardano/Wallet/DB/Sqlite/Types.hs | 31 +++ .../src/Cardano/Wallet/Primitive/Types.hs | 24 +- .../Api/ApiTransactionTestnet0.faulty.json | 245 ++++++++++++++++++ 8 files changed, 454 insertions(+), 35 deletions(-) create mode 100644 lib/core/test/data/Cardano/Wallet/Api/ApiTransactionTestnet0.faulty.json diff --git a/lib/core/src/Cardano/Wallet/Api/Server.hs b/lib/core/src/Cardano/Wallet/Api/Server.hs index 503a3905be0..625a78f0522 100644 --- a/lib/core/src/Cardano/Wallet/Api/Server.hs +++ b/lib/core/src/Cardano/Wallet/Api/Server.hs @@ -180,6 +180,7 @@ import Cardano.Wallet.Api.Types , ApiWalletMigrationPostData (..) , ApiWalletPassphrase (..) , ApiWalletPassphraseInfo (..) + , ApiWithdrawal (..) , ByronWalletFromXPrvPostData , ByronWalletPostData (..) , ByronWalletPutPassphraseData (..) @@ -309,6 +310,8 @@ import Data.Generics.Labels () import Data.List ( isInfixOf, isSubsequenceOf, sortOn ) +import Data.Map.Strict + ( Map ) import Data.Maybe ( fromMaybe, isJust ) import Data.Proxy @@ -1147,6 +1150,7 @@ postTransaction ctx genChange (ApiT wid) withdrawRewards body = do (txId tx) (fmap Just <$> selection ^. #inputs) (tx ^. #outputs) + (tx ^. #withdrawals) (meta, time) #pendingSince @@ -1194,13 +1198,13 @@ getTransaction ctx (ApiT wid) (ApiTxId (ApiT (tid))) = do -- Populate an API transaction record with 'TransactionInfo' from the wallet -- layer. mkApiTransactionFromInfo :: TransactionInfo -> ApiTransaction n -mkApiTransactionFromInfo (TransactionInfo txid ins outs meta depth txtime) = +mkApiTransactionFromInfo (TransactionInfo txid ins outs ws meta depth txtime) = case meta ^. #status of Pending -> apiTx InLedger -> apiTx { depth = Just depth } where drop2nd (a,_,c) = (a,c) - apiTx = mkApiTransaction txid (drop2nd <$> ins) outs (meta, txtime) $ + apiTx = mkApiTransaction txid (drop2nd <$> ins) outs ws (meta, txtime) $ case meta ^. #status of Pending -> #pendingSince InLedger -> #insertedAt @@ -1262,6 +1266,7 @@ joinStakePool ctx knownPools apiPoolId (ApiT wid) body = do (txId tx) (second (const Nothing) <$> tx ^. #resolvedInputs) (tx ^. #outputs) + (tx ^. #withdrawals) (txMeta, txTime) #pendingSince @@ -1301,6 +1306,7 @@ quitStakePool ctx (ApiT wid) body = do (txId tx) (second (const Nothing) <$> tx ^. #resolvedInputs) (tx ^. #outputs) + (tx ^. #withdrawals) (txMeta, txTime) #pendingSince @@ -1362,6 +1368,7 @@ migrateWallet ctx (ApiT wid) migrateData = do (txId tx) (fmap Just <$> NE.toList (W.unsignedInputs cs)) (NE.toList (W.unsignedOutputs cs)) + (tx ^. #withdrawals) (meta, time) #pendingSince where @@ -1567,10 +1574,11 @@ mkApiTransaction Hash "Tx" -> [(TxIn, Maybe TxOut)] -> [TxOut] + -> Map ChimericAccount Coin -> (W.TxMeta, UTCTime) -> Lens' (ApiTransaction n) (Maybe ApiTimeReference) -> ApiTransaction n -mkApiTransaction txid ins outs (meta, timestamp) setTimeReference = +mkApiTransaction txid ins outs ws (meta, timestamp) setTimeReference = tx & setTimeReference .~ Just timeReference where tx :: ApiTransaction n @@ -1583,6 +1591,7 @@ mkApiTransaction txid ins outs (meta, timestamp) setTimeReference = , direction = ApiT (meta ^. #direction) , inputs = [ApiTxInput (fmap toAddressAmount o) (ApiT i) | (i, o) <- ins] , outputs = toAddressAmount <$> outs + , withdrawals = mkApiWithdrawal @n <$> Map.toList ws , status = ApiT (meta ^. #status) } @@ -1597,8 +1606,20 @@ mkApiTransaction txid ins outs (meta, timestamp) setTimeReference = } toAddressAmount :: TxOut -> AddressAmount (ApiT Address, Proxy n) - toAddressAmount (TxOut addr (Coin c)) = - AddressAmount (ApiT addr, Proxy @n) (Quantity $ fromIntegral c) + toAddressAmount (TxOut addr c) = + AddressAmount (ApiT addr, Proxy @n) (mkApiCoin c) + +mkApiCoin + :: Coin + -> Quantity "lovelace" Natural +mkApiCoin (Coin c) = Quantity $ fromIntegral c + +mkApiWithdrawal + :: forall (n :: NetworkDiscriminant). () + => (ChimericAccount, Coin) + -> ApiWithdrawal n +mkApiWithdrawal (acct, c) = + ApiWithdrawal (ApiT acct, Proxy @n) (mkApiCoin c) coerceCoin :: forall (n :: NetworkDiscriminant). AddressAmount (ApiT Address, Proxy n) -> TxOut coerceCoin (AddressAmount (ApiT addr, _) (Quantity c)) = diff --git a/lib/core/src/Cardano/Wallet/Api/Types.hs b/lib/core/src/Cardano/Wallet/Api/Types.hs index 29333bf20f0..c7168d4a167 100644 --- a/lib/core/src/Cardano/Wallet/Api/Types.hs +++ b/lib/core/src/Cardano/Wallet/Api/Types.hs @@ -13,6 +13,7 @@ {-# LANGUAGE OverloadedLabels #-} {-# LANGUAGE PolyKinds #-} {-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE StandaloneDeriving #-} {-# LANGUAGE TypeApplications #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE UndecidableInstances #-} @@ -80,6 +81,7 @@ module Cardano.Wallet.Api.Types , ApiWalletMigrationPostData (..) , ApiWalletMigrationInfo (..) , ApiWithdrawRewards (..) + , ApiWithdrawal (..) -- * API Types (Byron) , ApiByronWallet (..) @@ -100,6 +102,8 @@ module Cardano.Wallet.Api.Types -- * User-Facing Address Encoding/Decoding , EncodeAddress (..) , DecodeAddress (..) + , EncodeStakeAddress (..) + , DecodeStakeAddress (..) -- * Polymorphic Types , ApiT (..) @@ -150,6 +154,7 @@ import Cardano.Wallet.Primitive.Types , Address (..) , AddressState (..) , BoundType + , ChimericAccount (..) , Coin (..) , DecentralizationLevel (..) , Direction (..) @@ -534,9 +539,15 @@ data ApiTransaction (n :: NetworkDiscriminant) = ApiTransaction , direction :: !(ApiT Direction) , inputs :: ![ApiTxInput n] , outputs :: ![AddressAmount (ApiT Address, Proxy n)] + , withdrawals :: ![ApiWithdrawal n] , status :: !(ApiT TxStatus) } deriving (Eq, Generic, Show) +data ApiWithdrawal n = ApiWithdrawal + { stakeAddress :: !(ApiT ChimericAccount, Proxy n) + , amount :: !(Quantity "lovelace" Natural) + } deriving (Eq, Generic, Show) + data ApiTxInput (n :: NetworkDiscriminant) = ApiTxInput { source :: !(Maybe (AddressAmount (ApiT Address, Proxy n))) , input :: !(ApiT TxIn) @@ -786,6 +797,7 @@ instance KnownDiscovery (SeqState network key) where newtype ApiT a = ApiT { getApiT :: a } deriving (Generic, Show, Eq, Functor) +deriving instance Ord a => Ord (ApiT a) -- | Representation of mnemonics at the API-level, using a polymorphic type in -- the lengths of mnemonics that are supported (and an underlying purpose). In @@ -1147,13 +1159,21 @@ instance FromJSON a => FromJSON (AddressAmount a) where instance ToJSON a => ToJSON (AddressAmount a) where toJSON = genericToJSON defaultRecordTypeOptions -instance DecodeAddress n => FromJSON (ApiTransaction n) where +instance + ( DecodeAddress n + , DecodeStakeAddress n + ) => FromJSON (ApiTransaction n) + where parseJSON = genericParseJSON defaultRecordTypeOptions -instance EncodeAddress n => ToJSON (ApiTransaction n) where +instance + ( EncodeAddress n + , EncodeStakeAddress n + ) => ToJSON (ApiTransaction n) + where toJSON = genericToJSON defaultRecordTypeOptions -instance (DecodeAddress n, PassphraseMaxLength s, PassphraseMinLength s) => - FromJSON (ApiWalletMigrationPostData n s) where +instance (DecodeAddress n , PassphraseMaxLength s , PassphraseMinLength s) => FromJSON (ApiWalletMigrationPostData n s) + where parseJSON = genericParseJSON defaultRecordTypeOptions instance EncodeAddress n => ToJSON (ApiWalletMigrationPostData n s) where toJSON = genericToJSON defaultRecordTypeOptions @@ -1248,6 +1268,26 @@ instance FromJSON ApiNetworkParameters where instance ToJSON ApiNetworkParameters where toJSON = genericToJSON defaultRecordTypeOptions +instance DecodeStakeAddress n => FromJSON (ApiWithdrawal n) where + parseJSON = genericParseJSON defaultRecordTypeOptions +instance EncodeStakeAddress n => ToJSON (ApiWithdrawal n) where + toJSON = genericToJSON defaultRecordTypeOptions + +instance {-# OVERLAPS #-} (DecodeStakeAddress n) + => FromJSON (ApiT ChimericAccount, Proxy n) + where + parseJSON x = do + let proxy = Proxy @n + acct <- parseJSON x >>= eitherToParser + . bimap ShowFmt ApiT + . decodeStakeAddress @n + return (acct, proxy) + +instance {-# OVERLAPS #-} EncodeStakeAddress n + => ToJSON (ApiT ChimericAccount, Proxy n) + where + toJSON (acct, _) = toJSON . encodeStakeAddress @n . getApiT $ acct + instance ToJSON ApiErrorCode where toJSON = genericToJSON defaultSumTypeOptions @@ -1416,6 +1456,18 @@ class DecodeAddress (n :: NetworkDiscriminant) where instance DecodeAddress 'Mainnet => DecodeAddress ('Staging pm) where decodeAddress = decodeAddress @'Mainnet +class EncodeStakeAddress (n :: NetworkDiscriminant) where + encodeStakeAddress :: ChimericAccount -> Text + +instance EncodeStakeAddress 'Mainnet => EncodeStakeAddress ('Staging pm) where + encodeStakeAddress = encodeStakeAddress @'Mainnet + +class DecodeStakeAddress (n :: NetworkDiscriminant) where + decodeStakeAddress :: Text -> Either TextDecodingError ChimericAccount + +instance DecodeStakeAddress 'Mainnet => DecodeStakeAddress ('Staging pm) where + decodeStakeAddress = decodeStakeAddress @'Mainnet + -- NOTE: -- The type families below are useful to allow building more flexible API -- implementation from the definition above. In particular, the API client we diff --git a/lib/core/src/Cardano/Wallet/DB/Model.hs b/lib/core/src/Cardano/Wallet/DB/Model.hs index dfd4f877654..836dd2968ce 100644 --- a/lib/core/src/Cardano/Wallet/DB/Model.hs +++ b/lib/core/src/Cardano/Wallet/DB/Model.hs @@ -428,6 +428,8 @@ mReadTxHistory wid order range mstatus db@(Database wallets txs) = (Right res, d <$> resolvedInputs tx , txInfoOutputs = outputs tx + , txInfoWithdrawals = + withdrawals tx , txInfoMeta = meta , txInfoDepth = diff --git a/lib/core/src/Cardano/Wallet/DB/Sqlite.hs b/lib/core/src/Cardano/Wallet/DB/Sqlite.hs index 85a89eca10c..3b807935620 100644 --- a/lib/core/src/Cardano/Wallet/DB/Sqlite.hs +++ b/lib/core/src/Cardano/Wallet/DB/Sqlite.hs @@ -81,6 +81,7 @@ import Cardano.Wallet.DB.Sqlite.TH , TxIn (..) , TxMeta (..) , TxOut (..) + , TxWithdrawal (..) , UTxO (..) , Wallet (..) , migrateAll @@ -100,8 +101,6 @@ import Cardano.Wallet.Primitive.AddressDerivation , SoftDerivation (..) , WalletKey (..) ) -import Control.Arrow - ( (***) ) import Control.Concurrent.MVar ( modifyMVar, modifyMVar_, newMVar, readMVar ) import Control.Exception @@ -126,6 +125,8 @@ import Data.Either ( isRight ) import Data.Generics.Internal.VL.Lens ( (^.) ) +import Data.List + ( unzip3 ) import Data.List.Split ( chunksOf ) import Data.Map.Strict @@ -136,6 +137,8 @@ import Data.Proxy ( Proxy (..) ) import Data.Quantity ( Quantity (..) ) +import Data.Text + ( Text ) import Data.Text.Class ( ToText (..), fromText ) import Data.Typeable @@ -533,9 +536,9 @@ newDBLayer trace defaultFieldValues mDatabaseFile = do insert_ (mkWalletEntity wid meta) when (isRight res) $ do insertCheckpoint wid cp - let (metas, txins, txouts) = mkTxHistory wid txs + let (metas, txins, txouts, txws) = mkTxHistory wid txs putTxMetas metas - putTxs txins txouts + putTxs txins txouts txws insert_ (mkProtocolParametersEntity wid pp) pure res @@ -667,9 +670,9 @@ newDBLayer trace defaultFieldValues mDatabaseFile = do selectWallet wid >>= \case Nothing -> pure $ Left $ ErrNoSuchWallet wid Just _ -> do - let (metas, txins, txouts) = mkTxHistory wid txs + let (metas, txins, txouts, txws) = mkTxHistory wid txs putTxMetas metas - putTxs txins txouts + putTxs txins txouts txws pure $ Right () , readTxHistory = \(PrimaryKey wid) order range status -> do @@ -690,7 +693,7 @@ newDBLayer trace defaultFieldValues mDatabaseFile = do Nothing -> pure errNoSuchWallet Just _ -> do metas <- selectPendingTxs wid (TxId tid) - let isPending (TxMeta _ _ st _ _ _ _) = st == W.Pending + let isPending meta = txMetaStatus meta == W.Pending case metas of [] -> pure errNoSuchTransaction txs | any isPending txs -> do @@ -945,20 +948,25 @@ checkpointFromEntity cp utxo s = mkTxHistory :: W.WalletId -> [(W.Tx, W.TxMeta)] - -> ([TxMeta], [TxIn], [TxOut]) + -> ([TxMeta], [TxIn], [TxOut], [TxWithdrawal]) mkTxHistory wid txs = flatTxHistory - [ (mkTxMetaEntity wid txid meta, mkTxInputsOutputs (txid, tx)) + [ ( mkTxMetaEntity wid txid meta + , mkTxInputsOutputs (txid, tx) + , mkTxWithdrawals (txid, tx) + ) | (tx, meta) <- txs , let txid = W.txId tx ] where -- | Make flat lists of entities from the result of 'mkTxHistory'. flatTxHistory - :: [(TxMeta, ([TxIn], [TxOut]))] -> ([TxMeta], [TxIn], [TxOut]) + :: [(TxMeta, ([TxIn], [TxOut]), [TxWithdrawal])] + -> ([TxMeta], [TxIn], [TxOut], [TxWithdrawal]) flatTxHistory entities = - ( map fst entities - , concatMap (fst . snd) entities - , concatMap (snd . snd) entities + ( map (\(a,_,_) -> a) entities + , concatMap (fst . (\(_,b,_) -> b)) entities + , concatMap (snd . (\(_,b,_) -> b)) entities + , concatMap (\(_,_,c) -> c) entities ) mkTxInputsOutputs @@ -988,6 +996,20 @@ mkTxInputsOutputs tx = dist :: (a -> b -> c) -> (a, [b]) -> [c] dist f (a, bs) = [f a b | b <- bs] +mkTxWithdrawals + :: (W.Hash "Tx", W.Tx) + -> [TxWithdrawal] +mkTxWithdrawals (txid, tx) = + mkTxWithdrawal <$> Map.toList (tx ^. #withdrawals) + where + txWithdrawalTxId = TxId txid + mkTxWithdrawal (txWithdrawalAccount, txWithdrawalAmount) = + TxWithdrawal + { txWithdrawalTxId + , txWithdrawalAccount + , txWithdrawalAmount + } + mkTxMetaEntity :: W.WalletId -> W.Hash "Tx" -> W.TxMeta -> TxMeta mkTxMetaEntity wid txid meta = TxMeta { txMetaTxId = TxId txid @@ -1007,8 +1029,9 @@ txHistoryFromEntity -> [TxMeta] -> [(TxIn, Maybe TxOut)] -> [TxOut] + -> [TxWithdrawal] -> [W.TransactionInfo] -txHistoryFromEntity sp tip metas ins outs = +txHistoryFromEntity sp tip metas ins outs ws = map mkItem metas where mkItem m = mkTxWith (txMetaTxId m) (mkTxMeta m) @@ -1019,6 +1042,8 @@ txHistoryFromEntity sp tip metas ins outs = map mkTxIn $ filter ((== txid) . txInputTxId . fst) ins , W.txInfoOutputs = map mkTxOut $ filter ((== txid) . txOutputTxId) outs + , W.txInfoWithdrawals = + Map.fromList $ map mkTxWithdrawal $ filter ((== txid) . txWithdrawalTxId) ws , W.txInfoMeta = meta , W.txInfoDepth = @@ -1041,6 +1066,10 @@ txHistoryFromEntity sp tip metas ins outs = { W.address = txOutputAddress tx , W.coin = txOutputAmount tx } + mkTxWithdrawal w = + ( txWithdrawalAccount w + , txWithdrawalAmount w + ) mkTxMeta m = W.TxMeta { W.status = txMetaStatus m , W.direction = txMetaDirection m @@ -1142,23 +1171,27 @@ putTxMetas metas = dbChunked repsertMany [(TxMetaKey txMetaTxId txMetaWalletId, m) | m@TxMeta{..} <- metas] -- | Insert multiple transactions, removing old instances first. -putTxs :: [TxIn] -> [TxOut] -> SqlPersistT IO () -putTxs txins txouts = do +putTxs :: [TxIn] -> [TxOut] -> [TxWithdrawal] -> SqlPersistT IO () +putTxs txins txouts txws = do dbChunked repsertMany [ (TxInKey txInputTxId txInputSourceTxId txInputSourceIndex, i) | i@TxIn{..} <- txins ] dbChunked repsertMany [ (TxOutKey txOutputTxId txOutputIndex, o) | o@TxOut{..} <- txouts ] + dbChunked repsertMany + [ (TxWithdrawalKey txWithdrawalTxId txWithdrawalAccount, w) + | w@TxWithdrawal{..} <- txws ] -- | Delete transactions that aren't referred to by TxMeta of any wallet. deleteLooseTransactions :: SqlPersistT IO () deleteLooseTransactions = do deleteLoose "tx_in" deleteLoose "tx_out" + deleteLoose "tx_withdrawal" where - -- Deletes all TxIn/TxOuts returned by the sub-select. - -- The sub-select outer joins TxMeta with TxIn/TxOut. + -- Deletes all TxIn/TxOuts/TxWithdrawal returned by the sub-select. + -- The sub-select outer joins TxMeta with TxIn/TxOut/TxWithdrawal. -- All rows of the join table TxMeta as NULL are loose (unreferenced) -- transactions. deleteLoose t = flip rawExecute [] $ @@ -1203,7 +1236,7 @@ selectUTxO cp = fmap entityVal <$> -- See also: issue #573. selectTxs :: [TxId] - -> SqlPersistT IO ([(TxIn, Maybe TxOut)], [TxOut]) + -> SqlPersistT IO ([(TxIn, Maybe TxOut)], [TxOut], [TxWithdrawal]) selectTxs = fmap concatUnzip . mapM select . chunksOf chunkSize where select txids = do @@ -1220,9 +1253,14 @@ selectTxs = fmap concatUnzip . mapM select . chunksOf chunkSize [TxOutputTxId <-. txids] [Asc TxOutputTxId, Asc TxOutputIndex] + withdrawals <- fmap entityVal <$> selectList + [TxWithdrawalTxId <-. txids] + [] + pure ( inputs `resolveWith` resolvedInputs , outputs + , withdrawals ) toOutputMap :: [TxOut] -> Map (TxId, Word32) TxOut @@ -1236,8 +1274,8 @@ selectTxs = fmap concatUnzip . mapM select . chunksOf chunkSize , let key = (txInputSourceTxId i, txInputSourceIndex i) ] - concatUnzip :: [([a], [b])] -> ([a], [b]) - concatUnzip = (concat *** concat) . unzip + concatUnzip :: [([a], [b], [c])] -> ([a], [b], [c]) + concatUnzip = (\(a, b, c) -> (concat a, concat b, concat c)) . unzip3 -- Split a query's input values into chunks, run multiple smaller queries, -- and then concatenate the results afterwards. Used to avoid "too many SQL @@ -1257,13 +1295,13 @@ selectTxHistory wid order conditions = do metas <- fmap entityVal <$> selectList ((TxMetaWalletId ==. wid) : conditions) sortOpt let txids = map txMetaTxId metas - (ins, outs) <- selectTxs txids + (ins, outs, ws) <- selectTxs txids let wal = checkpointFromEntity cp [] () let tip = W.currentTip wal let slp = W.slotParams $ W.blockchainParameters wal - return $ txHistoryFromEntity slp tip metas ins outs + return $ txHistoryFromEntity slp tip metas ins outs ws where -- Note: there are sorted indices on these columns. -- The secondary sort by TxId is to make the ordering stable diff --git a/lib/core/src/Cardano/Wallet/DB/Sqlite/TH.hs b/lib/core/src/Cardano/Wallet/DB/Sqlite/TH.hs index 15fc9ca388d..e15478db115 100644 --- a/lib/core/src/Cardano/Wallet/DB/Sqlite/TH.hs +++ b/lib/core/src/Cardano/Wallet/DB/Sqlite/TH.hs @@ -125,6 +125,18 @@ TxOut Primary txOutputTxId txOutputIndex deriving Show Generic +-- | A transaction withdrawal associated with TxMeta. +-- +-- There is no wallet ID because these values depend only on the transaction, +-- not the wallet. txOutputTxId is referred to by TxMeta +TxWithdrawal + txWithdrawalTxId TxId sql=tx_id + txWithdrawalAmount W.Coin sql=amount + txWithdrawalAccount W.ChimericAccount sql=account + + Primary txWithdrawalTxId txWithdrawalAccount + deriving Show Generic + -- A checkpoint for a given wallet is referred to by (wallet_id, slot). -- Volatile checkpoint data such as AD state will refer to this table. Checkpoint diff --git a/lib/core/src/Cardano/Wallet/DB/Sqlite/Types.hs b/lib/core/src/Cardano/Wallet/DB/Sqlite/Types.hs index 7e416de1618..d8c8251f20e 100644 --- a/lib/core/src/Cardano/Wallet/DB/Sqlite/Types.hs +++ b/lib/core/src/Cardano/Wallet/DB/Sqlite/Types.hs @@ -26,6 +26,7 @@ import Cardano.Wallet.Primitive.AddressDiscovery.Sequential ( AddressPoolGap (..), getAddressPoolGap, mkAddressPoolGap ) import Cardano.Wallet.Primitive.Types ( Address (..) + , ChimericAccount (..) , Coin (..) , Direction (..) , EpochLength (..) @@ -539,3 +540,33 @@ instance FromJSON StakePoolMetadataUrl where instance PathPiece StakePoolMetadataUrl where fromPathPiece = fromTextMaybe toPathPiece = toText + + +---------------------------------------------------------------------------- +-- ChimericAccount + +instance PersistField ChimericAccount where + toPersistValue = toPersistValue . toText + fromPersistValue = fromPersistValueFromText + +instance PersistFieldSql ChimericAccount where + sqlType _ = sqlType (Proxy @Text) + +instance Read ChimericAccount where + readsPrec _ = error "readsPrec stub needed for persistent" + +instance ToHttpApiData ChimericAccount where + toUrlPiece = toText + +instance FromHttpApiData ChimericAccount where + parseUrlPiece = fromText' + +instance ToJSON ChimericAccount where + toJSON = String . toText + +instance FromJSON ChimericAccount where + parseJSON = aesonFromText "ChimericAccount" + +instance PathPiece ChimericAccount where + fromPathPiece = fromTextMaybe + toPathPiece = toText diff --git a/lib/core/src/Cardano/Wallet/Primitive/Types.hs b/lib/core/src/Cardano/Wallet/Primitive/Types.hs index ed5e73c02e0..1c10fe5d1f1 100644 --- a/lib/core/src/Cardano/Wallet/Primitive/Types.hs +++ b/lib/core/src/Cardano/Wallet/Primitive/Types.hs @@ -822,16 +822,21 @@ data Tx = Tx -- ^ NOTE: Order of outputs matters in the transaction representations. Outputs -- are used as inputs for next transactions which refer to them using -- their indexes. It matters also for serialization. + , withdrawals + :: !(Map ChimericAccount Coin) + -- ^ Withdrawals (of funds from a registered reward account) embedded in + -- a transaction. The order does not matter. } deriving (Show, Generic, Ord, Eq) instance NFData Tx instance Buildable Tx where - build (Tx tid ins outs) = mempty + build (Tx tid ins outs ws) = mempty <> build tid - <> blockListF' "~>" build (fst <$> ins) - <> blockListF' "<~" build outs + <> blockListF' "inputs" build (fst <$> ins) + <> blockListF' "outputs" build outs + <> blockListF' "withdrawals" tupleF (Map.toList ws) txIns :: Set Tx -> Set TxIn txIns = foldMap (Set.fromList . inputs) @@ -958,6 +963,8 @@ data TransactionInfo = TransactionInfo -- source. Source information can only be provided for outgoing payments. , txInfoOutputs :: ![TxOut] -- ^ Payment destination. + , txInfoWithdrawals :: !(Map ChimericAccount Coin) + -- ^ Withdrawals on this transaction. , txInfoMeta :: !TxMeta -- ^ Other information calculated from the transaction. , txInfoDepth :: Quantity "block" Natural @@ -974,6 +981,7 @@ fromTransactionInfo info = Tx { txId = txInfoId info , resolvedInputs = (\(a,b,_) -> (a,b)) <$> txInfoInputs info , outputs = txInfoOutputs info + , withdrawals = txInfoWithdrawals info } -- | Drop time-specific information @@ -1700,6 +1708,16 @@ newtype ChimericAccount = ChimericAccount { unChimericAccount :: ByteString } instance NFData ChimericAccount +instance Buildable ChimericAccount where + build = build . Hash @"Account" . unChimericAccount + +instance ToText ChimericAccount where + toText = toText . Hash @"Account" . unChimericAccount + +instance FromText ChimericAccount where + fromText = fmap (ChimericAccount . getHash @"Account") . fromText + + -- | Represent a delegation certificate. data DelegationCertificate = CertDelegateNone ChimericAccount diff --git a/lib/core/test/data/Cardano/Wallet/Api/ApiTransactionTestnet0.faulty.json b/lib/core/test/data/Cardano/Wallet/Api/ApiTransactionTestnet0.faulty.json new file mode 100644 index 00000000000..97eb044a418 --- /dev/null +++ b/lib/core/test/data/Cardano/Wallet/Api/ApiTransactionTestnet0.faulty.json @@ -0,0 +1,245 @@ +{ + "seed": -856323584806524003, + "samples": [ + { + "status": "pending", + "withdrawals": [], + "amount": { + "quantity": 160, + "unit": "lovelace" + }, + "inputs": [], + "direction": "incoming", + "outputs": [], + "pending_since": { + "time": "1898-12-06T13:00:00Z", + "block": { + "height": { + "quantity": 9806, + "unit": "block" + }, + "epoch_number": 12759, + "slot_number": 19363 + } + }, + "depth": { + "quantity": 27442, + "unit": "block" + }, + "id": "0c23721b0c5f624c611e515873641e19829a4e2685548e74715b7dd0b24a7d79" + }, + { + "inserted_at": { + "time": "1864-10-06T19:06:06.359193744932Z", + "block": { + "height": { + "quantity": 8958, + "unit": "block" + }, + "epoch_number": 24530, + "slot_number": 3578 + } + }, + "status": "in_ledger", + "withdrawals": [], + "amount": { + "quantity": 172, + "unit": "lovelace" + }, + "inputs": [], + "direction": "incoming", + "outputs": [], + "id": "2c7545182548423b1cd8e65261080395421947074a1c4642723920470e0b087a" + }, + { + "status": "pending", + "withdrawals": [], + "amount": { + "quantity": 168, + "unit": "lovelace" + }, + "inputs": [], + "direction": "outgoing", + "outputs": [], + "pending_since": { + "time": "1862-03-05T07:00:00Z", + "block": { + "height": { + "quantity": 10798, + "unit": "block" + }, + "epoch_number": 28662, + "slot_number": 18973 + } + }, + "depth": { + "quantity": 11315, + "unit": "block" + }, + "id": "125f164e104a5d46078d1740346617404d3f936a1e26540758de0b2f063e137a" + }, + { + "inserted_at": { + "time": "1866-05-16T05:49:04.515289439119Z", + "block": { + "height": { + "quantity": 4157, + "unit": "block" + }, + "epoch_number": 13024, + "slot_number": 19903 + } + }, + "status": "in_ledger", + "withdrawals": [], + "amount": { + "quantity": 165, + "unit": "lovelace" + }, + "inputs": [], + "direction": "outgoing", + "outputs": [], + "depth": { + "quantity": 23543, + "unit": "block" + }, + "id": "7830071b655eb26f429e2278520c3327e74f200ec2290b17e02b6d793e4d7aee" + }, + { + "inserted_at": { + "time": "1891-07-11T00:00:00Z", + "block": { + "height": { + "quantity": 15659, + "unit": "block" + }, + "epoch_number": 25996, + "slot_number": 14900 + } + }, + "status": "in_ledger", + "withdrawals": [], + "amount": { + "quantity": 22, + "unit": "lovelace" + }, + "inputs": [], + "direction": "incoming", + "outputs": [], + "depth": { + "quantity": 11786, + "unit": "block" + }, + "id": "4040470863077e442c31623309ae740e52561153170f9e631407665b1808126e" + }, + { + "status": "in_ledger", + "withdrawals": [], + "amount": { + "quantity": 51, + "unit": "lovelace" + }, + "inputs": [], + "direction": "outgoing", + "outputs": [], + "depth": { + "quantity": 6735, + "unit": "block" + }, + "id": "427b74005d522d7e544c1956436a59b94e041156617f50438c08389b43396940" + }, + { + "status": "pending", + "withdrawals": [], + "amount": { + "quantity": 65, + "unit": "lovelace" + }, + "inputs": [], + "direction": "outgoing", + "outputs": [], + "depth": { + "quantity": 31288, + "unit": "block" + }, + "id": "27c74e7a1f261d733710607f4e18104c15ba53424dcb6e43465a6c9b307b0378" + }, + { + "status": "pending", + "withdrawals": [], + "amount": { + "quantity": 234, + "unit": "lovelace" + }, + "inputs": [], + "direction": "outgoing", + "outputs": [], + "pending_since": { + "time": "1907-01-19T02:11:06Z", + "block": { + "height": { + "quantity": 15652, + "unit": "block" + }, + "epoch_number": 21816, + "slot_number": 6642 + } + }, + "depth": { + "quantity": 29512, + "unit": "block" + }, + "id": "703f2304674cc637743e40c07325a021317c5c3b72b73845290b1b6c5f8c9266" + }, + { + "status": "pending", + "withdrawals": [], + "amount": { + "quantity": 230, + "unit": "lovelace" + }, + "inputs": [], + "direction": "incoming", + "outputs": [], + "pending_since": { + "time": "1894-10-11T08:00:00Z", + "block": { + "height": { + "quantity": 8518, + "unit": "block" + }, + "epoch_number": 15755, + "slot_number": 22621 + } + }, + "id": "4f3a7584153d061872564471431302641465606336582531e51f787612103fc4" + }, + { + "status": "pending", + "withdrawals": [], + "amount": { + "quantity": 165, + "unit": "lovelace" + }, + "inputs": [], + "direction": "outgoing", + "outputs": [], + "pending_since": { + "time": "1901-09-20T09:00:00Z", + "block": { + "height": { + "quantity": 3162, + "unit": "block" + }, + "epoch_number": 12570, + "slot_number": 30931 + } + }, + "depth": { + "quantity": 25741, + "unit": "block" + }, + "id": "6b44174865226b2101076326181532481a6c507f7c7801592d14733914860d26" + } + ] +} \ No newline at end of file From 6eeb563c9561c016caf75170b3009e59f486e2db Mon Sep 17 00:00:00 2001 From: KtorZ Date: Wed, 8 Jul 2020 20:30:58 +0200 Subject: [PATCH 4/9] upgrade Byron & Jormungandr compatibility code with empty withdrawals Withdrawals are only a thing in Shelley, so for this targets, we can safely replace them by empty lists --- .../src/Cardano/Wallet/Byron/Compatibility.hs | 18 +++++++++++++++++- .../src/Cardano/Wallet/Byron/Transaction.hs | 5 +++-- .../src/Cardano/Wallet/Jormungandr/Binary.hs | 4 ++-- .../Wallet/Jormungandr/Compatibility.hs | 15 ++++++++++++++- .../Cardano/Wallet/Jormungandr/Transaction.hs | 1 + 5 files changed, 37 insertions(+), 6 deletions(-) diff --git a/lib/byron/src/Cardano/Wallet/Byron/Compatibility.hs b/lib/byron/src/Cardano/Wallet/Byron/Compatibility.hs index 7348a8b78e0..bbebfe89139 100644 --- a/lib/byron/src/Cardano/Wallet/Byron/Compatibility.hs +++ b/lib/byron/src/Cardano/Wallet/Byron/Compatibility.hs @@ -2,6 +2,7 @@ {-# LANGUAGE DataKinds #-} {-# LANGUAGE DuplicateRecordFields #-} {-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE NumericUnderscores #-} @@ -86,7 +87,11 @@ import Cardano.Crypto import Cardano.Crypto.ProtocolMagic ( ProtocolMagicId, unProtocolMagicId ) import Cardano.Wallet.Api.Types - ( DecodeAddress (..), EncodeAddress (..) ) + ( DecodeAddress (..) + , DecodeStakeAddress (..) + , EncodeAddress (..) + , EncodeStakeAddress (..) + ) import Cardano.Wallet.Primitive.AddressDerivation ( NetworkDiscriminant (..) ) import Cardano.Wallet.Primitive.AddressDerivation.Byron @@ -354,6 +359,9 @@ fromTxAux txAux = case taTx txAux of , outputs = fromTxOut <$> NE.toList outputs + + , withdrawals = + mempty } fromTxIn :: TxIn -> W.TxIn @@ -494,6 +502,14 @@ fromProtocolMagicId = W.ProtocolMagic . fromIntegral . unProtocolMagicId Address Encoding / Decoding -------------------------------------------------------------------------------} +instance EncodeStakeAddress n where + encodeStakeAddress = error + "encodeStakeAddress: there's no such thing as stake address in Byron" + +instance DecodeStakeAddress n where + decodeStakeAddress = error + "decodeStakeAddress: there's no such thing as stake address in Byron" + instance EncodeAddress 'Mainnet where encodeAddress = gEncodeAddress diff --git a/lib/byron/src/Cardano/Wallet/Byron/Transaction.hs b/lib/byron/src/Cardano/Wallet/Byron/Transaction.hs index 802e1f7d686..899b8e8e5db 100644 --- a/lib/byron/src/Cardano/Wallet/Byron/Transaction.hs +++ b/lib/byron/src/Cardano/Wallet/Byron/Transaction.hs @@ -128,7 +128,7 @@ newTransactionLayer _proxy protocolMagic = TransactionLayer witnesses <- forM (CS.inputs cs) $ \(_, TxOut addr _) -> mkWitness protocolMagic sigData <$> lookupPrivateKey addr pure - ( Tx (Hash sigData) (second coin <$> CS.inputs cs) (CS.outputs cs) + ( Tx (Hash sigData) (second coin <$> CS.inputs cs) (CS.outputs cs) mempty , SealedTx $ CBOR.toStrictByteString $ CBOR.encodeSignedTx tx witnesses ) where @@ -190,6 +190,7 @@ newTransactionLayer _proxy protocolMagic = TransactionLayer -- FIXME Do not require Tx to have resolvedInputs , resolvedInputs = (,Coin 0) <$> inps , outputs = outs + , withdrawals = mempty } , SealedTx bytes ) @@ -243,7 +244,7 @@ genesisBlockFromTxOuts gp outs = Block } where mkTx out@(TxOut (Address bytes) _) = - Tx (Hash $ blake2b256 bytes) [] [out] + Tx (Hash $ blake2b256 bytes) [] [out] mempty dummyAddress :: forall (n :: NetworkDiscriminant). (MaxSizeOf Address n ByronKey) diff --git a/lib/jormungandr/src/Cardano/Wallet/Jormungandr/Binary.hs b/lib/jormungandr/src/Cardano/Wallet/Jormungandr/Binary.hs index 121acef7d64..a3f4892c4b9 100644 --- a/lib/jormungandr/src/Cardano/Wallet/Jormungandr/Binary.hs +++ b/lib/jormungandr/src/Cardano/Wallet/Jormungandr/Binary.hs @@ -461,7 +461,7 @@ getGenericTransaction tid = label "getGenericTransaction" $ do (ins, outs) <- getTokenTransfer let witnessCount = length ins _wits <- replicateM witnessCount getWitness - return $ Tx tid ins outs + return $ Tx tid ins outs mempty where getWitness :: Get ByteString getWitness = do @@ -509,7 +509,7 @@ getLegacyTransaction tid = do -- Legacy transactions only show up in the genesis block and are treated as -- coinbase transactions with no inputs. let inps = mempty - pure $ Tx tid inps outs + pure $ Tx tid inps outs mempty data MkFragment = MkFragmentSimpleTransaction diff --git a/lib/jormungandr/src/Cardano/Wallet/Jormungandr/Compatibility.hs b/lib/jormungandr/src/Cardano/Wallet/Jormungandr/Compatibility.hs index ff5ac61df2b..32cacc80138 100644 --- a/lib/jormungandr/src/Cardano/Wallet/Jormungandr/Compatibility.hs +++ b/lib/jormungandr/src/Cardano/Wallet/Jormungandr/Compatibility.hs @@ -43,7 +43,11 @@ module Cardano.Wallet.Jormungandr.Compatibility import Prelude import Cardano.Wallet.Api.Types - ( DecodeAddress (..), EncodeAddress (..) ) + ( DecodeAddress (..) + , DecodeStakeAddress (..) + , EncodeAddress (..) + , EncodeStakeAddress (..) + ) import Cardano.Wallet.Primitive.AddressDerivation ( NetworkDiscriminant (..) ) import Cardano.Wallet.Primitive.AddressDerivation.Byron @@ -110,6 +114,15 @@ baseUrlToText = T.pack . showBaseUrl Address Encoding / Decoding -------------------------------------------------------------------------------} +instance EncodeStakeAddress n where + encodeStakeAddress = error + "encodeStakeAddress: there's no such thing as stake address in Jörmungandr" + +instance DecodeStakeAddress n where + decodeStakeAddress = error + "decodeStakeAddress: there's no such thing as stake address in Jörmungandr" + + -- | Encode an 'Address' to a human-readable format. This produces two kinds of -- encodings: -- diff --git a/lib/jormungandr/src/Cardano/Wallet/Jormungandr/Transaction.hs b/lib/jormungandr/src/Cardano/Wallet/Jormungandr/Transaction.hs index 0529e637062..ab4e8c97a40 100644 --- a/lib/jormungandr/src/Cardano/Wallet/Jormungandr/Transaction.hs +++ b/lib/jormungandr/src/Cardano/Wallet/Jormungandr/Transaction.hs @@ -146,6 +146,7 @@ newTransactionLayer block0H = TransactionLayer { txId = fragmentId fragment , resolvedInputs = inps , outputs = outs + , withdrawals = mempty } , finalizeFragment fragment ) From 3633c7c0136b3bbad7434b926e799c2b546283c0 Mon Sep 17 00:00:00 2001 From: KtorZ Date: Wed, 8 Jul 2020 20:39:08 +0200 Subject: [PATCH 5/9] wire withdrawals in Shelley compatibility code Here, we extract withdrawals directly from the TxBody, the conversion is straightforward --- lib/shelley/cardano-wallet-shelley.cabal | 1 + lib/shelley/src/Cardano/Wallet/Shelley.hs | 10 +- .../Cardano/Wallet/Shelley/Compatibility.hs | 107 ++++++++++++++---- .../src/Cardano/Wallet/Shelley/Transaction.hs | 20 ++-- 4 files changed, 108 insertions(+), 30 deletions(-) diff --git a/lib/shelley/cardano-wallet-shelley.cabal b/lib/shelley/cardano-wallet-shelley.cabal index 582a0185ca1..9bd1e1bd0fb 100644 --- a/lib/shelley/cardano-wallet-shelley.cabal +++ b/lib/shelley/cardano-wallet-shelley.cabal @@ -35,6 +35,7 @@ library , base58-bytestring , bech32 , bech32-th + , binary , bytestring , cardano-addresses , cardano-api diff --git a/lib/shelley/src/Cardano/Wallet/Shelley.hs b/lib/shelley/src/Cardano/Wallet/Shelley.hs index 281bff0c403..d81e1fd74e6 100644 --- a/lib/shelley/src/Cardano/Wallet/Shelley.hs +++ b/lib/shelley/src/Cardano/Wallet/Shelley.hs @@ -62,7 +62,12 @@ import Cardano.Wallet.Api import Cardano.Wallet.Api.Server ( HostPreference, Listen (..), ListenError (..), TlsConfiguration ) import Cardano.Wallet.Api.Types - ( ApiStakePool, DecodeAddress, EncodeAddress ) + ( ApiStakePool + , DecodeAddress + , DecodeStakeAddress + , EncodeAddress + , EncodeStakeAddress + ) import Cardano.Wallet.DB.Sqlite ( DefaultFieldValues (..), PersistState ) import Cardano.Wallet.Logging @@ -176,6 +181,8 @@ data SomeNetworkDiscriminant where , DelegationAddress n ShelleyKey , DecodeAddress n , EncodeAddress n + , DecodeStakeAddress n + , EncodeStakeAddress n , Typeable n ) => Proxy n @@ -274,6 +281,7 @@ serveWallet , DelegationAddress n ShelleyKey , DecodeAddress n , EncodeAddress n + , EncodeStakeAddress n ) => Proxy n -> Socket diff --git a/lib/shelley/src/Cardano/Wallet/Shelley/Compatibility.hs b/lib/shelley/src/Cardano/Wallet/Shelley/Compatibility.hs index e62ec7e356f..0c6f27435e0 100644 --- a/lib/shelley/src/Cardano/Wallet/Shelley/Compatibility.hs +++ b/lib/shelley/src/Cardano/Wallet/Shelley/Compatibility.hs @@ -99,7 +99,11 @@ import Cardano.Crypto.Hash.Class import Cardano.Slotting.Slot ( EpochNo (..), EpochSize (..) ) import Cardano.Wallet.Api.Types - ( DecodeAddress (..), EncodeAddress (..) ) + ( DecodeAddress (..) + , DecodeStakeAddress (..) + , EncodeAddress (..) + , EncodeStakeAddress (..) + ) import Cardano.Wallet.Primitive.AddressDerivation ( NetworkDiscriminant (..) ) import Cardano.Wallet.Primitive.Types @@ -119,6 +123,12 @@ import Crypto.Hash.Utils ( blake2b224 ) import Data.Bifunctor ( bimap ) +import Data.Binary.Get + ( runGetOrFail ) +import Data.Binary.Put + ( putByteString, putWord8, runPut ) +import Data.Bits + ( (.|.) ) import Data.ByteArray.Encoding ( Base (Base16), convertFromBase ) import Data.ByteString @@ -144,9 +154,9 @@ import Data.Text.Class import Data.Type.Equality ( testEquality ) import Data.Word - ( Word16, Word32, Word64 ) + ( Word16, Word32, Word64, Word8 ) import Fmt - ( Buildable (..), hexF ) + ( Buildable (..) ) import GHC.Stack ( HasCallStack ) import Numeric.Natural @@ -572,6 +582,7 @@ fromGenesisData g initialFunds = pseudoHash [] [W.TxOut (fromShelleyAddress addr) (fromShelleyCoin c)] + mempty where W.TxIn pseudoHash _ = fromShelleyTxIn $ SL.initialFundsPseudoTxIn @TPraosStandardCrypto addr @@ -660,15 +671,20 @@ fromShelleyTx , [W.DelegationCertificate] , [W.PoolCertificate] ) -fromShelleyTx (SL.Tx bod@(SL.TxBody ins outs certs _ _ _ _ _) _ _) = +fromShelleyTx (SL.Tx bod@(SL.TxBody ins outs certs wdrls _ _ _ _) _ _) = ( W.Tx (fromShelleyTxId $ SL.txid bod) (map ((,W.Coin 0) . fromShelleyTxIn) (toList ins)) (map fromShelleyTxOut (toList outs)) + (fromShelleyWdrl wdrls) , mapMaybe fromShelleyDelegationCert (toList certs) , mapMaybe fromShelleyRegistrationCert (toList certs) ) +fromShelleyWdrl :: SL.Wdrl TPraosStandardCrypto -> Map W.ChimericAccount W.Coin +fromShelleyWdrl (SL.Wdrl wdrl) = Map.fromList $ + bimap (fromStakeCredential . SL.getRwdCred) fromShelleyCoin <$> Map.toList wdrl + -- Convert & filter Shelley certificate into delegation certificate. Returns -- 'Nothing' if certificates aren't delegation certificate. fromShelleyDelegationCert @@ -816,6 +832,61 @@ toStakePoolDlgCert xpub (W.PoolId pid) = Address Encoding / Decoding -------------------------------------------------------------------------------} +instance EncodeStakeAddress 'Mainnet where + encodeStakeAddress = _encodeStakeAddress SL.Mainnet +instance EncodeStakeAddress ('Testnet pm) where + encodeStakeAddress = _encodeStakeAddress SL.Testnet + +instance DecodeStakeAddress 'Mainnet where + decodeStakeAddress = _decodeStakeAddress SL.Mainnet +instance DecodeStakeAddress ('Testnet pm) where + decodeStakeAddress = _decodeStakeAddress SL.Testnet + +stakeAddressPrefix :: Word8 +stakeAddressPrefix = 0xE0 + +toNetworkId :: SL.Network -> Word8 +toNetworkId = \case + SL.Testnet -> 0 + SL.Mainnet -> 1 + +_encodeStakeAddress + :: SL.Network + -> W.ChimericAccount + -> Text +_encodeStakeAddress network (W.ChimericAccount acct) = + Bech32.encodeLenient hrp (dataPartFromBytes bytes) + where + hrp = [Bech32.humanReadablePart|stake_addr|] + bytes = BL.toStrict $ runPut $ do + putWord8 (toNetworkId network .|. stakeAddressPrefix) + putByteString acct + +_decodeStakeAddress + :: SL.Network + -> Text + -> Either TextDecodingError W.ChimericAccount +_decodeStakeAddress serverNetwork txt = do + rewardAcnt <- runGetOrFail' SL.getRewardAcnt (T.encodeUtf8 txt) + + guardNetwork (SL.getRwdNetwork rewardAcnt) serverNetwork + + pure $ fromStakeCredential $ SL.getRwdCred rewardAcnt + where + runGetOrFail' decoder bytes = + case runGetOrFail decoder (BL.fromStrict bytes) of + Left{} -> + Left msg + + Right (remaining,_,_) | not (BL.null remaining) -> + Left msg + + Right (_,_,a) -> + Right a + where + msg = TextDecodingError + "Unable to decode stake-address: not a well-formed address." + instance EncodeAddress 'Mainnet where encodeAddress = _encodeAddress @@ -874,32 +945,33 @@ _decodeAddress serverNetwork text = decodeShelleyAddress bytes = do case SL.deserialiseAddr @TPraosStandardCrypto bytes of Just (SL.Addr addrNetwork _ _) -> do - guardNetwork addrNetwork + guardNetwork addrNetwork serverNetwork pure (W.Address bytes) Just (SL.AddrBootstrap (SL.BootstrapAddress addr)) -> do - guardNetwork (toNetwork (Byron.addrNetworkMagic addr)) + guardNetwork (toNetwork (Byron.addrNetworkMagic addr)) serverNetwork pure (W.Address bytes) Nothing -> Left $ TextDecodingError "Unable to decode address: not a well-formed Shelley nor Byron address." where - guardNetwork :: SL.Network -> Either TextDecodingError () - guardNetwork addrNetwork = - when (addrNetwork /= serverNetwork) $ - Left $ TextDecodingError $ - "Invalid network discrimination on address. Expecting " - <> show serverNetwork - <> " but got " - <> show addrNetwork - <> "." - toNetwork :: Byron.NetworkMagic -> SL.Network toNetwork = \case Byron.NetworkMainOrStage -> SL.Mainnet Byron.NetworkTestnet{} -> SL.Testnet +guardNetwork :: SL.Network -> SL.Network -> Either TextDecodingError () +guardNetwork addrNetwork serverNetwork = + when (addrNetwork /= serverNetwork) $ + Left $ TextDecodingError $ + "Invalid network discrimination on address. Expecting " + <> show serverNetwork + <> " but got " + <> show addrNetwork + <> "." + + {------------------------------------------------------------------------------- Logging -------------------------------------------------------------------------------} @@ -911,9 +983,6 @@ instance Buildable addr => Buildable (ConnectionId addr) where instance Buildable LocalAddress where build (LocalAddress p) = build p -instance Buildable W.ChimericAccount where - build (W.ChimericAccount addr) = hexF addr - {------------------------------------------------------------------------------- Utilities -------------------------------------------------------------------------------} diff --git a/lib/shelley/src/Cardano/Wallet/Shelley/Transaction.hs b/lib/shelley/src/Cardano/Wallet/Shelley/Transaction.hs index e8055b7c2a2..a711fabbcfd 100644 --- a/lib/shelley/src/Cardano/Wallet/Shelley/Transaction.hs +++ b/lib/shelley/src/Cardano/Wallet/Shelley/Transaction.hs @@ -165,23 +165,23 @@ mkTx -> CoinSelection -> Either ErrMkTx (Tx, SealedTx) mkTx proxy (TxPayload certs mkExtraWits) timeToLive (rewardAcnt, pwdAcnt) keyFrom cs = do - let withdrawals = mkWithdrawals + let wdrls = mkWithdrawals proxy (toChimericAccountRaw . getRawKey . publicKey $ rewardAcnt) (withdrawal cs) - let unsigned = mkUnsignedTx timeToLive cs withdrawals certs + let unsigned = mkUnsignedTx timeToLive cs wdrls certs addrWits <- fmap Set.fromList $ forM (CS.inputs cs) $ \(_, TxOut addr _) -> do (k, pwd) <- lookupPrivateKey keyFrom addr pure $ mkWitness unsigned (getRawKey k, pwd) - let withdrawalsWits - | Map.null withdrawals = Set.empty + let wdrlsWits + | Map.null wdrls = Set.empty | otherwise = Set.singleton $ mkWitness unsigned (getRawKey rewardAcnt, pwdAcnt) - let wits = (SL.WitnessSet (addrWits <> withdrawalsWits) mempty mempty) + let wits = (SL.WitnessSet (addrWits <> wdrlsWits) mempty mempty) <> mkExtraWits unsigned let metadata = SL.SNothing @@ -359,7 +359,7 @@ computeTxSize proxy action cs = where metadata = SL.SNothing - unsigned = mkUnsignedTx maxBound cs' withdrawals certs + unsigned = mkUnsignedTx maxBound cs' wdrls certs where cs' :: CoinSelection cs' = cs @@ -387,7 +387,7 @@ computeTxSize proxy action cs = dummyKeyHashRaw = BS.pack (replicate 28 0) - withdrawals = mkWithdrawals + wdrls = mkWithdrawals proxy (ChimericAccount dummyKeyHashRaw) (withdrawal cs) @@ -395,7 +395,7 @@ computeTxSize proxy action cs = (addrWits, certWits) = ( Set.union (Set.map dummyWitnessUniq $ Set.fromList (fst <$> CS.inputs cs)) - (if Map.null withdrawals then Set.empty else Set.singleton (dummyWitness "0")) + (if Map.null wdrls then Set.empty else Set.singleton (dummyWitness "0")) , case action of Nothing -> Set.empty Just{} -> Set.singleton (dummyWitness "a") @@ -436,7 +436,7 @@ mkUnsignedTx -> Map (SL.RewardAcnt TPraosStandardCrypto) SL.Coin -> [Cardano.Certificate] -> Cardano.ShelleyTxBody -mkUnsignedTx ttl cs withdrawals certs = +mkUnsignedTx ttl cs wdrls certs = let Cardano.TxUnsignedShelley unsigned = Cardano.buildShelleyTransaction (toCardanoTxIn . fst <$> CS.inputs cs) @@ -444,7 +444,7 @@ mkUnsignedTx ttl cs withdrawals certs = ttl (toCardanoLovelace $ Coin $ feeBalance cs) certs - (Cardano.WithdrawalsShelley $ SL.Wdrl withdrawals) + (Cardano.WithdrawalsShelley $ SL.Wdrl wdrls) Nothing -- Update Nothing -- Metadata hash in From c672b67c2a160375b779be76f54b77b97f5f534b Mon Sep 17 00:00:00 2001 From: KtorZ Date: Wed, 8 Jul 2020 22:18:05 +0200 Subject: [PATCH 6/9] include withdrawals where relevant in test and arbitrary generators --- .../Byron/Scenario/API/Migrations.hs | 4 + .../Byron/Scenario/API/Transactions.hs | 21 ++ .../Byron/Scenario/CLI/Transactions.hs | 14 + .../src/Test/Integration/Framework/DSL.hs | 26 +- .../Scenario/API/Byron/Addresses.hs | 2 + .../Scenario/API/Byron/HWWallets.hs | 2 + .../Scenario/API/Byron/Migrations.hs | 2 + .../Scenario/API/Byron/Transactions.hs | 8 +- .../Integration/Scenario/API/Byron/Wallets.hs | 2 + .../Scenario/API/Shelley/Addresses.hs | 2 + .../Scenario/API/Shelley/HWWallets.hs | 2 + .../Scenario/API/Shelley/Migrations.hs | 2 + .../Scenario/API/Shelley/StakePools.hs | 2 + .../Scenario/API/Shelley/Transactions.hs | 2 + .../Scenario/API/Shelley/Wallets.hs | 2 + .../Scenario/CLI/Shelley/HWWallets.hs | 2 + .../Scenario/CLI/Shelley/Transactions.hs | 2 + .../Scenario/CLI/Shelley/Wallets.hs | 2 + .../src/Cardano/Wallet/Primitive/Types.hs | 18 +- .../Api/ApiTransactionTestnet0.faulty.json | 245 ------------------ .../Wallet/Api/ApiTransactionTestnet0.json | 209 ++++++++------- .../Wallet/DummyTarget/Primitive/Types.hs | 11 +- .../test/unit/Cardano/Wallet/Api/TypesSpec.hs | 23 ++ lib/core/test/unit/Cardano/Wallet/ApiSpec.hs | 16 +- .../test/unit/Cardano/Wallet/DB/Arbitrary.hs | 23 +- .../test/unit/Cardano/Wallet/DB/Properties.hs | 6 +- .../test/unit/Cardano/Wallet/DB/SqliteSpec.hs | 11 +- .../unit/Cardano/Wallet/DB/StateMachine.hs | 4 + .../Cardano/Wallet/Primitive/ModelSpec.hs | 19 +- .../Cardano/Wallet/Primitive/TypesSpec.hs | 18 +- lib/core/test/unit/Cardano/WalletSpec.hs | 24 +- .../Jormungandr/Scenario/API/StakePools.hs | 8 +- .../Jormungandr/Scenario/API/Transactions.hs | 2 +- .../Jormungandr/Scenario/CLI/Transactions.hs | 8 +- .../Cardano/Wallet/Jormungandr/BinarySpec.hs | 10 +- 35 files changed, 353 insertions(+), 401 deletions(-) delete mode 100644 lib/core/test/data/Cardano/Wallet/Api/ApiTransactionTestnet0.faulty.json diff --git a/lib/byron/test/integration/Test/Integration/Byron/Scenario/API/Migrations.hs b/lib/byron/test/integration/Test/Integration/Byron/Scenario/API/Migrations.hs index 424ecbb5060..c6bae26c470 100644 --- a/lib/byron/test/integration/Test/Integration/Byron/Scenario/API/Migrations.hs +++ b/lib/byron/test/integration/Test/Integration/Byron/Scenario/API/Migrations.hs @@ -20,6 +20,7 @@ import Cardano.Wallet.Api.Types , ApiTransaction , ApiWalletMigrationInfo , DecodeAddress (..) + , DecodeStakeAddress (..) , EncodeAddress (..) , WalletStyle (..) ) @@ -68,6 +69,7 @@ spec , PaymentAddress n ByronKey , EncodeAddress n , DecodeAddress n + , DecodeStakeAddress n ) => SpecWith (Context t) spec = do @@ -87,6 +89,7 @@ spec = do scenario_MIGRATE_01 :: forall (n :: NetworkDiscriminant) t. ( DecodeAddress n + , DecodeStakeAddress n , EncodeAddress n , PaymentAddress n ByronKey ) @@ -107,6 +110,7 @@ scenario_MIGRATE_01 fixtureSource = it title $ \ctx -> do scenario_MIGRATE_02 :: forall (n :: NetworkDiscriminant) t. ( DecodeAddress n + , DecodeStakeAddress n , EncodeAddress n , PaymentAddress n ByronKey ) diff --git a/lib/byron/test/integration/Test/Integration/Byron/Scenario/API/Transactions.hs b/lib/byron/test/integration/Test/Integration/Byron/Scenario/API/Transactions.hs index a251a557b0b..a76e2c69f4f 100644 --- a/lib/byron/test/integration/Test/Integration/Byron/Scenario/API/Transactions.hs +++ b/lib/byron/test/integration/Test/Integration/Byron/Scenario/API/Transactions.hs @@ -25,6 +25,7 @@ import Cardano.Wallet.Api.Types , ApiTxId (ApiTxId) , ApiUtxoStatistics , DecodeAddress (..) + , DecodeStakeAddress (..) , EncodeAddress (..) , Iso8601Time (..) , WalletStyle (..) @@ -108,6 +109,7 @@ spec , PaymentAddress n ByronKey , EncodeAddress n , DecodeAddress n + , DecodeStakeAddress n ) => SpecWith (Context t) spec = do @@ -173,6 +175,7 @@ spec = do scenario_TRANS_CREATE_01_02 :: forall (n :: NetworkDiscriminant) t. ( DecodeAddress n + , DecodeStakeAddress n , EncodeAddress n ) => (Context t -> IO ApiByronWallet) @@ -258,6 +261,7 @@ scenario_TRANS_CREATE_01_02 fixtureSource fixtures = it title $ \ctx -> do scenario_TRANS_ESTIMATE_01_02 :: forall (n :: NetworkDiscriminant) t. ( DecodeAddress n + , DecodeStakeAddress n , EncodeAddress n ) => (Context t -> IO ApiByronWallet) @@ -290,6 +294,7 @@ scenario_TRANS_ESTIMATE_01_02 fixtureSource fixtures = it title $ \ctx -> do scenario_TRANS_CREATE_04b :: forall (n :: NetworkDiscriminant) t. ( DecodeAddress n + , DecodeStakeAddress n , EncodeAddress n , PaymentAddress n IcarusKey ) @@ -312,6 +317,7 @@ scenario_TRANS_CREATE_04b = it title $ \ctx -> do scenario_TRANS_CREATE_04c :: forall (n :: NetworkDiscriminant) t. ( DecodeAddress n + , DecodeStakeAddress n , EncodeAddress n , PaymentAddress n IcarusKey ) @@ -334,6 +340,7 @@ scenario_TRANS_CREATE_04c = it title $ \ctx -> do scenario_TRANS_CREATE_04d :: forall (n :: NetworkDiscriminant) t. ( DecodeAddress n + , DecodeStakeAddress n , EncodeAddress n , PaymentAddress n IcarusKey ) @@ -356,6 +363,7 @@ scenario_TRANS_CREATE_04d = it title $ \ctx -> do scenario_TRANS_ESTIMATE_04b :: forall (n :: NetworkDiscriminant) t. ( DecodeAddress n + , DecodeStakeAddress n , EncodeAddress n , PaymentAddress n IcarusKey ) @@ -383,6 +391,7 @@ scenario_TRANS_ESTIMATE_04b = it title $ \ctx -> do scenario_TRANS_ESTIMATE_04c :: forall (n :: NetworkDiscriminant) t. ( DecodeAddress n + , DecodeStakeAddress n , EncodeAddress n , PaymentAddress n IcarusKey ) @@ -405,6 +414,7 @@ scenario_TRANS_ESTIMATE_04c = it title $ \ctx -> do scenario_TRANS_CREATE_07 :: forall (n :: NetworkDiscriminant) t. ( DecodeAddress n + , DecodeStakeAddress n , EncodeAddress n , PaymentAddress n ByronKey ) @@ -427,6 +437,7 @@ scenario_TRANS_CREATE_07 = it title $ \ctx -> do scenario_RESTORE_01 :: forall (n :: NetworkDiscriminant) t. ( DecodeAddress n + , DecodeStakeAddress n , EncodeAddress n , PaymentAddress n ByronKey ) @@ -504,6 +515,7 @@ scenario_RESTORE_01 fixtureSource = it title $ \ctx -> do scenario_RESTORE_02 :: forall (n :: NetworkDiscriminant) t. ( DecodeAddress n + , DecodeStakeAddress n , EncodeAddress n ) => (Context t -> IO (ApiByronWallet, [Address])) @@ -561,6 +573,7 @@ scenario_RESTORE_02 fixtureTarget = it title $ \ctx -> do scenario_RESTORE_03 :: forall (n :: NetworkDiscriminant) t. ( DecodeAddress n + , DecodeStakeAddress n , EncodeAddress n ) => (Context t -> IO (ApiByronWallet, [Address])) @@ -601,6 +614,7 @@ scenario_RESTORE_03 fixtureTarget = it title $ \ctx -> do scenario_TRANS_UTXO_01 :: forall (n :: NetworkDiscriminant) t. ( DecodeAddress n + , DecodeStakeAddress n , EncodeAddress n ) => (Context t -> IO ApiByronWallet) @@ -646,6 +660,7 @@ scenario_TRANS_UTXO_01 fixtureSource fixtureTarget = it title $ \ctx -> do scenario_TRANS_REG_1670 :: forall (n :: NetworkDiscriminant) t. ( DecodeAddress n + , DecodeStakeAddress n , EncodeAddress n , PaymentAddress n IcarusKey ) @@ -723,6 +738,7 @@ scenario_TRANS_REG_1670 fixture = it title $ \ctx -> do verifyTxInputsAndOutputs :: forall (d :: NetworkDiscriminant). ( DecodeAddress d + , DecodeStakeAddress d , EncodeAddress d , PaymentAddress d IcarusKey ) @@ -747,6 +763,7 @@ scenario_TRANS_REG_1670 fixture = it title $ \ctx -> do fixtureCantCoverFee :: forall (n :: NetworkDiscriminant) t. ( DecodeAddress n + , DecodeStakeAddress n , EncodeAddress n , PaymentAddress n IcarusKey ) @@ -764,6 +781,7 @@ fixtureCantCoverFee ctx = do fixtureNotEnoughMoney :: forall (n :: NetworkDiscriminant) t. ( DecodeAddress n + , DecodeStakeAddress n , EncodeAddress n , PaymentAddress n IcarusKey ) @@ -780,6 +798,7 @@ fixtureNotEnoughMoney ctx = do fixtureWrongPassphrase :: forall (n :: NetworkDiscriminant) t. ( DecodeAddress n + , DecodeStakeAddress n , EncodeAddress n , PaymentAddress n IcarusKey ) @@ -795,6 +814,7 @@ fixtureWrongPassphrase ctx = do fixtureDeletedWallet :: forall (n :: NetworkDiscriminant) t. ( DecodeAddress n + , DecodeStakeAddress n , EncodeAddress n , PaymentAddress n ByronKey ) @@ -831,6 +851,7 @@ mkPayment addr_ amnt = [json| postByronTransaction :: forall (n :: NetworkDiscriminant) t. ( DecodeAddress n + , DecodeStakeAddress n ) => Context t -- A surrounding API context diff --git a/lib/byron/test/integration/Test/Integration/Byron/Scenario/CLI/Transactions.hs b/lib/byron/test/integration/Test/Integration/Byron/Scenario/CLI/Transactions.hs index 83ca0a12c26..458b609a394 100644 --- a/lib/byron/test/integration/Test/Integration/Byron/Scenario/CLI/Transactions.hs +++ b/lib/byron/test/integration/Test/Integration/Byron/Scenario/CLI/Transactions.hs @@ -22,6 +22,7 @@ import Cardano.Wallet.Api.Types , ApiT (..) , ApiTransaction , DecodeAddress (..) + , DecodeStakeAddress (..) , EncodeAddress (..) , WalletStyle (..) ) @@ -120,6 +121,7 @@ spec , EncodeAddress n , KnownCommand t , DecodeAddress n + , DecodeStakeAddress n ) => SpecWith (Context t) spec = describe "BYRON_TXS_CLI" $ do @@ -486,6 +488,7 @@ spec = describe "BYRON_TXS_CLI" $ do scenario_TRANS_CREATE_01_02 :: forall (n :: NetworkDiscriminant) t. ( DecodeAddress n + , DecodeStakeAddress n , EncodeAddress n , KnownCommand t ) @@ -573,6 +576,7 @@ scenario_TRANS_CREATE_01_02 fixtureSource fixtures = it title $ \ctx -> do scenario_TRANS_ESTIMATE_01_02 :: forall (n :: NetworkDiscriminant) t. ( DecodeAddress n + , DecodeStakeAddress n , EncodeAddress n , KnownCommand t ) @@ -610,6 +614,7 @@ scenario_TRANS_ESTIMATE_01_02 fixtureSource fixtures = it title $ \ctx -> do scenario_TRANS_CREATE_04b :: forall (n :: NetworkDiscriminant) t. ( DecodeAddress n + , DecodeStakeAddress n , EncodeAddress n , PaymentAddress n IcarusKey , KnownCommand t @@ -633,6 +638,7 @@ scenario_TRANS_CREATE_04b = it title $ \ctx -> do scenario_TRANS_CREATE_04c :: forall (n :: NetworkDiscriminant) t. ( DecodeAddress n + , DecodeStakeAddress n , EncodeAddress n , PaymentAddress n IcarusKey , KnownCommand t @@ -656,6 +662,7 @@ scenario_TRANS_CREATE_04c = it title $ \ctx -> do scenario_TRANS_CREATE_04d :: forall (n :: NetworkDiscriminant) t. ( DecodeAddress n + , DecodeStakeAddress n , EncodeAddress n , PaymentAddress n IcarusKey , KnownCommand t @@ -679,6 +686,7 @@ scenario_TRANS_CREATE_04d = it title $ \ctx -> do scenario_TRANS_ESTIMATE_04b :: forall (n :: NetworkDiscriminant) t. ( DecodeAddress n + , DecodeStakeAddress n , EncodeAddress n , PaymentAddress n IcarusKey , KnownCommand t @@ -711,6 +719,7 @@ scenario_TRANS_ESTIMATE_04b = it title $ \ctx -> do scenario_TRANS_ESTIMATE_04c :: forall (n :: NetworkDiscriminant) t. ( DecodeAddress n + , DecodeStakeAddress n , EncodeAddress n , PaymentAddress n IcarusKey , KnownCommand t @@ -734,6 +743,7 @@ scenario_TRANS_ESTIMATE_04c = it title $ \ctx -> do scenario_TRANS_CREATE_07 :: forall (n :: NetworkDiscriminant) t. ( DecodeAddress n + , DecodeStakeAddress n , EncodeAddress n , PaymentAddress n ByronKey , KnownCommand t @@ -765,6 +775,7 @@ scenario_TRANS_CREATE_07 = it title $ \ctx -> do fixtureCantCoverFee :: forall (n :: NetworkDiscriminant) t. ( DecodeAddress n + , DecodeStakeAddress n , EncodeAddress n , PaymentAddress n IcarusKey ) @@ -782,6 +793,7 @@ fixtureCantCoverFee ctx = do fixtureNotEnoughMoney :: forall (n :: NetworkDiscriminant) t. ( DecodeAddress n + , DecodeStakeAddress n , EncodeAddress n , PaymentAddress n IcarusKey ) @@ -798,6 +810,7 @@ fixtureNotEnoughMoney ctx = do fixtureWrongPassphrase :: forall (n :: NetworkDiscriminant) t. ( DecodeAddress n + , DecodeStakeAddress n , EncodeAddress n , PaymentAddress n IcarusKey ) @@ -813,6 +826,7 @@ fixtureWrongPassphrase ctx = do fixtureDeletedWallet :: forall (n :: NetworkDiscriminant) t. ( DecodeAddress n + , DecodeStakeAddress n , EncodeAddress n , PaymentAddress n ByronKey ) diff --git a/lib/core-integration/src/Test/Integration/Framework/DSL.hs b/lib/core-integration/src/Test/Integration/Framework/DSL.hs index 75436df2af7..ce488e34e3c 100644 --- a/lib/core-integration/src/Test/Integration/Framework/DSL.hs +++ b/lib/core-integration/src/Test/Integration/Framework/DSL.hs @@ -164,6 +164,7 @@ import Cardano.Wallet.Api.Types , ApiWalletDelegationNext (..) , ApiWalletDelegationStatus (..) , DecodeAddress (..) + , DecodeStakeAddress (..) , EncodeAddress (..) , Iso8601Time (..) , WalletStyle (..) @@ -521,7 +522,7 @@ unsafeGetTransactionTime txs = _ -> error "Expected at least one transaction with a time." waitAllTxsInLedger - :: forall n t. (DecodeAddress n) + :: forall n t. (DecodeAddress n, DecodeStakeAddress n) => Context t -> ApiWallet -> IO () @@ -852,6 +853,7 @@ fixtureRandomWalletWith :: forall (n :: NetworkDiscriminant) t. ( EncodeAddress n , DecodeAddress n + , DecodeStakeAddress n , PaymentAddress n ByronKey ) => Context t @@ -903,6 +905,7 @@ fixtureIcarusWalletWith :: forall (n :: NetworkDiscriminant) t. ( EncodeAddress n , DecodeAddress n + , DecodeStakeAddress n , PaymentAddress n IcarusKey ) => Context t @@ -958,7 +961,11 @@ fixtureLegacyWallet ctx style mnemonics = do -- This function makes no attempt at ensuring the request is valid, so be -- careful. fixtureWalletWith - :: forall n t. (EncodeAddress n, DecodeAddress n) + :: forall n t. + ( EncodeAddress n + , DecodeAddress n + , DecodeStakeAddress n + ) => Context t -> [Natural] -> IO ApiWallet @@ -1019,6 +1026,7 @@ moveByronCoins :: forall (n :: NetworkDiscriminant) t. ( EncodeAddress n , DecodeAddress n + , DecodeStakeAddress n ) => Context t -- ^ Api context @@ -1098,6 +1106,7 @@ joinStakePool :: forall n t w. ( HasType (ApiT WalletId) w , DecodeAddress n + , DecodeStakeAddress n ) => Context t -> ApiT PoolId @@ -1114,6 +1123,7 @@ quitStakePool :: forall n t w. ( HasType (ApiT WalletId) w , DecodeAddress n + , DecodeStakeAddress n ) => Context t -> (w, Text) @@ -1237,7 +1247,11 @@ listAddresses ctx w = do return addrs listAllTransactions - :: forall n t w. (DecodeAddress n, HasType (ApiT WalletId) w) + :: forall n t w. + ( DecodeAddress n + , DecodeStakeAddress n + , HasType (ApiT WalletId) w + ) => Context t -> w -> IO [ApiTransaction n] @@ -1245,7 +1259,11 @@ listAllTransactions ctx w = listTransactions ctx w Nothing Nothing (Just Descending) listTransactions - :: forall n t w. (DecodeAddress n, HasType (ApiT WalletId) w) + :: forall n t w. + ( DecodeAddress n + , DecodeStakeAddress n + , HasType (ApiT WalletId) w + ) => Context t -> w -> Maybe UTCTime diff --git a/lib/core-integration/src/Test/Integration/Scenario/API/Byron/Addresses.hs b/lib/core-integration/src/Test/Integration/Scenario/API/Byron/Addresses.hs index f47923af04d..9514c239039 100644 --- a/lib/core-integration/src/Test/Integration/Scenario/API/Byron/Addresses.hs +++ b/lib/core-integration/src/Test/Integration/Scenario/API/Byron/Addresses.hs @@ -22,6 +22,7 @@ import Cardano.Wallet.Api.Types , ApiByronWallet , ApiT (..) , DecodeAddress + , DecodeStakeAddress , EncodeAddress (..) , WalletStyle (..) ) @@ -74,6 +75,7 @@ import qualified Network.HTTP.Types.Status as HTTP spec :: forall n t. ( DecodeAddress n + , DecodeStakeAddress n , EncodeAddress n , PaymentAddress n ByronKey , PaymentAddress n IcarusKey diff --git a/lib/core-integration/src/Test/Integration/Scenario/API/Byron/HWWallets.hs b/lib/core-integration/src/Test/Integration/Scenario/API/Byron/HWWallets.hs index f61437d6d95..f2eb97f81a7 100644 --- a/lib/core-integration/src/Test/Integration/Scenario/API/Byron/HWWallets.hs +++ b/lib/core-integration/src/Test/Integration/Scenario/API/Byron/HWWallets.hs @@ -30,6 +30,7 @@ import Cardano.Wallet.Api.Types , ApiTransaction , ApiUtxoStatistics , DecodeAddress + , DecodeStakeAddress , EncodeAddress (..) , WalletStyle (..) ) @@ -93,6 +94,7 @@ import qualified Network.HTTP.Types.Status as HTTP spec :: forall n t. ( DecodeAddress n + , DecodeStakeAddress n , EncodeAddress n , PaymentAddress n IcarusKey ) => SpecWith (Context t) diff --git a/lib/core-integration/src/Test/Integration/Scenario/API/Byron/Migrations.hs b/lib/core-integration/src/Test/Integration/Scenario/API/Byron/Migrations.hs index b4b3a266f31..b2e82c437e3 100644 --- a/lib/core-integration/src/Test/Integration/Scenario/API/Byron/Migrations.hs +++ b/lib/core-integration/src/Test/Integration/Scenario/API/Byron/Migrations.hs @@ -25,6 +25,7 @@ import Cardano.Wallet.Api.Types , ApiWallet , ApiWalletMigrationInfo (..) , DecodeAddress + , DecodeStakeAddress , EncodeAddress (..) , WalletStyle (..) ) @@ -90,6 +91,7 @@ import qualified Network.HTTP.Types.Status as HTTP spec :: forall n t. ( DecodeAddress n + , DecodeStakeAddress n , EncodeAddress n , PaymentAddress n ShelleyKey , PaymentAddress n IcarusKey diff --git a/lib/core-integration/src/Test/Integration/Scenario/API/Byron/Transactions.hs b/lib/core-integration/src/Test/Integration/Scenario/API/Byron/Transactions.hs index dd9ee75782f..803f4e9ec23 100644 --- a/lib/core-integration/src/Test/Integration/Scenario/API/Byron/Transactions.hs +++ b/lib/core-integration/src/Test/Integration/Scenario/API/Byron/Transactions.hs @@ -16,7 +16,12 @@ module Test.Integration.Scenario.API.Byron.Transactions import Prelude import Cardano.Wallet.Api.Types - ( ApiByronWallet, ApiTransaction, DecodeAddress, WalletStyle (..) ) + ( ApiByronWallet + , ApiTransaction + , DecodeAddress + , DecodeStakeAddress + , WalletStyle (..) + ) import Control.Monad ( forM_ ) import Data.Generics.Internal.VL.Lens @@ -63,6 +68,7 @@ data TestCase a = TestCase spec :: forall n t. ( DecodeAddress n + , DecodeStakeAddress n ) => SpecWith (Context t) spec = do diff --git a/lib/core-integration/src/Test/Integration/Scenario/API/Byron/Wallets.hs b/lib/core-integration/src/Test/Integration/Scenario/API/Byron/Wallets.hs index 613adf23875..1f9aac03a4e 100644 --- a/lib/core-integration/src/Test/Integration/Scenario/API/Byron/Wallets.hs +++ b/lib/core-integration/src/Test/Integration/Scenario/API/Byron/Wallets.hs @@ -30,6 +30,7 @@ import Cardano.Wallet.Api.Types , ApiUtxoStatistics , ApiWalletDiscovery (..) , DecodeAddress + , DecodeStakeAddress , EncodeAddress (..) , WalletStyle (..) ) @@ -100,6 +101,7 @@ import qualified Network.HTTP.Types.Status as HTTP spec :: forall n t. ( DecodeAddress n + , DecodeStakeAddress n , EncodeAddress n , PaymentAddress n ByronKey ) => SpecWith (Context t) diff --git a/lib/core-integration/src/Test/Integration/Scenario/API/Shelley/Addresses.hs b/lib/core-integration/src/Test/Integration/Scenario/API/Shelley/Addresses.hs index f897339016d..9fe6d034e16 100644 --- a/lib/core-integration/src/Test/Integration/Scenario/API/Shelley/Addresses.hs +++ b/lib/core-integration/src/Test/Integration/Scenario/API/Shelley/Addresses.hs @@ -17,6 +17,7 @@ import Cardano.Wallet.Api.Types , ApiTransaction , ApiWallet , DecodeAddress + , DecodeStakeAddress , EncodeAddress , WalletStyle (..) ) @@ -61,6 +62,7 @@ import qualified Network.HTTP.Types.Status as HTTP spec :: forall n t. ( DecodeAddress n + , DecodeStakeAddress n , EncodeAddress n ) => SpecWith (Context t) spec = do diff --git a/lib/core-integration/src/Test/Integration/Scenario/API/Shelley/HWWallets.hs b/lib/core-integration/src/Test/Integration/Scenario/API/Shelley/HWWallets.hs index add981d1987..547c6f5354b 100644 --- a/lib/core-integration/src/Test/Integration/Scenario/API/Shelley/HWWallets.hs +++ b/lib/core-integration/src/Test/Integration/Scenario/API/Shelley/HWWallets.hs @@ -24,6 +24,7 @@ import Cardano.Wallet.Api.Types , ApiUtxoStatistics , ApiWallet , DecodeAddress + , DecodeStakeAddress , EncodeAddress , WalletStyle (..) ) @@ -77,6 +78,7 @@ import qualified Network.HTTP.Types.Status as HTTP spec :: forall n t. ( DecodeAddress n + , DecodeStakeAddress n , EncodeAddress n ) => SpecWith (Context t) spec = do diff --git a/lib/core-integration/src/Test/Integration/Scenario/API/Shelley/Migrations.hs b/lib/core-integration/src/Test/Integration/Scenario/API/Shelley/Migrations.hs index f066d682309..9cd95b6a00d 100644 --- a/lib/core-integration/src/Test/Integration/Scenario/API/Shelley/Migrations.hs +++ b/lib/core-integration/src/Test/Integration/Scenario/API/Shelley/Migrations.hs @@ -24,6 +24,7 @@ import Cardano.Wallet.Api.Types , ApiWallet , ApiWalletMigrationInfo (..) , DecodeAddress + , DecodeStakeAddress , EncodeAddress (..) , WalletStyle (..) ) @@ -87,6 +88,7 @@ import qualified Network.HTTP.Types.Status as HTTP spec :: forall n t. ( DecodeAddress n + , DecodeStakeAddress n , EncodeAddress n , PaymentAddress n ShelleyKey , PaymentAddress n IcarusKey diff --git a/lib/core-integration/src/Test/Integration/Scenario/API/Shelley/StakePools.hs b/lib/core-integration/src/Test/Integration/Scenario/API/Shelley/StakePools.hs index 72ab1044e6a..74ad7838ce6 100644 --- a/lib/core-integration/src/Test/Integration/Scenario/API/Shelley/StakePools.hs +++ b/lib/core-integration/src/Test/Integration/Scenario/API/Shelley/StakePools.hs @@ -22,6 +22,7 @@ import Cardano.Wallet.Api.Types , ApiWallet , ApiWithdrawRewards (..) , DecodeAddress + , DecodeStakeAddress , EncodeAddress , WalletStyle (..) ) @@ -113,6 +114,7 @@ import qualified Network.HTTP.Types.Status as HTTP spec :: forall n t. ( DecodeAddress n + , DecodeStakeAddress n , EncodeAddress n , PaymentAddress n ShelleyKey ) => SpecWith (Context t) diff --git a/lib/core-integration/src/Test/Integration/Scenario/API/Shelley/Transactions.hs b/lib/core-integration/src/Test/Integration/Scenario/API/Shelley/Transactions.hs index ab4d2e17cd2..d84bdea8064 100644 --- a/lib/core-integration/src/Test/Integration/Scenario/API/Shelley/Transactions.hs +++ b/lib/core-integration/src/Test/Integration/Scenario/API/Shelley/Transactions.hs @@ -22,6 +22,7 @@ import Cardano.Wallet.Api.Types , ApiTxId (..) , ApiWallet , DecodeAddress + , DecodeStakeAddress , EncodeAddress , WalletStyle (..) , insertedAt @@ -116,6 +117,7 @@ data TestCase a = TestCase spec :: forall n t. ( DecodeAddress n + , DecodeStakeAddress n , EncodeAddress n ) => SpecWith (Context t) spec = do diff --git a/lib/core-integration/src/Test/Integration/Scenario/API/Shelley/Wallets.hs b/lib/core-integration/src/Test/Integration/Scenario/API/Shelley/Wallets.hs index c43e284999a..b3bfbae3531 100644 --- a/lib/core-integration/src/Test/Integration/Scenario/API/Shelley/Wallets.hs +++ b/lib/core-integration/src/Test/Integration/Scenario/API/Shelley/Wallets.hs @@ -36,6 +36,7 @@ import Cardano.Wallet.Api.Types , ApiUtxoStatistics , ApiWallet , DecodeAddress + , DecodeStakeAddress , EncodeAddress (..) , WalletStyle (..) ) @@ -128,6 +129,7 @@ import qualified Network.HTTP.Types.Status as HTTP spec :: forall n t. ( DecodeAddress n + , DecodeStakeAddress n , EncodeAddress n , PaymentAddress n ShelleyKey , PaymentAddress n IcarusKey diff --git a/lib/core-integration/src/Test/Integration/Scenario/CLI/Shelley/HWWallets.hs b/lib/core-integration/src/Test/Integration/Scenario/CLI/Shelley/HWWallets.hs index 92f938801b5..f928a80c913 100644 --- a/lib/core-integration/src/Test/Integration/Scenario/CLI/Shelley/HWWallets.hs +++ b/lib/core-integration/src/Test/Integration/Scenario/CLI/Shelley/HWWallets.hs @@ -18,6 +18,7 @@ import Cardano.Wallet.Api.Types , ApiUtxoStatistics , ApiWallet , DecodeAddress (..) + , DecodeStakeAddress (..) , EncodeAddress (..) , encodeAddress , getApiT @@ -83,6 +84,7 @@ import qualified Data.Text as T spec :: forall n t. ( KnownCommand t , DecodeAddress n + , DecodeStakeAddress n , EncodeAddress n ) => SpecWith (Context t) spec = do diff --git a/lib/core-integration/src/Test/Integration/Scenario/CLI/Shelley/Transactions.hs b/lib/core-integration/src/Test/Integration/Scenario/CLI/Shelley/Transactions.hs index 4640af8363b..a930da2b264 100644 --- a/lib/core-integration/src/Test/Integration/Scenario/CLI/Shelley/Transactions.hs +++ b/lib/core-integration/src/Test/Integration/Scenario/CLI/Shelley/Transactions.hs @@ -19,6 +19,7 @@ import Cardano.Wallet.Api.Types , ApiTransaction , ApiWallet , DecodeAddress + , DecodeStakeAddress , EncodeAddress (..) , getApiT ) @@ -100,6 +101,7 @@ import qualified Data.Text as T spec :: forall n t. ( KnownCommand t , DecodeAddress n + , DecodeStakeAddress n , EncodeAddress n ) => SpecWith (Context t) spec = do diff --git a/lib/core-integration/src/Test/Integration/Scenario/CLI/Shelley/Wallets.hs b/lib/core-integration/src/Test/Integration/Scenario/CLI/Shelley/Wallets.hs index 01b62ca44c9..024e8a83a6d 100644 --- a/lib/core-integration/src/Test/Integration/Scenario/CLI/Shelley/Wallets.hs +++ b/lib/core-integration/src/Test/Integration/Scenario/CLI/Shelley/Wallets.hs @@ -20,6 +20,7 @@ import Cardano.Wallet.Api.Types , ApiUtxoStatistics , ApiWallet , DecodeAddress (..) + , DecodeStakeAddress (..) , EncodeAddress (..) , getApiT ) @@ -96,6 +97,7 @@ import qualified Data.Text as T spec :: forall n t. ( KnownCommand t , DecodeAddress n + , DecodeStakeAddress n , EncodeAddress n ) => SpecWith (Context t) spec = do diff --git a/lib/core/src/Cardano/Wallet/Primitive/Types.hs b/lib/core/src/Cardano/Wallet/Primitive/Types.hs index 1c10fe5d1f1..ce537802d24 100644 --- a/lib/core/src/Cardano/Wallet/Primitive/Types.hs +++ b/lib/core/src/Cardano/Wallet/Primitive/Types.hs @@ -1709,14 +1709,13 @@ newtype ChimericAccount = ChimericAccount { unChimericAccount :: ByteString } instance NFData ChimericAccount instance Buildable ChimericAccount where - build = build . Hash @"Account" . unChimericAccount + build = build . Hash @"ChimericAccount" . unChimericAccount instance ToText ChimericAccount where - toText = toText . Hash @"Account" . unChimericAccount + toText = toText . Hash @"ChimericAccount" . unChimericAccount instance FromText ChimericAccount where - fromText = fmap (ChimericAccount . getHash @"Account") . fromText - + fromText = fmap (ChimericAccount . getHash @"ChimericAccount") . fromText -- | Represent a delegation certificate. data DelegationCertificate @@ -1848,11 +1847,12 @@ instance Buildable (Hash tag) where instance ToText (Hash tag) where toText = T.decodeUtf8 . convertToBase Base16 . getHash -instance FromText (Hash "Tx") where fromText = hashFromText 32 -instance FromText (Hash "Account") where fromText = hashFromText 32 -instance FromText (Hash "Genesis") where fromText = hashFromText 32 -instance FromText (Hash "Block") where fromText = hashFromText 32 -instance FromText (Hash "BlockHeader") where fromText = hashFromText 32 +instance FromText (Hash "Tx") where fromText = hashFromText 32 +instance FromText (Hash "Account") where fromText = hashFromText 32 +instance FromText (Hash "Genesis") where fromText = hashFromText 32 +instance FromText (Hash "Block") where fromText = hashFromText 32 +instance FromText (Hash "BlockHeader") where fromText = hashFromText 32 +instance FromText (Hash "ChimericAccount") where fromText = hashFromText 28 hashFromText :: forall t. (KnownSymbol t) diff --git a/lib/core/test/data/Cardano/Wallet/Api/ApiTransactionTestnet0.faulty.json b/lib/core/test/data/Cardano/Wallet/Api/ApiTransactionTestnet0.faulty.json deleted file mode 100644 index 97eb044a418..00000000000 --- a/lib/core/test/data/Cardano/Wallet/Api/ApiTransactionTestnet0.faulty.json +++ /dev/null @@ -1,245 +0,0 @@ -{ - "seed": -856323584806524003, - "samples": [ - { - "status": "pending", - "withdrawals": [], - "amount": { - "quantity": 160, - "unit": "lovelace" - }, - "inputs": [], - "direction": "incoming", - "outputs": [], - "pending_since": { - "time": "1898-12-06T13:00:00Z", - "block": { - "height": { - "quantity": 9806, - "unit": "block" - }, - "epoch_number": 12759, - "slot_number": 19363 - } - }, - "depth": { - "quantity": 27442, - "unit": "block" - }, - "id": "0c23721b0c5f624c611e515873641e19829a4e2685548e74715b7dd0b24a7d79" - }, - { - "inserted_at": { - "time": "1864-10-06T19:06:06.359193744932Z", - "block": { - "height": { - "quantity": 8958, - "unit": "block" - }, - "epoch_number": 24530, - "slot_number": 3578 - } - }, - "status": "in_ledger", - "withdrawals": [], - "amount": { - "quantity": 172, - "unit": "lovelace" - }, - "inputs": [], - "direction": "incoming", - "outputs": [], - "id": "2c7545182548423b1cd8e65261080395421947074a1c4642723920470e0b087a" - }, - { - "status": "pending", - "withdrawals": [], - "amount": { - "quantity": 168, - "unit": "lovelace" - }, - "inputs": [], - "direction": "outgoing", - "outputs": [], - "pending_since": { - "time": "1862-03-05T07:00:00Z", - "block": { - "height": { - "quantity": 10798, - "unit": "block" - }, - "epoch_number": 28662, - "slot_number": 18973 - } - }, - "depth": { - "quantity": 11315, - "unit": "block" - }, - "id": "125f164e104a5d46078d1740346617404d3f936a1e26540758de0b2f063e137a" - }, - { - "inserted_at": { - "time": "1866-05-16T05:49:04.515289439119Z", - "block": { - "height": { - "quantity": 4157, - "unit": "block" - }, - "epoch_number": 13024, - "slot_number": 19903 - } - }, - "status": "in_ledger", - "withdrawals": [], - "amount": { - "quantity": 165, - "unit": "lovelace" - }, - "inputs": [], - "direction": "outgoing", - "outputs": [], - "depth": { - "quantity": 23543, - "unit": "block" - }, - "id": "7830071b655eb26f429e2278520c3327e74f200ec2290b17e02b6d793e4d7aee" - }, - { - "inserted_at": { - "time": "1891-07-11T00:00:00Z", - "block": { - "height": { - "quantity": 15659, - "unit": "block" - }, - "epoch_number": 25996, - "slot_number": 14900 - } - }, - "status": "in_ledger", - "withdrawals": [], - "amount": { - "quantity": 22, - "unit": "lovelace" - }, - "inputs": [], - "direction": "incoming", - "outputs": [], - "depth": { - "quantity": 11786, - "unit": "block" - }, - "id": "4040470863077e442c31623309ae740e52561153170f9e631407665b1808126e" - }, - { - "status": "in_ledger", - "withdrawals": [], - "amount": { - "quantity": 51, - "unit": "lovelace" - }, - "inputs": [], - "direction": "outgoing", - "outputs": [], - "depth": { - "quantity": 6735, - "unit": "block" - }, - "id": "427b74005d522d7e544c1956436a59b94e041156617f50438c08389b43396940" - }, - { - "status": "pending", - "withdrawals": [], - "amount": { - "quantity": 65, - "unit": "lovelace" - }, - "inputs": [], - "direction": "outgoing", - "outputs": [], - "depth": { - "quantity": 31288, - "unit": "block" - }, - "id": "27c74e7a1f261d733710607f4e18104c15ba53424dcb6e43465a6c9b307b0378" - }, - { - "status": "pending", - "withdrawals": [], - "amount": { - "quantity": 234, - "unit": "lovelace" - }, - "inputs": [], - "direction": "outgoing", - "outputs": [], - "pending_since": { - "time": "1907-01-19T02:11:06Z", - "block": { - "height": { - "quantity": 15652, - "unit": "block" - }, - "epoch_number": 21816, - "slot_number": 6642 - } - }, - "depth": { - "quantity": 29512, - "unit": "block" - }, - "id": "703f2304674cc637743e40c07325a021317c5c3b72b73845290b1b6c5f8c9266" - }, - { - "status": "pending", - "withdrawals": [], - "amount": { - "quantity": 230, - "unit": "lovelace" - }, - "inputs": [], - "direction": "incoming", - "outputs": [], - "pending_since": { - "time": "1894-10-11T08:00:00Z", - "block": { - "height": { - "quantity": 8518, - "unit": "block" - }, - "epoch_number": 15755, - "slot_number": 22621 - } - }, - "id": "4f3a7584153d061872564471431302641465606336582531e51f787612103fc4" - }, - { - "status": "pending", - "withdrawals": [], - "amount": { - "quantity": 165, - "unit": "lovelace" - }, - "inputs": [], - "direction": "outgoing", - "outputs": [], - "pending_since": { - "time": "1901-09-20T09:00:00Z", - "block": { - "height": { - "quantity": 3162, - "unit": "block" - }, - "epoch_number": 12570, - "slot_number": 30931 - } - }, - "depth": { - "quantity": 25741, - "unit": "block" - }, - "id": "6b44174865226b2101076326181532481a6c507f7c7801592d14733914860d26" - } - ] -} \ No newline at end of file diff --git a/lib/core/test/data/Cardano/Wallet/Api/ApiTransactionTestnet0.json b/lib/core/test/data/Cardano/Wallet/Api/ApiTransactionTestnet0.json index 1ba95ed775d..0b87c558a93 100644 --- a/lib/core/test/data/Cardano/Wallet/Api/ApiTransactionTestnet0.json +++ b/lib/core/test/data/Cardano/Wallet/Api/ApiTransactionTestnet0.json @@ -1,231 +1,226 @@ { - "seed": -856323584806524003, + "seed": 6053236950585574193, "samples": [ { "status": "pending", + "withdrawals": [], "amount": { - "quantity": 226, + "quantity": 164, "unit": "lovelace" }, "inputs": [], "direction": "incoming", "outputs": [], "pending_since": { - "time": "1898-12-06T13:00:00Z", + "time": "1865-11-27T00:45:02.891766615378Z", "block": { "height": { - "quantity": 9806, + "quantity": 8562, "unit": "block" }, - "epoch_number": 12759, - "slot_number": 19363 + "epoch_number": 6541, + "slot_number": 1999 } }, - "depth": { - "quantity": 9366, - "unit": "block" - }, - "id": "212046712f796e020d124b421a45302b7b39ab0a6d8b195e20330a54bb604125" + "id": "525d0964716030bd190e3e3b256f795d6c731173a76047191f5c78601e934120" }, { - "inserted_at": { - "time": "1864-10-06T19:06:06.359193744932Z", - "block": { - "height": { - "quantity": 8958, - "unit": "block" - }, - "epoch_number": 24530, - "slot_number": 3578 - } - }, - "status": "in_ledger", + "status": "pending", + "withdrawals": [], "amount": { - "quantity": 17, + "quantity": 98, "unit": "lovelace" }, "inputs": [], - "direction": "incoming", + "direction": "outgoing", "outputs": [], - "depth": { - "quantity": 21227, - "unit": "block" - }, - "id": "5f776a8a3408243b2062231c532d417681735300405396652f0c0bbc613812df" + "id": "3a037b7019005a4721683804e21b573217625c68280f3e8e2f5d57fa6f3732f0" }, { "status": "pending", + "withdrawals": [], "amount": { - "quantity": 214, + "quantity": 226, "unit": "lovelace" }, "inputs": [], "direction": "incoming", "outputs": [], "pending_since": { - "time": "1862-03-05T07:00:00Z", + "time": "1883-06-08T10:47:06Z", "block": { "height": { - "quantity": 10798, + "quantity": 20027, "unit": "block" }, - "epoch_number": 28662, - "slot_number": 18973 + "epoch_number": 31665, + "slot_number": 547 } }, - "id": "1f0625477b4ce84d730b253b29ee7b1e5d6d73584c412273316cb6292e07382c" - }, - { - "inserted_at": { - "time": "1866-05-16T05:49:04.515289439119Z", - "block": { - "height": { - "quantity": 4157, - "unit": "block" - }, - "epoch_number": 13024, - "slot_number": 19903 - } - }, - "status": "in_ledger", - "amount": { - "quantity": 81, - "unit": "lovelace" + "depth": { + "quantity": 10530, + "unit": "block" }, - "inputs": [], - "direction": "incoming", - "outputs": [], - "id": "380c4c484d113555bd276d58316949432a768d3c5de2c4561caf350964348526" + "id": "751429625c321e537377af7615d0767e3a015f12496211520fd44c496b4c060d" }, { "inserted_at": { - "time": "1891-07-11T00:00:00Z", + "time": "1878-12-18T19:38:35.958580553853Z", "block": { "height": { - "quantity": 15659, + "quantity": 30534, "unit": "block" }, - "epoch_number": 25996, - "slot_number": 14900 + "epoch_number": 27805, + "slot_number": 27205 } }, "status": "in_ledger", + "withdrawals": [], "amount": { - "quantity": 177, + "quantity": 14, "unit": "lovelace" }, "inputs": [], - "direction": "outgoing", + "direction": "incoming", "outputs": [], "depth": { - "quantity": 17890, + "quantity": 14442, "unit": "block" }, - "id": "65495e417206503b7051420c093f704208070c2948810b26a8bb425d8bcf4d5c" + "id": "2a211a3430407b601f6a59ea1e822640675e423e461a8d6a14576579615bbb0d" }, { - "status": "in_ledger", + "status": "pending", + "withdrawals": [], "amount": { - "quantity": 222, + "quantity": 54, "unit": "lovelace" }, "inputs": [], - "direction": "outgoing", + "direction": "incoming", "outputs": [], "depth": { - "quantity": 1979, + "quantity": 14281, "unit": "block" }, - "id": "748d1a2a631d482d14397e6a451b4a74427b501d5f7564423717012d443a284a" + "id": "34c75472935253434c7668c0f9b64503121a5b2d071b4a30fd3629375c5f086f" }, { - "status": "pending", + "inserted_at": { + "time": "1902-10-08T23:11:39Z", + "block": { + "height": { + "quantity": 16538, + "unit": "block" + }, + "epoch_number": 16561, + "slot_number": 24304 + } + }, + "status": "in_ledger", + "withdrawals": [], "amount": { - "quantity": 1, + "quantity": 40, "unit": "lovelace" }, "inputs": [], "direction": "incoming", "outputs": [], "depth": { - "quantity": 8150, + "quantity": 8010, "unit": "block" }, - "id": "6b05350513015d60d55fd8024ea7451d1609ff09680c537c542e7053f393a920" + "id": "40782433736e114a36186c105e2602ae3f02100b7d8a1e04000d7c541e1ed74c" }, { "status": "pending", + "withdrawals": [], "amount": { - "quantity": 55, + "quantity": 121, "unit": "lovelace" }, "inputs": [], - "direction": "outgoing", + "direction": "incoming", "outputs": [], "pending_since": { - "time": "1907-01-19T02:11:06Z", + "time": "1864-05-10T04:19:09Z", "block": { "height": { - "quantity": 15652, + "quantity": 12912, "unit": "block" }, - "epoch_number": 21816, - "slot_number": 6642 + "epoch_number": 15822, + "slot_number": 8822 } }, - "depth": { - "quantity": 3184, - "unit": "block" - }, - "id": "7a1c012822613d0b9d6a5053135a232e7352377f7b171c5d6c0a22fd7f2c860d" + "id": "5f7f2401130757880f14316b64299605527715156d4b5f4aeb4052122c7f45b6" }, { - "status": "pending", - "amount": { - "quantity": 102, - "unit": "lovelace" - }, - "inputs": [], - "direction": "outgoing", - "outputs": [], - "pending_since": { - "time": "1894-10-11T08:00:00Z", + "inserted_at": { + "time": "1893-08-22T17:00:00Z", "block": { "height": { - "quantity": 8518, + "quantity": 18283, "unit": "block" }, - "epoch_number": 15755, - "slot_number": 22621 + "epoch_number": 22762, + "slot_number": 20049 } }, + "status": "in_ledger", + "withdrawals": [], + "amount": { + "quantity": 162, + "unit": "lovelace" + }, + "inputs": [], + "direction": "incoming", + "outputs": [], + "id": "654d191c1b6f69047e2a56180e69070533683b3d7a0803b96944ab6f5b658511" + }, + { + "status": "in_ledger", + "withdrawals": [], + "amount": { + "quantity": 119, + "unit": "lovelace" + }, + "inputs": [], + "direction": "incoming", + "outputs": [], "depth": { - "quantity": 9520, + "quantity": 30408, "unit": "block" }, - "id": "514f643f5b06245928074b12670d5c4648ae0b36aa9b2f2b5b334a034e6d7f11" + "id": "69f624217e7ea8332137742c7e1f5937125d4c521d365d76286a04637b3e2a33" }, { "status": "pending", + "withdrawals": [], "amount": { - "quantity": 180, + "quantity": 192, "unit": "lovelace" }, "inputs": [], - "direction": "incoming", + "direction": "outgoing", "outputs": [], "pending_since": { - "time": "1901-09-20T09:00:00Z", + "time": "1873-04-02T18:09:54Z", "block": { "height": { - "quantity": 3162, + "quantity": 31840, "unit": "block" }, - "epoch_number": 12570, - "slot_number": 30931 + "epoch_number": 9169, + "slot_number": 8592 } }, - "id": "58206c3f575a5b5f3906465d6e7a12667c5814097c3e2e07336f3d794225585f" + "depth": { + "quantity": 31984, + "unit": "block" + }, + "id": "292f1d4f1a0d7519657e09d22421595275067b26501c53861d762043138d0b77" } ] } \ No newline at end of file diff --git a/lib/core/test/shared/Cardano/Wallet/DummyTarget/Primitive/Types.hs b/lib/core/test/shared/Cardano/Wallet/DummyTarget/Primitive/Types.hs index 2e983841924..62ea73ae54b 100644 --- a/lib/core/test/shared/Cardano/Wallet/DummyTarget/Primitive/Types.hs +++ b/lib/core/test/shared/Cardano/Wallet/DummyTarget/Primitive/Types.hs @@ -21,6 +21,7 @@ import Cardano.Wallet.Primitive.Types ( ActiveSlotCoefficient (..) , Block (..) , BlockHeader (..) + , ChimericAccount (..) , Coin (..) , EpochLength (..) , FeePolicy (..) @@ -42,6 +43,8 @@ import Data.ByteString ( ByteString ) import Data.Coerce ( coerce ) +import Data.Map.Strict + ( Map ) import Data.Quantity ( Quantity (..) ) import Data.Time.Clock.POSIX @@ -102,12 +105,12 @@ dummyProtocolParameters = ProtocolParameters } -- | Construct a @Tx@, computing its hash using the dummy @mkTxId@. -mkTx :: [(TxIn, Coin)] -> [TxOut] -> Tx -mkTx ins outs = Tx (mkTxId ins outs) ins outs +mkTx :: [(TxIn, Coin)] -> [TxOut] -> Map ChimericAccount Coin -> Tx +mkTx ins outs wdrls = Tx (mkTxId ins outs wdrls) ins outs wdrls -- | txId calculation for testing purposes. -mkTxId :: [(TxIn, Coin)] -> [TxOut] -> Hash "Tx" -mkTxId = curry mockHash +mkTxId :: [(TxIn, Coin)] -> [TxOut] -> Map ChimericAccount Coin -> Hash "Tx" +mkTxId ins outs wdrls = mockHash (ins, outs, wdrls) -- | Construct a good-enough hash for testing mockHash :: Show a => a -> Hash whatever diff --git a/lib/core/test/unit/Cardano/Wallet/Api/TypesSpec.hs b/lib/core/test/unit/Cardano/Wallet/Api/TypesSpec.hs index d0f1d3c8779..51e9dbb5d12 100644 --- a/lib/core/test/unit/Cardano/Wallet/Api/TypesSpec.hs +++ b/lib/core/test/unit/Cardano/Wallet/Api/TypesSpec.hs @@ -74,12 +74,15 @@ import Cardano.Wallet.Api.Types , ApiWalletMigrationPostData (..) , ApiWalletPassphrase (..) , ApiWalletPassphraseInfo (..) + , ApiWithdrawal (..) , ByronWalletFromXPrvPostData (..) , ByronWalletPostData (..) , ByronWalletPutPassphraseData (..) , ByronWalletStyle (..) , DecodeAddress (..) + , DecodeStakeAddress (..) , EncodeAddress (..) + , EncodeStakeAddress (..) , Iso8601Time (..) , NtpSyncingStatus (..) , PostExternalTransactionData (..) @@ -115,6 +118,7 @@ import Cardano.Wallet.Primitive.SyncProgress import Cardano.Wallet.Primitive.Types ( Address (..) , AddressState (..) + , ChimericAccount (..) , Coin (..) , Direction (..) , EpochNo (..) @@ -710,6 +714,7 @@ spec = do , inputs = inputs (x :: ApiTransaction ('Testnet 0)) , outputs = outputs (x :: ApiTransaction ('Testnet 0)) , status = status (x :: ApiTransaction ('Testnet 0)) + , withdrawals = withdrawals (x :: ApiTransaction ('Testnet 0)) } in x' === x .&&. show x' === show x @@ -797,6 +802,15 @@ instance DecodeAddress ('Testnet 0) where decodeAddress "" = Right $ Address "" decodeAddress _ = Left $ TextDecodingError "invalid address" +-- Dummy instances +instance EncodeStakeAddress ('Testnet 0) where + encodeStakeAddress = const "" + +instance DecodeStakeAddress ('Testnet 0) where + decodeStakeAddress "" = Right $ ChimericAccount "" + decodeStakeAddress _ = Left $ TextDecodingError "invalid stake address" + + {------------------------------------------------------------------------------- Arbitrary Instances -------------------------------------------------------------------------------} @@ -1234,8 +1248,17 @@ instance Arbitrary (ApiTransaction t) where <*> arbitrary <*> Test.QuickCheck.scale (`mod` 3) arbitrary <*> Test.QuickCheck.scale (`mod` 3) arbitrary + <*> Test.QuickCheck.scale (`mod` 3) arbitrary <*> pure txStatus +instance Arbitrary (ApiWithdrawal (t :: NetworkDiscriminant)) where + arbitrary = ApiWithdrawal + <$> fmap (, Proxy @t) arbitrary + <*> arbitrary + +instance Arbitrary ChimericAccount where + arbitrary = ChimericAccount . BS.pack <$> vector 28 + instance Arbitrary Coin where -- No Shrinking arbitrary = Coin <$> choose (0, 1_000_000_000_000_000) diff --git a/lib/core/test/unit/Cardano/Wallet/ApiSpec.hs b/lib/core/test/unit/Cardano/Wallet/ApiSpec.hs index 7af3a539526..33517703c6c 100644 --- a/lib/core/test/unit/Cardano/Wallet/ApiSpec.hs +++ b/lib/core/test/unit/Cardano/Wallet/ApiSpec.hs @@ -51,11 +51,16 @@ import Cardano.Wallet.Api.Malformed import Cardano.Wallet.Api.Server ( LiftHandler (..) ) import Cardano.Wallet.Api.Types - ( ApiStakePool, DecodeAddress (..), EncodeAddress (..) ) + ( ApiStakePool + , DecodeAddress (..) + , DecodeStakeAddress (..) + , EncodeAddress (..) + , EncodeStakeAddress (..) + ) import Cardano.Wallet.Primitive.AddressDerivation ( NetworkDiscriminant (..) ) import Cardano.Wallet.Primitive.Types - ( Address (..) ) + ( Address (..), ChimericAccount (..) ) import Control.Arrow ( first ) import Control.Monad @@ -321,6 +326,13 @@ instance EncodeAddress ('Testnet 0) where instance DecodeAddress ('Testnet 0) where decodeAddress _ = pure (Address "") +-- Dummy instances +instance EncodeStakeAddress ('Testnet 0) where + encodeStakeAddress = T.pack . show + +instance DecodeStakeAddress ('Testnet 0) where + decodeStakeAddress _ = pure (ChimericAccount "") + everyPathParam :: GEveryEndpoints api => Proxy api -> MkPathRequest api everyPathParam proxy = gEveryPathParam proxy defaultRequest diff --git a/lib/core/test/unit/Cardano/Wallet/DB/Arbitrary.hs b/lib/core/test/unit/Cardano/Wallet/DB/Arbitrary.hs index 6f1a94aa9ce..6418e167a71 100644 --- a/lib/core/test/unit/Cardano/Wallet/DB/Arbitrary.hs +++ b/lib/core/test/unit/Cardano/Wallet/DB/Arbitrary.hs @@ -376,9 +376,19 @@ arbitraryChainLength = 10 -------------------------------------------------------------------------------} instance Arbitrary Tx where - shrink (Tx _tid ins outs) = - [mkTx ins' outs | ins' <- shrinkList' ins ] ++ - [mkTx ins outs' | outs' <- shrinkList' outs ] + shrink (Tx _tid ins outs wdrls) = mconcat + [ [ mkTx ins' outs wdrls + | ins' <- shrinkList' ins + ] + + , [ mkTx ins outs' wdrls + | outs' <- shrinkList' outs + ] + + , [ mkTx ins outs (Map.fromList wdrls') + | wdrls' <- shrinkList' (Map.toList wdrls) + ] + ] where shrinkList' xs = filter (not . null) [ take n xs | Positive n <- shrink (Positive $ length xs) ] @@ -386,7 +396,8 @@ instance Arbitrary Tx where arbitrary = do ins <- fmap (L.nub . L.take 5 . getNonEmpty) arbitrary outs <- fmap (L.take 5 . getNonEmpty) arbitrary - return $ mkTx ins outs + wdrls <- fmap (Map.fromList . L.take 5) arbitrary + return $ mkTx ins outs wdrls instance Arbitrary TxIn where arbitrary = TxIn @@ -611,6 +622,10 @@ instance Arbitrary Percentage where instance Arbitrary DecentralizationLevel where arbitrary = DecentralizationLevel <$> arbitrary +instance Arbitrary ChimericAccount where + arbitrary = + ChimericAccount . BS.pack <$> vector 28 + instance Arbitrary (Hash purpose) where arbitrary = do Hash . convertToBase Base16 . BS.pack <$> vector 16 diff --git a/lib/core/test/unit/Cardano/Wallet/DB/Properties.hs b/lib/core/test/unit/Cardano/Wallet/DB/Properties.hs index 10d4dd69f21..6819240fbca 100644 --- a/lib/core/test/unit/Cardano/Wallet/DB/Properties.hs +++ b/lib/core/test/unit/Cardano/Wallet/DB/Properties.hs @@ -515,8 +515,8 @@ prop_getTxAfterPutValidTxId db@DBLayer{..} wid txGen = prop = do let txs = unGenTxHistory txGen run $ unsafeRunExceptT $ mapExceptT atomically $ putTxHistory wid txs - forM_ txs $ \((Tx txId _ _), txMeta) -> do - (Just (TransactionInfo txId' _ _ txMeta' _ _)) <- + forM_ txs $ \((Tx txId _ _ _), txMeta) -> do + (Just (TransactionInfo txId' _ _ _ txMeta' _ _)) <- run $ atomically $ unsafeRunExceptT $ getTx wid txId monitor $ counterexample $ @@ -567,7 +567,7 @@ prop_getTxAfterPutInvalidWalletId db@DBLayer{..} (key, cp, meta) txGen key'@(Pri prop = liftIO $ do let txs = unGenTxHistory txGen atomically (runExceptT $ putTxHistory key txs) `shouldReturn` Right () - forM_ txs $ \((Tx txId _ _), _) -> do + forM_ txs $ \((Tx txId _ _ _), _) -> do let err = ErrNoSuchWallet wid' atomically (runExceptT $ getTx key' txId) `shouldReturn` Left err diff --git a/lib/core/test/unit/Cardano/Wallet/DB/SqliteSpec.hs b/lib/core/test/unit/Cardano/Wallet/DB/SqliteSpec.hs index 0c00ae0f32e..85486c74c35 100644 --- a/lib/core/test/unit/Cardano/Wallet/DB/SqliteSpec.hs +++ b/lib/core/test/unit/Cardano/Wallet/DB/SqliteSpec.hs @@ -582,7 +582,7 @@ fileModeSpec = do , parentHeaderHash = hashA }) mockTxs - [] + mempty let (FilteredBlock _ txs, cpB) = applyBlock fakeBlock cpA atomically $ do unsafeRunExceptT $ putCheckpoint testPk cpB @@ -592,8 +592,8 @@ fileModeSpec = do let mockApplyBlock1 = mockApply (dummyHash "block1") [ Tx (dummyHash "tx1") [(TxIn (dummyHash "faucet") 0, Coin 4)] - [ TxOut (head ourAddrs) (Coin 4) - ] + [ TxOut (head ourAddrs) (Coin 4) ] + mempty ] -- Slot 1 0 @@ -604,11 +604,11 @@ fileModeSpec = do mockApply (dummyHash "block2a") [ Tx (dummyHash "tx2a") - [ (TxIn (dummyHash "tx1") 0, Coin 4) - ] + [ (TxIn (dummyHash "tx1") 0, Coin 4) ] [ TxOut (dummyAddr "faucetAddr2") (Coin 2) , TxOut (ourAddrs !! 1) (Coin 2) ] + mempty ] -- Slot 3 0 @@ -839,6 +839,7 @@ testTxs = [ ( Tx (mockHash @String "tx2") [ (TxIn (mockHash @String "tx1") 0, Coin 1)] [ TxOut (Address "addr") (Coin 1) ] + mempty , TxMeta InLedger Incoming (SlotId 14 0) (Quantity 0) (Quantity 1337144) ) ] diff --git a/lib/core/test/unit/Cardano/Wallet/DB/StateMachine.hs b/lib/core/test/unit/Cardano/Wallet/DB/StateMachine.hs index 9beb16d564d..80dbed20a47 100644 --- a/lib/core/test/unit/Cardano/Wallet/DB/StateMachine.hs +++ b/lib/core/test/unit/Cardano/Wallet/DB/StateMachine.hs @@ -110,6 +110,7 @@ import Cardano.Wallet.Primitive.Model import Cardano.Wallet.Primitive.Types ( Address , BlockHeader + , ChimericAccount (..) , Coin (..) , DecentralizationLevel , DelegationCertificate @@ -857,6 +858,9 @@ instance ToExpr MWid where instance ToExpr StakeKeyCertificate where toExpr = genericToExpr +instance ToExpr ChimericAccount where + toExpr = genericToExpr + {------------------------------------------------------------------------------- Tagging -------------------------------------------------------------------------------} diff --git a/lib/core/test/unit/Cardano/Wallet/Primitive/ModelSpec.hs b/lib/core/test/unit/Cardano/Wallet/Primitive/ModelSpec.hs index 0b696922d01..d3eb371df7d 100644 --- a/lib/core/test/unit/Cardano/Wallet/Primitive/ModelSpec.hs +++ b/lib/core/test/unit/Cardano/Wallet/Primitive/ModelSpec.hs @@ -261,7 +261,7 @@ txOutsOurs txs = -- the transaction outputs to be ordered correctly, since they become available -- inputs for the subsequent blocks. utxoFromTx :: Tx -> UTxO -utxoFromTx tx@(Tx _ _ outs) = +utxoFromTx tx@(Tx _ _ outs _) = UTxO $ Map.fromList $ zip (TxIn (txId tx) <$> [0..]) outs @@ -377,6 +377,7 @@ blockchain = , coin = Coin 3844423800000 } ] + , withdrawals = mempty } ] , delegations = [] @@ -407,6 +408,7 @@ blockchain = , coin = Coin 3351830178 } ] + , withdrawals = mempty } , Tx { txId = Hash "b17ca3d2b8a991ea4680d1ebd9940a03449b1b6261fbe625d5cae6599726ea41" @@ -426,6 +428,7 @@ blockchain = , coin = Coin 19999800000 } ] + , withdrawals = mempty } ] , delegations = [] @@ -456,6 +459,7 @@ blockchain = , coin = Coin 3495800000 } ] + , withdrawals = mempty } , Tx { txId = Hash "6ed51b05821f0dc130a9411f0d63a241a624fbc8a9c8a2a13da8194ce3c463f4" @@ -475,6 +479,7 @@ blockchain = , coin = Coin 29999800000 } ] + , withdrawals = mempty } ] , delegations = [] @@ -505,6 +510,7 @@ blockchain = , coin = Coin 500000000 } ] + , withdrawals = mempty } ] , delegations = [] @@ -545,6 +551,7 @@ blockchain = , coin = Coin 9999800000 } ] + , withdrawals = mempty } ] , delegations = [] @@ -574,6 +581,7 @@ blockchain = , coin = Coin 3273721339 } ] + , withdrawals = mempty } ] , delegations = [] @@ -604,6 +612,7 @@ blockchain = , coin = Coin 19999800000 } ] + , withdrawals = mempty } ] , delegations = [] @@ -648,6 +657,7 @@ blockchain = , coin = Coin 12999433909 } ] + , withdrawals = mempty } ] , delegations = [] @@ -718,6 +728,7 @@ blockchain = , coin = Coin 16837395907 } ] + , withdrawals = mempty } , Tx { txId = Hash "611ce641f0f9282a35b1678fcd996016833c0de9e83a04bfa1178c8f045196ea" @@ -737,6 +748,7 @@ blockchain = , coin = Coin 748331810 } ] + , withdrawals = mempty } ] , delegations = [] @@ -767,6 +779,7 @@ blockchain = , coin = Coin 1499800000 } ] + , withdrawals = mempty } , Tx { txId = Hash "b8e9699ffff40c993d6778f586110b78cd30826feaa5314adf3a2e9894b9313a" @@ -786,6 +799,7 @@ blockchain = , coin = Coin 1345293520 } ] + , withdrawals = mempty } ] , delegations = [] @@ -876,6 +890,7 @@ blockchain = , coin = Coin 11823271860 } ] + , withdrawals = mempty } , Tx { txId = Hash "7726526b5cc003f71d9629c611397285004b5438eac9a118c2b20e2810e0783e" @@ -895,6 +910,7 @@ blockchain = , coin = Coin 2700667457 } ] + , withdrawals = mempty } ] , delegations = [] @@ -925,6 +941,7 @@ blockchain = , coin = Coin 19999800000 } ] + , withdrawals = mempty } ] , delegations = [] diff --git a/lib/core/test/unit/Cardano/Wallet/Primitive/TypesSpec.hs b/lib/core/test/unit/Cardano/Wallet/Primitive/TypesSpec.hs index 24c9616cfb0..77287d26757 100644 --- a/lib/core/test/unit/Cardano/Wallet/Primitive/TypesSpec.hs +++ b/lib/core/test/unit/Cardano/Wallet/Primitive/TypesSpec.hs @@ -32,6 +32,7 @@ import Cardano.Wallet.Primitive.Types , Block (..) , BlockHeader (..) , BoundType + , ChimericAccount (..) , Coin (..) , Direction (..) , Dom (..) @@ -203,6 +204,7 @@ spec = do textRoundtrip $ Proxy @(Hash "Genesis") textRoundtrip $ Proxy @(Hash "Tx") textRoundtrip $ Proxy @(Hash "Account") + textRoundtrip $ Proxy @(Hash "ChimericAccount") textRoundtrip $ Proxy @(Hash "Block") textRoundtrip $ Proxy @(Hash "BlockHeader") textRoundtrip $ Proxy @SyncTolerance @@ -1093,6 +1095,9 @@ instance Arbitrary (Hash "Block") where instance Arbitrary (Hash "Account") where arbitrary = Hash . BS.pack <$> vector 32 +instance Arbitrary (Hash "ChimericAccount") where + arbitrary = Hash . BS.pack <$> vector 28 + instance Arbitrary (Hash "BlockHeader") where arbitrary = Hash . BS.pack <$> vector 32 @@ -1182,13 +1187,17 @@ instance Arbitrary UTxO where return $ UTxO $ Map.fromList utxo instance Arbitrary Tx where - shrink (Tx tid ins outs) = - (flip (Tx tid) outs <$> shrink ins) <> ((Tx tid) ins <$> shrink outs) + shrink (Tx tid ins outs wdrls) = mconcat + [ (\ins' -> Tx tid ins' outs wdrls) <$> shrink ins + , (\outs' -> Tx tid ins outs' wdrls) <$> shrink outs + , (Tx tid ins outs . Map.fromList) <$> shrink (Map.toList wdrls) + ] arbitrary = do ins <- choose (1, 3) >>= vector outs <- choose (1, 3) >>= vector + wdrls <- choose (1,3) >>= vector tid <- genHash - return $ Tx tid ins outs + return $ Tx tid ins outs (Map.fromList wdrls) where genHash = elements [ Hash "Tx1" @@ -1196,6 +1205,9 @@ instance Arbitrary Tx where , Hash "Tx3" ] +instance Arbitrary ChimericAccount where + arbitrary = ChimericAccount . BS.pack <$> vector 28 + instance Arbitrary BlockHeader where shrink _ = [] arbitrary = arbitrary >>= genBlockHeader diff --git a/lib/core/test/unit/Cardano/WalletSpec.hs b/lib/core/test/unit/Cardano/WalletSpec.hs index c0957ea6358..e4a1849baf4 100644 --- a/lib/core/test/unit/Cardano/WalletSpec.hs +++ b/lib/core/test/unit/Cardano/WalletSpec.hs @@ -627,8 +627,8 @@ dummyTransactionLayer :: TransactionLayer DummyTarget JormungandrKey dummyTransactionLayer = TransactionLayer { mkStdTx = \_ keyFrom _slot cs -> do let inps' = map (second coin) (CS.inputs cs) - let tid = mkTxId inps' (CS.outputs cs) - let tx = Tx tid inps' (CS.outputs cs) + let tid = mkTxId inps' (CS.outputs cs) mempty + let tx = Tx tid inps' (CS.outputs cs) mempty wit <- forM (CS.inputs cs) $ \(_, TxOut addr _) -> do (xprv, Passphrase pwd) <- withEither (ErrKeyNotFoundForAddress addr) $ keyFrom addr @@ -788,9 +788,19 @@ instance Arbitrary Coin where arbitrary = Coin <$> arbitrary instance Arbitrary Tx where - shrink (Tx tid ins outs) = - [Tx tid ins' outs | ins' <- shrinkList' ins ] ++ - [Tx tid ins outs' | outs' <- shrinkList' outs ] + shrink (Tx tid ins outs wdrls) = mconcat + [ [ Tx tid ins' outs wdrls + | ins' <- shrinkList' ins + ] + + , [ Tx tid ins outs' wdrls + | outs' <- shrinkList' outs + ] + + , [ Tx tid ins outs (Map.fromList wdrls') + | wdrls' <- shrinkList' (Map.toList wdrls) + ] + ] where shrinkList' xs = filter (not . null) [ take n xs | Positive n <- shrink (Positive $ length xs) ] @@ -798,6 +808,10 @@ instance Arbitrary Tx where <$> arbitrary <*> fmap (L.nub . L.take 5 . getNonEmpty) arbitrary <*> fmap (L.take 5 . getNonEmpty) arbitrary + <*> fmap (Map.fromList . L.take 5) arbitrary + +instance Arbitrary ChimericAccount where + arbitrary = ChimericAccount . BS.pack <$> vector 28 instance Arbitrary TxIn where arbitrary = TxIn diff --git a/lib/jormungandr/test/integration/Test/Integration/Jormungandr/Scenario/API/StakePools.hs b/lib/jormungandr/test/integration/Test/Integration/Jormungandr/Scenario/API/StakePools.hs index ca18c5f4419..6e1d0f0f267 100644 --- a/lib/jormungandr/test/integration/Test/Integration/Jormungandr/Scenario/API/StakePools.hs +++ b/lib/jormungandr/test/integration/Test/Integration/Jormungandr/Scenario/API/StakePools.hs @@ -22,6 +22,7 @@ import Cardano.Wallet.Api.Types , ApiTransaction , ApiWallet , DecodeAddress + , DecodeStakeAddress , EncodeAddress , WalletStyle (..) ) @@ -109,6 +110,7 @@ import qualified Network.HTTP.Types.Status as HTTP spec :: forall n t. ( DecodeAddress n + , DecodeStakeAddress n , EncodeAddress n ) => SpecWith (Port "node", FeePolicy, Context t) spec = do @@ -835,6 +837,7 @@ dummyPool = PoolId mempty joinStakePoolWithWalletBalance :: forall n t. ( DecodeAddress n + , DecodeStakeAddress n , EncodeAddress n ) => (Context t) @@ -856,7 +859,10 @@ joinStakePoolWithWalletBalance ctx balance = do return (w, p) joinStakePoolWithFixtureWallet - :: forall n t. (DecodeAddress n) + :: forall n t. + ( DecodeAddress n + , DecodeStakeAddress n + ) => (Context t) -> IO (ApiWallet, ApiStakePool) joinStakePoolWithFixtureWallet ctx = do diff --git a/lib/jormungandr/test/integration/Test/Integration/Jormungandr/Scenario/API/Transactions.hs b/lib/jormungandr/test/integration/Test/Integration/Jormungandr/Scenario/API/Transactions.hs index 8d79de2e2d8..466d916e9fc 100644 --- a/lib/jormungandr/test/integration/Test/Integration/Jormungandr/Scenario/API/Transactions.hs +++ b/lib/jormungandr/test/integration/Test/Integration/Jormungandr/Scenario/API/Transactions.hs @@ -471,7 +471,7 @@ fixtureExternalTx ctx toSend = do let wSrc = getFromResponse Prelude.id r0 -- we take input by lookking at transactions of the faucet wallet txsSrc <- listAllTransactions @n ctx wSrc - let (ApiTransaction (ApiT theTxId) _ _ _ _ _ _ outs _):_ = reverse txsSrc + let (ApiTransaction (ApiT theTxId) _ _ _ _ _ _ outs _ _):_ = reverse txsSrc let (AddressAmount ((ApiT addrSrc),_) (Quantity amt)):_ = outs let (rootXPrv, pwd, st) = getSeqState mnemonicFaucet password -- we create change address diff --git a/lib/jormungandr/test/integration/Test/Integration/Jormungandr/Scenario/CLI/Transactions.hs b/lib/jormungandr/test/integration/Test/Integration/Jormungandr/Scenario/CLI/Transactions.hs index 575fc501c28..47cd945decb 100644 --- a/lib/jormungandr/test/integration/Test/Integration/Jormungandr/Scenario/CLI/Transactions.hs +++ b/lib/jormungandr/test/integration/Test/Integration/Jormungandr/Scenario/CLI/Transactions.hs @@ -13,7 +13,12 @@ module Test.Integration.Jormungandr.Scenario.CLI.Transactions import Prelude import Cardano.Wallet.Api.Types - ( ApiTxId (..), ApiWallet, DecodeAddress (..), getApiT ) + ( ApiTxId (..) + , ApiWallet + , DecodeAddress (..) + , DecodeStakeAddress + , getApiT + ) import Cardano.Wallet.Primitive.AddressDerivation ( DelegationAddress (..), hex ) import Cardano.Wallet.Primitive.AddressDerivation.Jormungandr @@ -71,6 +76,7 @@ import qualified Data.Text.Encoding as T spec :: forall n t. ( KnownCommand t , DecodeAddress n + , DecodeStakeAddress n , DelegationAddress n JormungandrKey ) => SpecWith (Context t) spec = do diff --git a/lib/jormungandr/test/unit/Cardano/Wallet/Jormungandr/BinarySpec.hs b/lib/jormungandr/test/unit/Cardano/Wallet/Jormungandr/BinarySpec.hs index 09ac618647e..c3f535989ce 100644 --- a/lib/jormungandr/test/unit/Cardano/Wallet/Jormungandr/BinarySpec.hs +++ b/lib/jormungandr/test/unit/Cardano/Wallet/Jormungandr/BinarySpec.hs @@ -172,19 +172,19 @@ spec = do monitor (counterexample $ show fragment') case fragment' of - Transaction (Tx _ inps outs) -> do + Transaction (Tx _ inps outs _) -> do monitor (QC.label "Transaction") assert (inps == fragmentInputs test) assert (outs == fragmentOutputs test) - StakeDelegation (DlgFull poolId, accountId, (Tx _ inps outs)) -> do + StakeDelegation (DlgFull poolId, accountId, (Tx _ inps outs _)) -> do monitor (QC.label "StakeDelegation (Full)") assert (inps == fragmentInputs test) assert (outs == fragmentOutputs test) assert (Just accountId == fragmentAccountId test) assert (Just poolId == fragmentPoolId test) - StakeDelegation (DlgNone, accountId, (Tx _ inps outs)) -> do + StakeDelegation (DlgNone, accountId, (Tx _ inps outs _)) -> do monitor (QC.label "StakeDelegation (None)") assert (inps == fragmentInputs test) assert (outs == fragmentOutputs test) @@ -213,7 +213,7 @@ spec = do runGet getFragment (BL.fromStrict tx) `shouldBe` - PoolRegistration (poolId', [owner], taxes, Tx txId' [] []) + PoolRegistration (poolId', [owner], taxes, Tx txId' [] [] mempty) describe "Decode External Tx" $ do let tl = newTransactionLayer @JormungandrKey (Hash "genesis") @@ -234,7 +234,7 @@ spec = do case decodeSignedTx tl bytes of Left err -> run $ expectationFailure $ show err - Right (tx@(Tx _ inps outs), SealedTx bytes') -> do + Right (tx@(Tx _ inps outs _), SealedTx bytes') -> do monitor (counterexample $ show tx) assert (inps == fragmentInputs test) assert (outs == fragmentOutputs test) From fd55332abdf337540cc62b3092d18230c0116dcf Mon Sep 17 00:00:00 2001 From: KtorZ Date: Wed, 8 Jul 2020 22:48:15 +0200 Subject: [PATCH 7/9] add withdrawals to the API Swagger specification We represent them as a list and not a key:value map with stake address as key because clients typically don't know the stake address associated with their wallet, so it'd be quite impractical for them to access this data if returned as a map... --- specifications/api/swagger.yaml | 21 +++++++++++++++++++++ 1 file changed, 21 insertions(+) diff --git a/specifications/api/swagger.yaml b/specifications/api/swagger.yaml index 40fe06b3f93..e1e33642fcc 100644 --- a/specifications/api/swagger.yaml +++ b/specifications/api/swagger.yaml @@ -215,6 +215,11 @@ x-amount: &amount enum: - lovelace +x-stakeAddress: &stakeAddress + type: string + format: bech32 + example: stake_addr1sjck9mdmfyhzvjhydcjllgj9vjvl522w0573ncustrrr2rg7h9azg4cyqd36yyd48t5ut72hgld0fg2x + x-addressId: &addressId type: string format: base58|bech32 @@ -460,6 +465,20 @@ x-transactionOutputs: &transactionOutputs address: *addressId amount: *transactionAmount +x-transactionWithdrawals: &transactionWithdrawals + description: A list of withdrawals from stake addresses. + type: array + minItems: 0 + items: + type: object + additionalProperties: false + required: + - stake_address + - amount + properties: + stake_address: *stakeAddress + amount: *amount + x-transactionResolvedInputs: &transactionResolvedInputs description: A list of transaction inputs type: array @@ -902,6 +921,7 @@ components: - direction - inputs - outputs + - withdrawals - status properties: id: *transactionId @@ -912,6 +932,7 @@ components: direction: *transactionDirection inputs: *transactionInputs outputs: *transactionOutputs + withdrawals: *transactionWithdrawals status: *transactionStatus ApiWalletDelegationNext: &ApiWalletDelegationNext From a40b93e53556ca670ebdd28ab48b7b5f7b49fdf4 Mon Sep 17 00:00:00 2001 From: KtorZ Date: Fri, 10 Jul 2020 15:37:01 +0200 Subject: [PATCH 8/9] add roundtrip tests for stake address and show that withdrawals are returned from the API --- .../Scenario/API/Shelley/StakePools.hs | 24 ++++++++++------ .../Cardano/Wallet/Shelley/Compatibility.hs | 28 +++++++++++++------ .../Wallet/Shelley/CompatibilitySpec.hs | 17 ++++++++++- 3 files changed, 51 insertions(+), 18 deletions(-) diff --git a/lib/core-integration/src/Test/Integration/Scenario/API/Shelley/StakePools.hs b/lib/core-integration/src/Test/Integration/Scenario/API/Shelley/StakePools.hs index 74ad7838ce6..d009c0641c8 100644 --- a/lib/core-integration/src/Test/Integration/Scenario/API/Shelley/StakePools.hs +++ b/lib/core-integration/src/Test/Integration/Scenario/API/Shelley/StakePools.hs @@ -18,7 +18,6 @@ import Cardano.Wallet.Api.Types ( ApiStakePool , ApiT (..) , ApiTransaction - , ApiTxId (..) , ApiWallet , ApiWithdrawRewards (..) , DecodeAddress @@ -192,9 +191,8 @@ spec = do (Link.createTransaction @'Shelley w) Default (Json payload) expectResponseCode HTTP.status202 r1 - let txId1 = getFromResponse #id r1 eventually "Wallet has not consumed rewards" $ do - let linkSrc = Link.getTransaction @'Shelley w (ApiTxId txId1) + let linkSrc = Link.getTransaction @'Shelley w (getFromResponse Prelude.id r1) request @(ApiTransaction n) ctx linkSrc Default Empty >>= flip verify [ expectField (#status . #getApiT) (`shouldBe` InLedger) ] @@ -203,12 +201,13 @@ spec = do ] -- can use rewards with special transaction query param (ApiWithdrawRewards True) - request @(ApiTransaction n) ctx + rTx <- request @(ApiTransaction n) ctx (Link.createTransaction' @'Shelley w (ApiWithdrawRewards True)) - Default (Json payload) >>= flip verify - [ expectField #amount (.> (Quantity coin)) - , expectField (#direction . #getApiT) (`shouldBe` Outgoing) - ] + Default (Json payload) + verify rTx + [ expectField #amount (.> (Quantity coin)) + , expectField (#direction . #getApiT) (`shouldBe` Outgoing) + ] -- Rewards are have been consumed. eventually "Wallet has consumed rewards" $ do @@ -217,6 +216,15 @@ spec = do , expectField (#balance . #getApiT . #available) (.> previousBalance) ] + eventually "There's at least one transaction with a withdrawal" $ do + rWithdrawal <- request @(ApiTransaction n) ctx + (Link.getTransaction @'Shelley w (getFromResponse Prelude.id rTx)) + Default Empty + verify rWithdrawal + [ expectResponseCode HTTP.status200 + , expectField #withdrawals (`shouldSatisfy` (not . null)) + ] + -- Quit delegation altogether. quitStakePool @n ctx (w, fixturePassphrase) >>= flip verify [ expectResponseCode HTTP.status202 diff --git a/lib/shelley/src/Cardano/Wallet/Shelley/Compatibility.hs b/lib/shelley/src/Cardano/Wallet/Shelley/Compatibility.hs index 0c6f27435e0..da044bd3760 100644 --- a/lib/shelley/src/Cardano/Wallet/Shelley/Compatibility.hs +++ b/lib/shelley/src/Cardano/Wallet/Shelley/Compatibility.hs @@ -117,6 +117,8 @@ import Codec.Binary.Bech32 ( dataPartFromBytes, dataPartToBytes ) import Control.Applicative ( (<|>) ) +import Control.Arrow + ( left ) import Control.Monad ( when ) import Crypto.Hash.Utils @@ -128,7 +130,7 @@ import Data.Binary.Get import Data.Binary.Put ( putByteString, putWord8, runPut ) import Data.Bits - ( (.|.) ) + ( (.&.), (.|.) ) import Data.ByteArray.Encoding ( Base (Base16), convertFromBase ) import Data.ByteString @@ -845,6 +847,9 @@ instance DecodeStakeAddress ('Testnet pm) where stakeAddressPrefix :: Word8 stakeAddressPrefix = 0xE0 +networkIdMask :: Word8 +networkIdMask = 0x0F + toNetworkId :: SL.Network -> Word8 toNetworkId = \case SL.Testnet -> 0 @@ -859,7 +864,7 @@ _encodeStakeAddress network (W.ChimericAccount acct) = where hrp = [Bech32.humanReadablePart|stake_addr|] bytes = BL.toStrict $ runPut $ do - putWord8 (toNetworkId network .|. stakeAddressPrefix) + putWord8 $ (networkIdMask .&. toNetworkId network) .|. stakeAddressPrefix putByteString acct _decodeStakeAddress @@ -867,7 +872,9 @@ _decodeStakeAddress -> Text -> Either TextDecodingError W.ChimericAccount _decodeStakeAddress serverNetwork txt = do - rewardAcnt <- runGetOrFail' SL.getRewardAcnt (T.encodeUtf8 txt) + (_, dp) <- left (const errBech32) $ Bech32.decodeLenient txt + bytes <- maybe (Left errBech32) Right $ dataPartToBytes dp + rewardAcnt <- runGetOrFail' SL.getRewardAcnt bytes guardNetwork (SL.getRwdNetwork rewardAcnt) serverNetwork @@ -875,17 +882,20 @@ _decodeStakeAddress serverNetwork txt = do where runGetOrFail' decoder bytes = case runGetOrFail decoder (BL.fromStrict bytes) of - Left{} -> - Left msg + Left e -> + Left (TextDecodingError (show e)) Right (remaining,_,_) | not (BL.null remaining) -> - Left msg + Left errDecode Right (_,_,a) -> Right a - where - msg = TextDecodingError - "Unable to decode stake-address: not a well-formed address." + + errDecode = TextDecodingError + "Unable to decode stake-address: not a well-formed address." + + errBech32 = TextDecodingError + "Unable to decode stake-address: must be a valid bech32 string." instance EncodeAddress 'Mainnet where encodeAddress = _encodeAddress diff --git a/lib/shelley/test/unit/Cardano/Wallet/Shelley/CompatibilitySpec.hs b/lib/shelley/test/unit/Cardano/Wallet/Shelley/CompatibilitySpec.hs index 94ba10ba2b6..78339e85bbf 100644 --- a/lib/shelley/test/unit/Cardano/Wallet/Shelley/CompatibilitySpec.hs +++ b/lib/shelley/test/unit/Cardano/Wallet/Shelley/CompatibilitySpec.hs @@ -26,7 +26,7 @@ import Cardano.Mnemonic , entropyToMnemonic ) import Cardano.Wallet.Api.Types - ( DecodeAddress (..) ) + ( DecodeAddress (..), DecodeStakeAddress(..), EncodeStakeAddress(..) ) import Cardano.Wallet.Primitive.AddressDerivation ( Depth (..) , NetworkDiscriminant (..) @@ -41,6 +41,7 @@ import Cardano.Wallet.Primitive.AddressDerivation.Shelley import Cardano.Wallet.Primitive.Types ( Address (..) , DecentralizationLevel (..) + , ChimericAccount(..) , EpochLength (..) , Hash (..) , SlotId (..) @@ -122,6 +123,17 @@ spec = do let toPoint' = toPoint gh epochLength toPoint' (fromTip' tip) === (getTipPoint tip) + describe "Shelley StakeAddress" $ do + prop "roundtrip / Mainnet" $ \x -> + (decodeStakeAddress @'Mainnet . encodeStakeAddress @'Mainnet) x + === + Right x + + prop "roundtrip / Testnet" $ \x -> + (decodeStakeAddress @('Testnet 0) . encodeStakeAddress @('Testnet 0)) x + === + Right x + describe "Shelley Addresses" $ do prop "(Mainnet) can be deserialised by shelley ledger spec" $ \k -> do let Address addr = paymentAddress @'Mainnet @ShelleyKey k @@ -214,6 +226,9 @@ instance Arbitrary (Hash "Genesis") where instance Arbitrary (Hash "BlockHeader") where arbitrary = Hash . BS.pack <$> vector 32 +instance Arbitrary ChimericAccount where + arbitrary = ChimericAccount . BS.pack <$> vector 28 + instance Arbitrary (Tip ShelleyBlock) where arbitrary = frequency [ (10, return TipGenesis) From ab7bb2be03d963aab5b10da15236acbc876c66b9 Mon Sep 17 00:00:00 2001 From: IOHK Date: Fri, 10 Jul 2020 13:50:29 +0000 Subject: [PATCH 9/9] Regenerate nix --- nix/.stack.nix/cardano-wallet-shelley.nix | 1 + 1 file changed, 1 insertion(+) diff --git a/nix/.stack.nix/cardano-wallet-shelley.nix b/nix/.stack.nix/cardano-wallet-shelley.nix index ce4cbfcdf1f..52d65fa185b 100644 --- a/nix/.stack.nix/cardano-wallet-shelley.nix +++ b/nix/.stack.nix/cardano-wallet-shelley.nix @@ -32,6 +32,7 @@ (hsPkgs."base58-bytestring" or (errorHandler.buildDepError "base58-bytestring")) (hsPkgs."bech32" or (errorHandler.buildDepError "bech32")) (hsPkgs."bech32-th" or (errorHandler.buildDepError "bech32-th")) + (hsPkgs."binary" or (errorHandler.buildDepError "binary")) (hsPkgs."bytestring" or (errorHandler.buildDepError "bytestring")) (hsPkgs."cardano-addresses" or (errorHandler.buildDepError "cardano-addresses")) (hsPkgs."cardano-api" or (errorHandler.buildDepError "cardano-api"))