diff --git a/lib/customer-deposit-wallet/customer-deposit-wallet.cabal b/lib/customer-deposit-wallet/customer-deposit-wallet.cabal index dd76cdbac61..eeb1f2cd7b2 100644 --- a/lib/customer-deposit-wallet/customer-deposit-wallet.cabal +++ b/lib/customer-deposit-wallet/customer-deposit-wallet.cabal @@ -54,8 +54,8 @@ library build-depends: , async , base - , base58-bytestring , base16-bytestring + , base58-bytestring , bech32 , bech32-th , bytestring @@ -69,7 +69,7 @@ library , cardano-wallet , cardano-wallet-network-layer , cardano-wallet-primitive - , cardano-wallet-read ==0.2024.8.27 + , cardano-wallet-read , containers , contra-tracer , customer-deposit-wallet-pure @@ -77,8 +77,8 @@ library , delta-types , digest , fingertree - , io-classes , int-cast + , io-classes , lens , MonadRandom , monoidal-containers @@ -104,8 +104,8 @@ library Cardano.Wallet.Deposit.Pure.API.TxHistory Cardano.Wallet.Deposit.Pure.Balance Cardano.Wallet.Deposit.Pure.State.Creation - Cardano.Wallet.Deposit.Pure.State.Payment.Inspect Cardano.Wallet.Deposit.Pure.State.Payment + Cardano.Wallet.Deposit.Pure.State.Payment.Inspect Cardano.Wallet.Deposit.Pure.State.Rolling Cardano.Wallet.Deposit.Pure.State.Signing Cardano.Wallet.Deposit.Pure.State.Submissions @@ -214,26 +214,33 @@ test-suite unit , aeson , aeson-pretty , base + , base58-bytestring + , base16-bytestring , bech32 , bech32-th - , base58-bytestring , bytestring + , cardano-addresses + , address-derivation-discovery , cardano-crypto , cardano-crypto-class , cardano-ledger-api , cardano-ledger-core , cardano-ledger-core:testlib + , cardano-ledger-shelley + , cardano-slotting , cardano-wallet-read , cardano-wallet-test-utils , containers , contra-tracer , customer-deposit-wallet + , customer-deposit-wallet-pure , customer-deposit-wallet:http , customer-deposit-wallet:rest - , customer-deposit-wallet-pure + , data-default , directory , hspec , hspec-golden + , lens , openapi3 , pretty-simple , QuickCheck @@ -241,7 +248,6 @@ test-suite unit , temporary , text , time - , text , transformers , with-utf8 @@ -251,6 +257,7 @@ test-suite unit Cardano.Wallet.Deposit.HTTP.OpenAPISpec Cardano.Wallet.Deposit.Map.TimedSpec Cardano.Wallet.Deposit.Pure.API.AddressSpec + Cardano.Wallet.Deposit.Pure.API.TransactionSpec Cardano.Wallet.Deposit.PureSpec Cardano.Wallet.Deposit.RESTSpec Cardano.Wallet.Deposit.Write.KeysSpec diff --git a/lib/customer-deposit-wallet/http/Cardano/Wallet/Deposit/HTTP/Server.hs b/lib/customer-deposit-wallet/http/Cardano/Wallet/Deposit/HTTP/Server.hs index d789ef9fa94..fa936209323 100644 --- a/lib/customer-deposit-wallet/http/Cardano/Wallet/Deposit/HTTP/Server.hs +++ b/lib/customer-deposit-wallet/http/Cardano/Wallet/Deposit/HTTP/Server.hs @@ -23,7 +23,8 @@ import Cardano.Wallet.Deposit.IO ( WalletBootEnv ) import Cardano.Wallet.Deposit.Pure.State.Creation - ( credentialsFromEncodedXPub + ( createMnemonicFromWords + , credentialsFromEncodedXPub , credentialsFromMnemonics ) import Cardano.Wallet.Deposit.REST @@ -90,17 +91,20 @@ createWalletViaMnemonic dir boot resource - (PostWalletViaMnemonic mnemonics' passphrase' users') = - onlyOnWalletIntance resource initWallet $> NoContent - where - initWallet :: WalletResourceM () - initWallet = - REST.initWallet - tracer - boot - dir - (credentialsFromMnemonics mnemonics' passphrase') - (fromIntegral users') + (PostWalletViaMnemonic mnemonics' passphrase' users') = do + case createMnemonicFromWords mnemonics' of + Left e -> fail $ show e + Right someMnemonic -> do + let + initWallet :: WalletResourceM () + initWallet = + REST.initWallet + tracer + boot + dir + (credentialsFromMnemonics someMnemonic passphrase') + (fromIntegral users') + onlyOnWalletIntance resource initWallet $> NoContent createWalletViaXPub :: Tracer IO String diff --git a/lib/customer-deposit-wallet/rest/Cardano/Wallet/Deposit/REST.hs b/lib/customer-deposit-wallet/rest/Cardano/Wallet/Deposit/REST.hs index fbdbd2b39b9..5bc16a39b30 100644 --- a/lib/customer-deposit-wallet/rest/Cardano/Wallet/Deposit/REST.hs +++ b/lib/customer-deposit-wallet/rest/Cardano/Wallet/Deposit/REST.hs @@ -50,9 +50,14 @@ module Cardano.Wallet.Deposit.REST , walletPublicIdentity , deleteWallet , deleteTheDepositWalletOnDisk - -- * Internals - , onWalletInstance + -- * Internals + , inspectTx + , onWalletInstance + , networkTag + , resolveCurrentEraTx + , canSign + , submitTx ) where import Prelude @@ -81,9 +86,12 @@ import Cardano.Wallet.Deposit.IO.Resource , ErrResourceMissing (..) ) import Cardano.Wallet.Deposit.Pure - ( Credentials + ( CanSign + , Credentials + , CurrentEraResolvedTx , Customer , ErrCreatePayment + , InspectTx , Passphrase , Word31 , fromCredentialsAndGenesis @@ -152,6 +160,7 @@ import System.FilePath ) import qualified Cardano.Wallet.Deposit.IO as WalletIO +import qualified Cardano.Wallet.Deposit.IO.Network.Type as Network import qualified Cardano.Wallet.Deposit.IO.Resource as Resource import qualified Cardano.Wallet.Deposit.Read as Read import qualified Cardano.Wallet.Deposit.Write as Write @@ -287,7 +296,7 @@ instance Serialise XPrv where encode = encode . unXPrv decode = do b :: ByteString <- decode - case xprv b of + case xprv b of Right x -> pure x Left e -> fail e @@ -438,6 +447,9 @@ getTxHistoryByTime :: WalletResourceM ByTime getTxHistoryByTime = onWalletInstance WalletIO.getTxHistoryByTime +networkTag :: WalletResourceM Read.NetworkTag +networkTag = onWalletInstance WalletIO.networkTag + {----------------------------------------------------------------------------- Operations Writing to blockchain @@ -445,7 +457,7 @@ getTxHistoryByTime = onWalletInstance WalletIO.getTxHistoryByTime createPayment :: [(Address, Read.Value)] - -> WalletResourceM (Either ErrCreatePayment Write.Tx) + -> WalletResourceM (Either ErrCreatePayment CurrentEraResolvedTx) createPayment = onWalletInstance . WalletIO.createPayment getBIP32PathsForOwnedInputs @@ -454,8 +466,22 @@ getBIP32PathsForOwnedInputs getBIP32PathsForOwnedInputs = onWalletInstance . WalletIO.getBIP32PathsForOwnedInputs +canSign :: WalletResourceM CanSign +canSign = onWalletInstance WalletIO.canSign + signTx :: Write.Tx -> Passphrase -> WalletResourceM (Maybe Write.Tx) signTx tx = onWalletInstance . WalletIO.signTx tx + +inspectTx + :: CurrentEraResolvedTx + -> WalletResourceM InspectTx +inspectTx = onWalletInstance . WalletIO.inspectTx + +resolveCurrentEraTx :: Write.Tx -> WalletResourceM CurrentEraResolvedTx +resolveCurrentEraTx = onWalletInstance . WalletIO.resolveCurrentEraTx + +submitTx :: Write.Tx -> WalletResourceM (Either Network.ErrPostTx ()) +submitTx = onWalletInstance . WalletIO.submitTx diff --git a/lib/customer-deposit-wallet/src/Cardano/Wallet/Deposit/IO.hs b/lib/customer-deposit-wallet/src/Cardano/Wallet/Deposit/IO.hs index bd54f40f69c..4ae62d8b43b 100644 --- a/lib/customer-deposit-wallet/src/Cardano/Wallet/Deposit/IO.hs +++ b/lib/customer-deposit-wallet/src/Cardano/Wallet/Deposit/IO.hs @@ -36,6 +36,7 @@ module Cardano.Wallet.Deposit.IO -- *** Create transactions , createPayment + , inspectTx -- *** Sign transactions , getBIP32PathsForOwnedInputs @@ -45,8 +46,12 @@ module Cardano.Wallet.Deposit.IO , submitTx , listTxsInSubmission - -- * Internals - , onWalletState + -- * Internals + , onWalletState + , networkTag + , readWalletState + , resolveCurrentEraTx + , canSign ) where import Prelude @@ -59,6 +64,7 @@ import Cardano.Wallet.Deposit.IO.Network.Type ) import Cardano.Wallet.Deposit.Pure ( Credentials + , CurrentEraResolvedTx , Customer , ValueTransfer , WalletPublicIdentity (..) @@ -70,6 +76,9 @@ import Cardano.Wallet.Deposit.Pure.API.TxHistory , ByTime , LookupTimeFromSlot ) +import Cardano.Wallet.Deposit.Pure.State.Creation + ( CanSign + ) import Cardano.Wallet.Deposit.Read ( Address , TxId @@ -315,6 +324,10 @@ slotResolver w = do $ bootEnv $ env w +networkTag :: WalletInstance -> IO Read.NetworkTag +networkTag w = do + Wallet.networkTag <$> readWalletState w + {----------------------------------------------------------------------------- Operations Constructing transactions @@ -323,7 +336,7 @@ slotResolver w = do createPayment :: [(Address, Read.Value)] -> WalletInstance - -> IO (Either Wallet.ErrCreatePayment Write.Tx) + -> IO (Either Wallet.ErrCreatePayment CurrentEraResolvedTx) createPayment a w = do timeTranslation <- Network.getTimeTranslation network pparams <- @@ -332,11 +345,28 @@ createPayment a w = do where network = networkEnv $ bootEnv $ env w +inspectTx + :: CurrentEraResolvedTx + -> WalletInstance + -> IO Wallet.InspectTx +inspectTx tx w = flip Wallet.inspectTx tx <$> readWalletState w + +resolveCurrentEraTx + :: Write.Tx + -> WalletInstance + -> IO CurrentEraResolvedTx +resolveCurrentEraTx tx w = + Wallet.resolveCurrentEraTx tx <$> readWalletState w + {----------------------------------------------------------------------------- Operations Signing transactions ------------------------------------------------------------------------------} +canSign :: WalletInstance -> IO CanSign +canSign w = do + Wallet.canSign <$> readWalletState w + getBIP32PathsForOwnedInputs :: Write.Tx -> WalletInstance -> IO [BIP32Path] getBIP32PathsForOwnedInputs a w = diff --git a/lib/customer-deposit-wallet/src/Cardano/Wallet/Deposit/Pure.hs b/lib/customer-deposit-wallet/src/Cardano/Wallet/Deposit/Pure.hs index cd1bc1e2f03..6de8e6a07e3 100644 --- a/lib/customer-deposit-wallet/src/Cardano/Wallet/Deposit/Pure.hs +++ b/lib/customer-deposit-wallet/src/Cardano/Wallet/Deposit/Pure.hs @@ -43,17 +43,25 @@ module Cardano.Wallet.Deposit.Pure , getEraSlotOfBlock , getCustomerDeposits , getAllDeposits + , networkTag -- ** Writing to the blockchain , ErrCreatePayment (..) , createPayment + , resolveCurrentEraTx + , CurrentEraResolvedTx , BIP32Path (..) , DerivationType (..) + , ResolvedTx (..) + , canSign + , CanSign (..) , getBIP32PathsForOwnedInputs , Passphrase , signTx , addTxSubmission , listTxsInSubmission + , inspectTx + , InspectTx (..) ) where import Cardano.Wallet.Address.BIP32 @@ -61,13 +69,21 @@ import Cardano.Wallet.Address.BIP32 , DerivationType (..) ) import Cardano.Wallet.Deposit.Pure.State.Creation - ( Credentials (..) + ( CanSign (..) + , Credentials (..) , WalletPublicIdentity (..) + , canSign , fromCredentialsAndGenesis ) import Cardano.Wallet.Deposit.Pure.State.Payment - ( ErrCreatePayment (..) + ( CurrentEraResolvedTx + , ErrCreatePayment (..) , createPayment + , resolveCurrentEraTx + ) +import Cardano.Wallet.Deposit.Pure.State.Payment.Inspect + ( InspectTx (..) + , inspectTx ) import Cardano.Wallet.Deposit.Pure.State.Rolling ( rollBackward @@ -104,9 +120,13 @@ import Cardano.Wallet.Deposit.Pure.State.Type , knownCustomer , knownCustomerAddress , listCustomers + , networkTag , trackedCustomers , walletXPub ) +import Cardano.Wallet.Deposit.Pure.UTxO.Tx + ( ResolvedTx (..) + ) import Cardano.Wallet.Deposit.Pure.UTxO.ValueTransfer ( ValueTransfer (..) ) diff --git a/lib/customer-deposit-wallet/src/Cardano/Wallet/Deposit/Pure/State/Creation.hs b/lib/customer-deposit-wallet/src/Cardano/Wallet/Deposit/Pure/State/Creation.hs index 94a31cc07c8..5bafc4ce876 100644 --- a/lib/customer-deposit-wallet/src/Cardano/Wallet/Deposit/Pure/State/Creation.hs +++ b/lib/customer-deposit-wallet/src/Cardano/Wallet/Deposit/Pure/State/Creation.hs @@ -1,4 +1,6 @@ +{-# LANGUAGE DataKinds #-} {-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE TypeSynonymInstances #-} {-# OPTIONS_GHC -Wno-orphans #-} @@ -13,6 +15,9 @@ module Cardano.Wallet.Deposit.Pure.State.Creation , rootXPrvFromCredentials , ErrDecodingXPub (..) , encodedXPubFromCredentials + , canSign + , CanSign (..) + , createMnemonicFromWords ) where import Prelude hiding @@ -23,8 +28,13 @@ import Cardano.Address.Derivation ( xpubFromBytes , xpubToBytes ) -import Cardano.Crypto.Wallet - ( generate +import Cardano.Address.Style.Shelley + ( genMasterKeyFromMnemonicShelley + ) +import Cardano.Mnemonic + ( MkSomeMnemonic (..) + , MkSomeMnemonicError + , SomeMnemonic ) import Cardano.Wallet.Address.BIP32_Ed25519 ( XPrv @@ -46,12 +56,16 @@ import GHC.Generics ( Generic ) +import Cardano.Crypto.Wallet + ( xPrvChangePass + ) import qualified Cardano.Wallet.Deposit.Pure.Address as Address import qualified Cardano.Wallet.Deposit.Pure.Submissions as Sbm import qualified Cardano.Wallet.Deposit.Pure.UTxO.UTxOHistory as UTxOHistory import qualified Cardano.Wallet.Deposit.Read as Read import qualified Data.ByteString.Base16 as B16 import qualified Data.ByteString.Char8 as B8 +import qualified Data.Text as T import qualified Data.Text.Encoding as T data WalletPublicIdentity = WalletPublicIdentity @@ -83,12 +97,16 @@ accountXPubFromCredentials (XPrvCredentials _ xpub) = xpub -- | Derive account 'XPrv' from the root 'XPrv'. deriveAccountXPrv :: XPrv -> XPrv deriveAccountXPrv xprv = - (deriveXPrvHard - (deriveXPrvHard - (deriveXPrvHard xprv - 1857) -- Address derivation standard - 1815) -- ADA - 0) -- Account number + ( deriveXPrvHard + ( deriveXPrvHard + ( deriveXPrvHard + xprv + 1857 -- Address derivation standard + ) + 1815 -- ADA + ) + 0 -- Account number + ) -- | Get root 'XPrv' from credentials if available. rootXPrvFromCredentials :: Credentials -> Maybe XPrv @@ -114,9 +132,15 @@ fromCredentialsAndGenesis credentials knownCustomerCount genesisData = network = Read.getNetworkId genesisData initialUTxO = mempty +-- | Simplified version of 'mkSomeMnemonic' that takes a space-separated list of +-- words. Entropy and checksum are checked as well. +createMnemonicFromWords + :: Text -> Either (MkSomeMnemonicError '[15, 24]) SomeMnemonic +createMnemonicFromWords = mkSomeMnemonic . T.words + -- | Create 'Credentials' from a mnemonic sentence and a passphrase. credentialsFromMnemonics - :: Text + :: SomeMnemonic -- ^ Mnemonics -> Text -- ^ Passphrase @@ -124,17 +148,27 @@ credentialsFromMnemonics credentialsFromMnemonics mnemonics passphrase = let unencryptedXPrv = - generate - (T.encodeUtf8 mnemonics) + genMasterKeyFromMnemonicShelley + mnemonics (T.encodeUtf8 mempty) encryptedXPrv = - generate - (T.encodeUtf8 mnemonics) + xPrvChangePass + B8.empty (T.encodeUtf8 passphrase) + unencryptedXPrv in XPrvCredentials encryptedXPrv - (toXPub $ deriveAccountXPrv unencryptedXPrv) + $ toXPub + $ deriveAccountXPrv unencryptedXPrv + +data CanSign = CanSign | CannotSign + deriving (Eq, Show) + +canSign :: WalletState -> CanSign +canSign WalletState{rootXSignKey} = case rootXSignKey of + Nothing -> CannotSign + Just _ -> CanSign -- | Create 'Credentials' from an extended public key failures to decode data ErrDecodingXPub = ErrFromXPubBase16 | ErrFromXPubDecodeKey diff --git a/lib/customer-deposit-wallet/src/Cardano/Wallet/Deposit/Pure/State/Payment.hs b/lib/customer-deposit-wallet/src/Cardano/Wallet/Deposit/Pure/State/Payment.hs index 5d0c4d1cecf..df2013f37b3 100644 --- a/lib/customer-deposit-wallet/src/Cardano/Wallet/Deposit/Pure/State/Payment.hs +++ b/lib/customer-deposit-wallet/src/Cardano/Wallet/Deposit/Pure/State/Payment.hs @@ -1,11 +1,14 @@ {-# LANGUAGE DuplicateRecordFields #-} {-# LANGUAGE GADTs #-} +{-# LANGUAGE LambdaCase #-} {-# LANGUAGE ScopedTypeVariables #-} module Cardano.Wallet.Deposit.Pure.State.Payment ( ErrCreatePayment (..) , createPayment + , createPaymentTxBody , CurrentEraResolvedTx + , resolveCurrentEraTx ) where import Prelude hiding @@ -20,12 +23,14 @@ import Cardano.Wallet.Deposit.Pure.State.Type ) import Cardano.Wallet.Deposit.Pure.UTxO.Tx ( ResolvedTx (..) + , resolveInputs ) import Cardano.Wallet.Deposit.Read ( Address ) import Cardano.Wallet.Deposit.Write - ( TxBody (..) + ( Tx + , TxBody (..) ) import Control.Monad.Trans.Except ( runExceptT @@ -36,6 +41,9 @@ import Data.Bifunctor import Data.Digest.CRC32 ( crc32 ) +import Data.Text.Class.Extended + ( ToText (..) + ) import qualified Cardano.Wallet.Deposit.Pure.Address as Address import qualified Cardano.Wallet.Deposit.Read as Read @@ -43,36 +51,79 @@ import qualified Cardano.Wallet.Deposit.Write as Write import qualified Cardano.Wallet.Read.Hash as Hash import qualified Control.Monad.Random.Strict as Random import qualified Data.Map.Strict as Map +import qualified Data.Text as T data ErrCreatePayment = ErrCreatePaymentNotRecentEra (Read.EraValue Read.Era) | ErrCreatePaymentBalanceTx (Write.ErrBalanceTx Write.Conway) deriving (Eq, Show) +instance ToText ErrCreatePayment where + toText = \case + ErrCreatePaymentNotRecentEra era -> + "Cannot create a payment in the era: " <> T.pack (show era) + ErrCreatePaymentBalanceTx err -> + "Cannot create a payment: " <> T.pack (show err) + type CurrentEraResolvedTx = ResolvedTx Read.Conway --- | Create a payment to a list of destinations. +resolveCurrentEraTx :: Tx -> WalletState -> CurrentEraResolvedTx +resolveCurrentEraTx tx w = resolveInputs (availableUTxO w) tx + createPayment :: Read.EraValue Read.PParams -> Write.TimeTranslation -> [(Address, Write.Value)] -> WalletState - -> Either ErrCreatePayment Write.Tx -createPayment (Read.EraValue (Read.PParams pparams :: Read.PParams era)) a b w = - case Read.theEra :: Read.Era era of - Read.Conway -> - first ErrCreatePaymentBalanceTx - $ createPaymentConway pparams a b w - era' -> Left $ ErrCreatePaymentNotRecentEra (Read.EraValue era') + -> Either ErrCreatePayment CurrentEraResolvedTx +createPayment pp tt destinations w = + createPaymentTxBody pp tt (mkPaymentTxBody w destinations) w + +-- | Create a payment to a list of destinations. +createPaymentTxBody + :: Read.EraValue Read.PParams + -> Write.TimeTranslation + -> TxBody + -> WalletState + -> Either ErrCreatePayment CurrentEraResolvedTx +createPaymentTxBody + (Read.EraValue (Read.PParams pparams :: Read.PParams era)) + timeTranslation + txBody + state = + case Read.theEra :: Read.Era era of + Read.Conway -> + first ErrCreatePaymentBalanceTx + $ flip resolveCurrentEraTx state + <$> createPaymentConway + pparams + timeTranslation + txBody + state + era' -> Left $ ErrCreatePaymentNotRecentEra (Read.EraValue era') + +mkPaymentTxBody + :: WalletState -> [(Address, Write.Value)] -> Write.TxBody +mkPaymentTxBody w destinations = + Write.TxBody + { spendInputs = mempty + , collInputs = mempty + , txouts = + Map.fromList + $ zip [(toEnum 0) ..] + $ map (uncurry Write.mkTxOut) destinations + , collRet = Nothing + , expirySlot = Just . computeExpirySlot $ walletTip w + } -- | In the Conway era: Create a payment to a list of destinations. createPaymentConway :: Write.PParams Write.Conway -> Write.TimeTranslation - -> [(Address, Write.Value)] + -> TxBody -> WalletState -> Either (Write.ErrBalanceTx Write.Conway) Write.Tx -createPaymentConway pparams timeTranslation destinations w = +createPaymentConway pparams timeTranslation body w = fmap (Read.Tx . fst) . flip Random.evalRand (pilferRandomGen w) . runExceptT @@ -80,21 +131,8 @@ createPaymentConway pparams timeTranslation destinations w = (availableUTxO w) (addresses w) . mkPartialTx - $ paymentTxBody + $ body where - paymentTxBody :: Write.TxBody - paymentTxBody = - Write.TxBody - { spendInputs = mempty - , collInputs = mempty - , txouts = - Map.fromList - $ zip [(toEnum 0) ..] - $ map (uncurry Write.mkTxOut) destinations - , collRet = Nothing - , expirySlot = Just . computeExpirySlot $ walletTip w - } - mkPartialTx :: Write.TxBody -> Write.PartialTx Write.Conway mkPartialTx txbody = Write.PartialTx diff --git a/lib/customer-deposit-wallet/src/Cardano/Wallet/Deposit/Pure/State/Payment/Inspect.hs b/lib/customer-deposit-wallet/src/Cardano/Wallet/Deposit/Pure/State/Payment/Inspect.hs index d1eb72edf9c..9cb26bbdc46 100644 --- a/lib/customer-deposit-wallet/src/Cardano/Wallet/Deposit/Pure/State/Payment/Inspect.hs +++ b/lib/customer-deposit-wallet/src/Cardano/Wallet/Deposit/Pure/State/Payment/Inspect.hs @@ -7,8 +7,11 @@ module Cardano.Wallet.Deposit.Pure.State.Payment.Inspect ( inspectTx , CurrentEraResolvedTx , InspectTx (..) + , transactionBalance ) where +import Prelude + import Cardano.Read.Ledger.Tx.Fee ( Fee (..) , getEraFee @@ -39,7 +42,7 @@ import Cardano.Wallet.Deposit.Read , TxId ) import Cardano.Wallet.Read - ( Coin + ( Coin (..) , Conway , TxIx , Value (..) @@ -49,26 +52,53 @@ import Cardano.Wallet.Read , mkEraTxOut , pattern TxIn ) +import Control.Lens + ( Field2 (_2) + , Field3 (_3) + , to + , (^.) + ) import Data.Foldable ( Foldable (..) , fold ) -import Prelude +import Data.Monoid + ( Sum (..) + ) import qualified Data.Map.Strict as Map import qualified Data.Set as Set +-- | Inspect the inputs and outputs of a transaction. data InspectTx = InspectTx { ourInputs :: [(TxId, TxIx, Coin)] + -- ^ Our inputs. , otherInputs :: [(TxId, TxIx)] + -- ^ Other inputs, there shouldn't be any. , change :: [(Address, Coin)] + -- ^ Change outputs. , ourOutputs :: [(Address, Customer, Coin)] + -- ^ Our outputs. The customer is the owner of the address. There could be + -- reasons the user wants to move funds among customer addresses. , otherOutputs :: [(Address, Coin)] + -- ^ Other outputs. This is regular money leaving the wallet. , fee :: Coin } + deriving (Eq, Show) + +-- | Calculate the output balance of a transaction, which is the sum of the +-- values of our inputs minus the sum of the values of the change outputs and +-- minus the outputs to our customers. +transactionBalance :: InspectTx -> Integer +transactionBalance InspectTx{..} = getSum $ + (ourInputs ^. traverse . _3 . mkSum) + - (change ^. traverse . _2 . mkSum) + - (ourOutputs ^. traverse . _3 . mkSum) + where + mkSum = to (Sum . unCoin) -inspectTx - :: WalletState -> CurrentEraResolvedTx -> InspectTx +-- | Inspect a transaction where inputs have been resolved to our UTxO. +inspectTx :: WalletState -> CurrentEraResolvedTx -> InspectTx inspectTx ws (ResolvedTx tx ourUTxO) = let (ourInputs, otherInputs) = fold $ do diff --git a/lib/customer-deposit-wallet/src/Cardano/Wallet/Deposit/Pure/State/Signing.hs b/lib/customer-deposit-wallet/src/Cardano/Wallet/Deposit/Pure/State/Signing.hs index 18789eb82af..4d01c5ab989 100644 --- a/lib/customer-deposit-wallet/src/Cardano/Wallet/Deposit/Pure/State/Signing.hs +++ b/lib/customer-deposit-wallet/src/Cardano/Wallet/Deposit/Pure/State/Signing.hs @@ -61,7 +61,7 @@ signTx :: Write.Tx -> Passphrase -> WalletState -> Maybe Write.Tx signTx tx passphrase w = signTx' <$> rootXSignKey w where signTx' encryptedXPrv = - foldr Write.addAddressWitness tx keys + foldr Write.addSignature tx keys where unencryptedXPrv = xPrvChangePass diff --git a/lib/customer-deposit-wallet/src/Cardano/Wallet/Deposit/Pure/State/Type.hs b/lib/customer-deposit-wallet/src/Cardano/Wallet/Deposit/Pure/State/Type.hs index faf4ea179bb..dc3a094c5be 100644 --- a/lib/customer-deposit-wallet/src/Cardano/Wallet/Deposit/Pure/State/Type.hs +++ b/lib/customer-deposit-wallet/src/Cardano/Wallet/Deposit/Pure/State/Type.hs @@ -18,6 +18,7 @@ module Cardano.Wallet.Deposit.Pure.State.Type , walletXPub , getUTxO , getWalletTip + , networkTag ) where import Prelude hiding @@ -31,6 +32,9 @@ import Cardano.Crypto.Wallet import Cardano.Wallet.Deposit.Pure.API.TxHistory ( TxHistory (..) ) +import Cardano.Wallet.Deposit.Read + ( NetworkTag + ) import Cardano.Wallet.Deposit.Write ( Address ) @@ -118,3 +122,6 @@ getUTxO = UTxOHistory.getUTxO . utxoHistory getWalletTip :: WalletState -> Read.ChainPoint getWalletTip = walletTip + +networkTag :: WalletState -> NetworkTag +networkTag = Address.getNetworkTag . addresses diff --git a/lib/customer-deposit-wallet/src/Cardano/Wallet/Deposit/Testing/DSL.hs b/lib/customer-deposit-wallet/src/Cardano/Wallet/Deposit/Testing/DSL.hs index dee2578c84d..750dcbbfb71 100644 --- a/lib/customer-deposit-wallet/src/Cardano/Wallet/Deposit/Testing/DSL.hs +++ b/lib/customer-deposit-wallet/src/Cardano/Wallet/Deposit/Testing/DSL.hs @@ -23,6 +23,11 @@ module Cardano.Wallet.Deposit.Testing.DSL , assert , interpret , InterpreterState (..) + , spend + , sign + , utxo + , wallet + , balance ) where @@ -30,6 +35,7 @@ import Prelude import Cardano.Wallet.Deposit.Pure ( Customer + , ResolvedTx (..) , WalletState , getTxHistoryByTime ) @@ -38,10 +44,18 @@ import Cardano.Wallet.Deposit.Pure.API.TxHistory , ByTime , LookupTimeFromSlot ) +import Cardano.Wallet.Deposit.Pure.State.Creation + ( createMnemonicFromWords + , credentialsFromMnemonics + ) +import Cardano.Wallet.Deposit.Pure.State.Payment + ( createPaymentTxBody + ) import Cardano.Wallet.Deposit.Read ( Address , ChainPoint (..) , EraValue (..) + , UTxO , getChainPoint , mockNextBlock , slotFromChainPoint @@ -65,7 +79,9 @@ import Cardano.Wallet.Deposit.Write , mkAda , mkTx , mkTxOut + , txOutsL ) +import qualified Cardano.Wallet.Deposit.Write as Write import Cardano.Wallet.Read ( Coin (..) , Slot @@ -76,16 +92,17 @@ import Cardano.Wallet.Read ) import Control.Lens ( At (..) + , Field1 (_1) + , Field2 (_2) , Ixed (..) , Lens' - , _1 - , _2 , lens , use , uses , zoom , (%=) , (.=) + , (^?) ) import Control.Monad ( void @@ -115,18 +132,28 @@ import Data.List import Data.Map ( Map ) +import Data.Maybe + ( fromJust + ) +import Data.Text + ( Text + ) import Data.Time ( UTCTime ) import qualified Cardano.Wallet.Deposit.Pure as Wallet +import qualified Cardano.Wallet.Deposit.Time as Time +import qualified Cardano.Wallet.Read as Read import qualified Data.List.NonEmpty as NE import qualified Data.Map as Map import qualified Data.Set as Set data Scenario p a where + ResetWallet :: Int -> Text -> Text -> Scenario p () ExistsTx :: Scenario p TxI Deposit :: TxI -> Customer -> Int -> Scenario p UnspentI + Spend :: TxI -> Address -> Int -> Scenario p () Withdrawal :: TxI -> UnspentI -> Scenario p () CreateBlock :: [TxI] -> Scenario p (BlockI) RollForward :: [BlockI] -> Scenario p () @@ -135,10 +162,17 @@ data Scenario p a where HistoryByCustomer :: Scenario p ByCustomer NewHistoryByTime :: ByTimeM ByTime -> Scenario p ByTime AvailableBalance :: Scenario p Int + Sign :: Tx -> Text -> Scenario p Tx + Balance :: TxI -> Scenario p Tx + UTxO :: UnspentI -> Scenario p UTxO Assert :: p -> Scenario p () type ScenarioP p m = ProgramT (Scenario p) m +wallet :: Int -> Text -> Text -> ScenarioP p m () +wallet users seed passphrase = + singleton (ResetWallet users seed passphrase) + existsTx :: ScenarioP p m TxI existsTx = singleton ExistsTx @@ -148,6 +182,9 @@ deposit tx customer value = singleton (Deposit tx customer value) deposit_ :: Monad m => TxI -> Customer -> Int -> ScenarioP p m () deposit_ tx customer value = void $ deposit tx customer value +spend :: TxI -> Address -> Int -> ScenarioP p m () +spend tx addr value = singleton (Spend tx addr value) + withdrawal :: TxI -> UnspentI -> ScenarioP p m () withdrawal tx unspent = singleton (Withdrawal tx unspent) @@ -172,6 +209,15 @@ newHistoryByTime = singleton . NewHistoryByTime availableBalance :: ScenarioP p m Int availableBalance = singleton AvailableBalance +sign :: Tx -> Text -> ScenarioP p m Write.Tx +sign tx pass = singleton (Sign tx pass) + +balance :: TxI -> ScenarioP p m Tx +balance tx = singleton (Balance tx) + +utxo :: UnspentI -> ScenarioP p m UTxO +utxo = singleton . UTxO + assert :: p -> ScenarioP p m () assert = singleton . Assert @@ -260,32 +306,48 @@ newBlockId = zoom iBlockContentsL $ do put $ Map.insert blockId [] blocks return blockId +freshInterpreterState :: InterpreterState +freshInterpreterState = InterpreterState mempty mempty mempty mempty + +unsafeCustomerAddress + :: Wallet.WalletState -> Customer -> Write.Address +unsafeCustomerAddress w = fromJust . flip Wallet.customerAddress w + interpret :: (MonadIO m, MonadFail m) => WalletState -> (p -> m ()) - -> (Customer -> Address) -> (Slot -> WithOrigin UTCTime) -> ScenarioP p (StateT (WalletState, InterpreterState) m) () -> m () -interpret w runP customerAddresses slotTimes p = flip evalStateT w $ do +interpret w runP slotTimes p = flip evalStateT w $ do walletState <- get (walletState', _) <- lift $ execStateT (go p) - (walletState, InterpreterState mempty mempty mempty mempty) + (walletState, freshInterpreterState) put walletState' where go = viewT >=> eval + eval (ResetWallet users seed passphrase :>>= k) = do + Right mnemonics <- pure $ createMnemonicFromWords seed + let new = + Wallet.fromCredentialsAndGenesis + (credentialsFromMnemonics mnemonics passphrase) + (fromIntegral users) + Read.mockGenesisDataMainnet + id .= (new, freshInterpreterState) + go $ k () eval (Return x) = return x eval (ExistsTx :>>= k) = do txId <- zoom _2 newTxId go $ k txId eval (Deposit tx customer value :>>= k) = do + customerAddresses <- uses _1 unsafeCustomerAddress let v = mkAda $ fromIntegral value txOut = mkTxOut (customerAddresses customer) v Just txBody <- use (_2 . iTxsL . at tx) @@ -296,6 +358,12 @@ interpret w runP customerAddresses slotTimes p = flip evalStateT w $ do Just txId <- uses (_2 . iTxsL . at tx') $ fmap (getTxId . mkTx) _2 . iTxsL . ix tx %= \txBody -> addTxIn (TxIn txId tix) txBody go $ k () + eval (Spend tx address value :>>= k) = do + Just txBody <- use (_2 . iTxsL . at tx) + let (txBody', _tix) = + addTxOut (mkTxOut address (mkAda $ fromIntegral value)) txBody + _2 . iTxsL . ix tx .= txBody' + go $ k () eval (CreateBlock txs :>>= k) = do blockId <- zoom _2 newBlockId send <- @@ -317,6 +385,7 @@ interpret w runP customerAddresses slotTimes p = flip evalStateT w $ do v <- uses _1 Wallet.getTxHistoryByCustomer go $ k v eval (NewHistoryByTime m :>>= k) = do + customerAddresses <- uses _1 unsafeCustomerAddress txIds' <- uses (_2 . iTxsL) $ (Map.!) . fmap (getTxId . mkTx) blockSlots <- uses (_2 . iBlockPointsL) $ (Map.!) . fmap slotFromChainPoint @@ -327,6 +396,27 @@ interpret w runP customerAddresses slotTimes p = flip evalStateT w $ do eval (AvailableBalance :>>= k) = do ValueC (CoinC v) _ <- uses _1 Wallet.availableBalance go $ k $ fromIntegral v + eval (Sign tx pass :>>= k) = do + Just stx <- uses _1 $ Wallet.signTx tx pass + go $ k stx + eval (Balance tx :>>= k) = do + Just txBody <- use (_2 . iTxsL . at tx) + ws <- use _1 + let etx = + createPaymentTxBody + (Read.EraValue Read.mockPParamsConway) + (Time.toTimeTranslationPure Time.mockTimeInterpreter) + txBody + ws + ResolvedTx btx _ <- case etx of + Left e -> fail $ "createPaymentTxBody failed: " <> show e + Right tx' -> return tx' + go $ k btx + eval (UTxO (UnspentI (tx, tix)) :>>= k) = do + Just txBody <- use (_2 . iTxsL . at tx) + let txId = getTxId $ mkTx txBody + Just txOut <- pure $ txBody ^? txOutsL . ix tix + go $ k $ Map.singleton (TxIn txId tix) txOut eval (Assert assertion :>>= k) = do lift $ runP assertion go $ k () diff --git a/lib/customer-deposit-wallet/src/Cardano/Wallet/Deposit/Write.hs b/lib/customer-deposit-wallet/src/Cardano/Wallet/Deposit/Write.hs index 417fe060a15..acea171ce3b 100644 --- a/lib/customer-deposit-wallet/src/Cardano/Wallet/Deposit/Write.hs +++ b/lib/customer-deposit-wallet/src/Cardano/Wallet/Deposit/Write.hs @@ -34,7 +34,7 @@ module Cardano.Wallet.Deposit.Write , Write.balanceTx -- * Signing - , addAddressWitness + , addSignature -- ** Time interpreter , Write.TimeTranslation @@ -42,10 +42,13 @@ module Cardano.Wallet.Deposit.Write -- * Helper functions , mkAda , mkTxOut + , txOutsL , toConwayTx , addTxIn , addTxOut , emptyTxBody + , UTxO.resolvedTx + , UTxO.resolvedInputs ) where import Prelude @@ -99,6 +102,7 @@ import Data.Set import qualified Cardano.Ledger.Api as L import qualified Cardano.Ledger.Api.Tx.In as L import qualified Cardano.Ledger.Slot as L +import qualified Cardano.Wallet.Deposit.Pure.UTxO.Tx as UTxO import qualified Cardano.Wallet.Read as Read import qualified Cardano.Wallet.Read.Hash as Hash import qualified Cardano.Write.Eras as Write @@ -117,9 +121,8 @@ type Block = Read.Block Read.Conway Signing ------------------------------------------------------------------------------} -- | Add a signature to the transaction using the private key --- corresponding to a payment address. -addAddressWitness :: XPrv -> Tx -> Tx -addAddressWitness xprv tx@(Read.Tx ledgerTx) = +addSignature :: XPrv -> Tx -> Tx +addSignature xprv tx@(Read.Tx ledgerTx) = Read.Tx (ledgerTx & (L.witsTxL . L.addrTxWitsL) %~ Set.insert witnessVKey) where diff --git a/lib/customer-deposit-wallet/test/scenario/Test/Scenario/Wallet/Deposit/Exchanges.lhs.md b/lib/customer-deposit-wallet/test/scenario/Test/Scenario/Wallet/Deposit/Exchanges.lhs.md index d33a839404b..080684b7079 100644 --- a/lib/customer-deposit-wallet/test/scenario/Test/Scenario/Wallet/Deposit/Exchanges.lhs.md +++ b/lib/customer-deposit-wallet/test/scenario/Test/Scenario/Wallet/Deposit/Exchanges.lhs.md @@ -35,6 +35,7 @@ import Cardano.Wallet.Deposit.Pure ( Customer , ValueTransfer (..) , Credentials (..) + , ResolvedTx (..) ) import Cardano.Wallet.Deposit.Read ( Address @@ -206,7 +207,7 @@ scenarioCreatePayment xprv env destination w = do assert $ value1 == (coin <> coin) -- createPayment - Right txUnsigned <- Wallet.createPayment [(destination, coin)] w + Right (ResolvedTx txUnsigned _) <- Wallet.createPayment [(destination, coin)] w paths <- Wallet.getBIP32PathsForOwnedInputs txUnsigned w let tx = signTx xprv paths txUnsigned submitTx env tx diff --git a/lib/customer-deposit-wallet/test/unit/Cardano/Wallet/Deposit/Pure/API/TransactionSpec.hs b/lib/customer-deposit-wallet/test/unit/Cardano/Wallet/Deposit/Pure/API/TransactionSpec.hs new file mode 100644 index 00000000000..ecd6572b698 --- /dev/null +++ b/lib/customer-deposit-wallet/test/unit/Cardano/Wallet/Deposit/Pure/API/TransactionSpec.hs @@ -0,0 +1,241 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE NumericUnderscores #-} +{-# LANGUAGE OverloadedStrings #-} +{-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-} + +module Cardano.Wallet.Deposit.Pure.API.TransactionSpec + ( spec + ) +where + +import Prelude + +import Cardano.Ledger.Api + ( ppMaxTxSizeL + , ppMaxValSizeL + ) +import Cardano.Ledger.BaseTypes + ( EpochSize (..) + ) +import qualified Cardano.Ledger.BaseTypes as Ledger +import qualified Cardano.Ledger.Core as Ledger +import qualified Cardano.Ledger.Shelley.API.Mempool as Ledger +import qualified Cardano.Ledger.Shelley.LedgerState as Ledger +import qualified Cardano.Ledger.Shelley.Rules as Ledger +import qualified Cardano.Slotting.EpochInfo as Slotting +import Cardano.Slotting.Time + ( SlotLength + , SystemStart (..) + , mkSlotLength + ) +import Cardano.Wallet.Deposit.Pure.Address + ( createAddress + ) +import qualified Cardano.Wallet.Deposit.Pure.Address as Address +import Cardano.Wallet.Deposit.Pure.API.Address + ( encodeAddress + ) +import Cardano.Wallet.Deposit.Pure.State.Creation + ( accountXPubFromCredentials + , createMnemonicFromWords + , credentialsFromMnemonics + ) +import Cardano.Wallet.Deposit.PureSpec + ( testOnWallet + ) +import Cardano.Wallet.Deposit.Read + ( Address + , Conway + , NetworkTag (..) + , UTxO + , mkEnterpriseAddress + ) +import Cardano.Wallet.Deposit.Testing.DSL + ( assert + , balance + , block + , deposit + , existsTx + , rollForward + , sign + , spend + , utxo + , wallet + ) +import Cardano.Wallet.Deposit.Write + ( Tx + ) +import qualified Cardano.Wallet.Deposit.Write as Write +import Cardano.Wallet.Read + ( NetworkId (..) + ) +import qualified Cardano.Wallet.Read as Read +import Control.Lens + ( (&) + , (.~) + ) +import qualified Data.ByteString.Short as SBS +import Data.Default + ( Default (..) + ) +import Data.Maybe + ( fromMaybe + ) +import Data.Text + ( Text + ) +import qualified Data.Text.Lazy as TL +import Data.Time.Clock.POSIX + ( posixSecondsToUTCTime + ) +import Test.Cardano.Ledger.Core.Arbitrary + () +import Test.Hspec + ( Spec + , describe + , it + , shouldBe + ) +import Text.Pretty.Simple + ( pShow + ) + +address :: Address +address = mockAddress + +mockAddress :: Address +mockAddress = + mkEnterpriseAddress + MainnetTag + (SBS.toShort "12345678901234567890123456789012") + +defaultPParams :: Ledger.PParams Conway +defaultPParams = + def + & ppMaxTxSizeL .~ 16_384 + & ppMaxValSizeL .~ 1_000_000_000 + +-- | Create a new ledger env from given protocol parameters. +newLedgerEnv :: Ledger.PParams Conway -> Ledger.LedgerEnv Conway +newLedgerEnv protocolParams = + Ledger.LedgerEnv + { Ledger.ledgerSlotNo = 0 + , -- NOTE: This can probably stay at 0 forever. This is used internally by the + -- node's mempool to keep track of transaction seen from peers. Transactions + -- in Hydra do not go through the node's mempool and follow a different + -- consensus path so this will remain unused. + Ledger.ledgerIx = minBound + , -- NOTE: This keeps track of the ledger's treasury and reserve which are + -- both unused in Hydra. There might be room for interesting features in the + -- future with these two but for now, we'll consider them empty. + Ledger.ledgerAccount = Ledger.AccountState mempty mempty + , Ledger.ledgerPp = protocolParams + , Ledger.ledgerMempool = False + } + +defaultLedgerEnv :: Ledger.LedgerEnv Conway +defaultLedgerEnv = newLedgerEnv defaultPParams + +defaultGlobals :: Ledger.Globals +defaultGlobals = + Ledger.Globals + { Ledger.epochInfo = Slotting.fixedEpochInfo epochSize slotLength + , Ledger.slotsPerKESPeriod = 20 + , Ledger.stabilityWindow = 33 + , Ledger.randomnessStabilisationWindow = 33 + , Ledger.securityParameter = 10 + , Ledger.maxKESEvo = 10 + , Ledger.quorum = 5 + , Ledger.maxLovelaceSupply = 45 * 1000 * 1000 * 1000 * 1000 * 1000 + , Ledger.activeSlotCoeff = + Ledger.mkActiveSlotCoeff . unsafeBoundRational $ 0.9 + , Ledger.networkId = Ledger.Mainnet + , Ledger.systemStart = SystemStart $ posixSecondsToUTCTime 0 + } + where + unsafeBoundRational r = + fromMaybe (error $ "Could not convert from Rational: " <> show r) + $ Ledger.boundRational r + +epochSize :: EpochSize +epochSize = EpochSize 100 + +slotLength :: SlotLength +slotLength = mkSlotLength 1 + +applyTx + :: UTxO + -> Write.Tx + -> Either + (Ledger.ApplyTxError Conway) + () +applyTx utxos (Read.Tx tx) = + case Ledger.applyTx defaultGlobals defaultLedgerEnv memPoolState tx of + Left err -> Left err + Right _ -> Right () + where + memPoolState = + Ledger.LedgerState + { Ledger.lsUTxOState = + def{Ledger.utxosUtxo = Write.toConwayUTxO utxos} + , Ledger.lsCertState = def + } +newtype Ledger = Ledger + { validate :: Tx -> Either (Ledger.ApplyTxError Conway) () + } + +ledgerFrom :: UTxO -> Ledger +ledgerFrom = Ledger . applyTx + +accepts :: Ledger -> Tx -> IO () +accepts l t = case validate l t of + Left err -> + error + $ TL.unpack + $ "Transaction was not accepted by the ledger: \n" + <> pShow defaultPParams + <> "\n" + <> pShow t + <> "\n" + <> pShow err + Right _ -> pure () + +mnemonics :: Text +mnemonics = "vital minimum victory start lunch find city peanut shiver soft hedgehog artwork mushroom loud found" + +spec :: Spec +spec = do + describe "balanced transaction" $ do + it "has correct witness for one tx-in" + $ testOnWallet + $ do + wallet 17 mnemonics "passphrase" + tx1 <- existsTx + u1 <- deposit tx1 1 100 + b1 <- block [tx1] + rollForward [b1] + spending <- existsTx + spend spending address 10 + balanced <- balance spending + utxos <- utxo u1 + signedTx <- sign balanced "passphrase" + assert $ ledgerFrom utxos `accepts` signedTx + + -- cat root1.prv + -- | cardano-address key child 1857H/1815H/0H/0/0 \ + -- | cardano-address key public --with-chain-code \ + -- | cardano-address address payment --network-tag mainnet + describe "generated address match golden cases" $ do + it "with empty passphrase in mainnet" $ do + let + Right seed = createMnemonicFromWords mnemonics + address0 = "addr1v8th5554xvd2us9hwh72p3yt9rg7uw9v7tk49t3yw3wrcgc3drxft" + creds = credentialsFromMnemonics seed mempty + xpub = accountXPubFromCredentials creds + addr = + encodeAddress + $ fst + $ createAddress 0 + $ Address.fromXPubAndCount Mainnet xpub 1 + + addr `shouldBe` address0 diff --git a/lib/customer-deposit-wallet/test/unit/Cardano/Wallet/Deposit/PureSpec.hs b/lib/customer-deposit-wallet/test/unit/Cardano/Wallet/Deposit/PureSpec.hs index a2436a0fffe..efb3844c038 100644 --- a/lib/customer-deposit-wallet/test/unit/Cardano/Wallet/Deposit/PureSpec.hs +++ b/lib/customer-deposit-wallet/test/unit/Cardano/Wallet/Deposit/PureSpec.hs @@ -9,19 +9,23 @@ -- Property tests for the deposit wallet. module Cardano.Wallet.Deposit.PureSpec ( spec + , testOnWallet ) where import Prelude +import Cardano.Mnemonic + ( SomeMnemonic + ) import Cardano.Wallet.Deposit.Pure ( Credentials - , Customer ) import Cardano.Wallet.Deposit.Pure.API.TxHistory ( LookupTimeFromSlot ) import Cardano.Wallet.Deposit.Pure.State.Creation - ( credentialsFromMnemonics + ( createMnemonicFromWords + , credentialsFromMnemonics ) import Cardano.Wallet.Deposit.Testing.DSL ( InterpreterState (..) @@ -87,10 +91,6 @@ timeFromSlot = unsafeUTCTimeOfSlot unsafeTimeForSlot :: Read.Slot -> Read.WithOrigin UTCTime unsafeTimeForSlot = fromJust . timeFromSlot -unsafeCustomerAddress - :: Wallet.WalletState -> Customer -> Write.Address -unsafeCustomerAddress w = fromJust . flip Wallet.customerAddress w - testOnWallet :: ScenarioP (IO ()) @@ -101,7 +101,6 @@ testOnWallet = interpret emptyWalletWith17Addresses id - (unsafeCustomerAddress emptyWalletWith17Addresses) unsafeTimeForSlot spec :: Spec @@ -300,9 +299,16 @@ emptyWalletWith17Addresses :: Wallet.WalletState emptyWalletWith17Addresses = Wallet.fromCredentialsAndGenesis testCredentials 17 testGenesis +seed :: SomeMnemonic +seed = case createMnemonicFromWords + "vital minimum victory start lunch find city peanut shiver soft hedgehog artwork mushroom loud found" + of + Right seed' -> seed' + Left e -> error $ show e + testCredentials :: Credentials testCredentials = - credentialsFromMnemonics "random seed for a testing xpub lala" mempty + credentialsFromMnemonics seed mempty {----------------------------------------------------------------------------- Test blockchain diff --git a/lib/customer-deposit-wallet/test/unit/Cardano/Wallet/Deposit/RESTSpec.hs b/lib/customer-deposit-wallet/test/unit/Cardano/Wallet/Deposit/RESTSpec.hs index dbc52505856..c8f7ee64273 100644 --- a/lib/customer-deposit-wallet/test/unit/Cardano/Wallet/Deposit/RESTSpec.hs +++ b/lib/customer-deposit-wallet/test/unit/Cardano/Wallet/Deposit/RESTSpec.hs @@ -1,3 +1,5 @@ +{-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-} + module Cardano.Wallet.Deposit.RESTSpec ( spec ) @@ -10,6 +12,9 @@ import Cardano.Crypto.Wallet , verify , xPrvChangePass ) +import Cardano.Mnemonic + ( SomeMnemonic + ) import Cardano.Wallet.Deposit.IO ( WalletBootEnv (WalletBootEnv) ) @@ -20,6 +25,7 @@ import Cardano.Wallet.Deposit.IO.Resource import Cardano.Wallet.Deposit.Pure.State.Creation ( Credentials , accountXPubFromCredentials + , createMnemonicFromWords , credentialsFromMnemonics , deriveAccountXPrv , rootXPrvFromCredentials @@ -46,6 +52,10 @@ import Control.Concurrent import Control.Monad.IO.Class ( MonadIO (..) ) +import Control.Monad.Trans.Cont + ( cont + , evalCont + ) import Control.Tracer ( nullTracer ) @@ -67,18 +77,12 @@ import Test.Hspec , it , shouldBe ) - -import Control.Monad.Trans.Cont - ( cont - , evalCont - ) import Test.QuickCheck ( Gen , arbitrary + , elements , forAll , listOf - , suchThat - , vectorOf , (===) ) @@ -90,11 +94,13 @@ import qualified Data.Text.Encoding as T fakeBootEnv :: WalletBootEnv IO fakeBootEnv = WalletBootEnv nullTracer Read.mockGenesisDataMainnet undefined -mnemonics :: Text -mnemonics = "random seed for a testing xpub lala" +seed :: SomeMnemonic +Right seed = + createMnemonicFromWords + "vital minimum victory start lunch find city peanut shiver soft hedgehog artwork mushroom loud found" credentials :: Credentials -credentials = credentialsFromMnemonics mnemonics mempty +credentials = credentialsFromMnemonics seed mempty letItInitialize :: WalletResourceM () letItInitialize = liftIO $ threadDelay 100000 @@ -139,16 +145,21 @@ byteStringGen = B8.pack <$> listOf arbitrary textGen :: Gen Text textGen = T.pack <$> listOf arbitrary -textNGen :: Int -> Gen Text -textNGen n = do - n' <- arbitrary `suchThat` (>= n) - T.pack <$> vectorOf n' arbitrary +words15 :: [Text] +words15 = + [ "soap retire song hat major steak stuff daughter half scorpion please brisk decade hill song" + , "sure cannon broom caution artist legend boring reveal scene rubber weapon chest page clog fine" + , "fruit garden saddle upper huge educate fabric ocean bamboo verb iron apple have deposit trap" + ] credentialsGen :: Gen (Credentials, Text) credentialsGen = do - mnemonics' <- textNGen 32 - passphrase' <- textGen - pure (credentialsFromMnemonics mnemonics' passphrase', passphrase') + mnemonics' <- elements words15 + case createMnemonicFromWords mnemonics' of + Left e -> error $ "Invalid mnemonics: " <> show e + Right seed' -> do + passphrase' <- textGen + pure (credentialsFromMnemonics seed' passphrase', passphrase') spec :: Spec spec = do @@ -175,9 +186,9 @@ spec = do xPrvChangePass (T.encodeUtf8 passphrase') B8.empty xprv = deriveAccountXPrv - $ decryptXPrv - $ fromJust - $ rootXPrvFromCredentials credentials' + $ decryptXPrv + $ fromJust + $ rootXPrvFromCredentials credentials' sig = sign B8.empty xprv message pure $ verify (accountXPubFromCredentials credentials') message sig diff --git a/lib/customer-deposit-wallet/test/unit/Cardano/Wallet/Deposit/Write/KeysSpec.hs b/lib/customer-deposit-wallet/test/unit/Cardano/Wallet/Deposit/Write/KeysSpec.hs index 5b822c9af71..872cbe6c9ed 100644 --- a/lib/customer-deposit-wallet/test/unit/Cardano/Wallet/Deposit/Write/KeysSpec.hs +++ b/lib/customer-deposit-wallet/test/unit/Cardano/Wallet/Deposit/Write/KeysSpec.hs @@ -1,4 +1,5 @@ {-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE PackageImports #-} {-# LANGUAGE ScopedTypeVariables #-} {-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-} {-# OPTIONS_GHC -Wno-orphans #-} @@ -23,7 +24,7 @@ import Cardano.Wallet.Address.BIP32_Ed25519 , sign , toXPub ) -import Cardano.Wallet.Address.Encoding +import "customer-deposit-wallet-pure" Cardano.Wallet.Address.Encoding ( EnterpriseAddr (..) , NetworkTag (..) , compactAddrFromEnterpriseAddr @@ -101,10 +102,7 @@ instance Arbitrary NetworkTag where arbitrary = elements [MainnetTag, TestnetTag] instance Arbitrary XPrv where - arbitrary = - generate - <$> (BS.pack <$> vectorOf 100 arbitrary) - <*> pure BS.empty + arbitrary = generate . BS.pack <$> vectorOf 100 arbitrary <*> pure BS.empty instance Arbitrary XPub where arbitrary = toXPub <$> arbitrary diff --git a/lib/ui/src/Cardano/Wallet/UI/Deposit/Handlers/Wallet.hs b/lib/ui/src/Cardano/Wallet/UI/Deposit/Handlers/Wallet.hs index 7f0688ac590..069db286ca8 100644 --- a/lib/ui/src/Cardano/Wallet/UI/Deposit/Handlers/Wallet.hs +++ b/lib/ui/src/Cardano/Wallet/UI/Deposit/Handlers/Wallet.hs @@ -10,7 +10,8 @@ import Cardano.Wallet.Deposit.Pure , Customer ) import Cardano.Wallet.Deposit.Pure.State.Creation - ( credentialsFromEncodedXPub + ( createMnemonicFromWords + , credentialsFromEncodedXPub , credentialsFromMnemonics ) import Cardano.Wallet.Deposit.REST @@ -72,10 +73,13 @@ postMnemonicWallet alert render (PostWalletViaMnemonic mnemonic passphrase customers) = do - let credentials = credentialsFromMnemonics mnemonic passphrase - initWalletWithXPub l alert render - $ initWallet credentials - $ fromIntegral customers + case createMnemonicFromWords mnemonic of + Left e -> pure $ alert $ BL.pack $ show e + Right mnemonic' -> do + let credentials = credentialsFromMnemonics mnemonic' passphrase + initWalletWithXPub l alert render + $ initWallet credentials + $ fromIntegral customers postXPubWallet :: SessionLayer WalletResource