From cb3821b5daf0e240f9de2e967d82ee7f5c841879 Mon Sep 17 00:00:00 2001 From: Johannes Lund Date: Tue, 9 Apr 2019 16:23:21 +0200 Subject: [PATCH 1/3] Add Signing module with `mkStdTx` Not tested yet. For the time being we hard-code the testnet protocol magic in the signing. --- cardano-wallet.cabal | 4 +- src/Cardano/Wallet.hs | 24 +-- src/Cardano/Wallet/CoinSelection.hs | 41 +++++ .../Wallet/Primitive/AddressDerivation.hs | 3 +- .../Wallet/Primitive/AddressDiscovery.hs | 62 +++++++- src/Cardano/Wallet/Primitive/Signing.hs | 142 ++++++++++++++++++ 6 files changed, 257 insertions(+), 19 deletions(-) create mode 100644 src/Cardano/Wallet/Primitive/Signing.hs diff --git a/cardano-wallet.cabal b/cardano-wallet.cabal index f4623381913..77ca70fc17f 100644 --- a/cardano-wallet.cabal +++ b/cardano-wallet.cabal @@ -53,12 +53,13 @@ library , http-types , memory , servant - , servant-server , servant-client , servant-client-core + , servant-server , text , time , transformers + , vector hs-source-dirs: src exposed-modules: @@ -81,6 +82,7 @@ library Cardano.Wallet.Primitive.AddressDiscovery Cardano.Wallet.Primitive.Mnemonic Cardano.Wallet.Primitive.Model + Cardano.Wallet.Primitive.Signing Cardano.Wallet.Primitive.Types Data.Quantity Data.Text.Class diff --git a/src/Cardano/Wallet.hs b/src/Cardano/Wallet.hs index fbc55578355..c83b74bb371 100644 --- a/src/Cardano/Wallet.hs +++ b/src/Cardano/Wallet.hs @@ -37,7 +37,11 @@ import Prelude import Cardano.Wallet.Binary ( encodeSignedTx, toByteString ) import Cardano.Wallet.CoinSelection - ( CoinSelection (..), CoinSelectionError (..), CoinSelectionOptions ) + ( CoinSelection (..) + , CoinSelectionError (..) + , CoinSelectionOptions + , shuffle + ) import Cardano.Wallet.DB ( DBLayer , ErrNoSuchWallet (..) @@ -61,6 +65,8 @@ import Cardano.Wallet.Primitive.AddressDiscovery ( AddressPoolGap, SeqState (..), mkAddressPool ) import Cardano.Wallet.Primitive.Model ( Wallet, applyBlocks, availableUTxO, currentTip, getState, initWallet ) +import Cardano.Wallet.Primitive.Signing + ( SignTxError, mkStdTx ) import Cardano.Wallet.Primitive.Types ( Block (..) , BlockHeader (..) @@ -180,7 +186,7 @@ data ErrCreateUnsignedTx -- | Errors occuring when signing a transaction data ErrSignTx = ErrSignTxNoSuchWallet ErrNoSuchWallet - | ErrSignTx + | ErrSignTx SignTxError -- | Errors occuring when submitting a signed transaction to the network data ErrSubmitTx = forall a. NetworkError a @@ -251,12 +257,14 @@ mkWalletLayer db network = WalletLayer let signed = SignedTx $ toByteString $ encodeSignedTx (tx, witnesses) withExceptT NetworkError $ postTx network signed - , signTx = \wid rootXPrv password (CoinSelection ins outs chgs) -> do + , signTx = \wid rootXPrv password (CoinSelection ins outs _chgs) -> do + -- TODO: This is untested (w, _) <- withExceptT ErrSignTxNoSuchWallet $ _readWallet wid - maybe - (throwE ErrSignTx) - return - (mkStdTx (getState w) rootXPrv password ins outs chgs) + + shuffledOuts <- liftIO $ shuffle outs + case mkStdTx (getState w) (rootXPrv, password) ins shuffledOuts of + Right a -> return a + Left e -> throwE $ ErrSignTx e } where _readWallet @@ -337,8 +345,6 @@ mkWalletLayer db network = WalletLayer DB.putTxHistory db (PrimaryKey wid) txs DB.putWalletMeta db (PrimaryKey wid) meta' - mkStdTx = error "TODO: mkStdTx not implemented yet" - {------------------------------------------------------------------------------- Helpers -------------------------------------------------------------------------------} diff --git a/src/Cardano/Wallet/CoinSelection.hs b/src/Cardano/Wallet/CoinSelection.hs index 21208e8a78b..ba6dbe1c08d 100644 --- a/src/Cardano/Wallet/CoinSelection.hs +++ b/src/Cardano/Wallet/CoinSelection.hs @@ -18,12 +18,21 @@ module Cardano.Wallet.CoinSelection CoinSelectionOptions (..) , CoinSelectionError(..) , CoinSelection(..) + + -- * Helpers + , shuffle ) where import Prelude import Cardano.Wallet.Primitive.Types ( Coin (..), TxIn, TxOut (..) ) +import Control.Monad + ( forM_ ) +import Crypto.Number.Generate + ( generateBetween ) +import Data.Vector.Mutable + ( IOVector ) import Data.Word ( Word64 ) import Fmt @@ -31,6 +40,9 @@ import Fmt import GHC.Generics ( Generic ) +import qualified Data.Vector as V +import qualified Data.Vector.Mutable as MV + {------------------------------------------------------------------------------- Coin Selection -------------------------------------------------------------------------------} @@ -84,3 +96,32 @@ instance Buildable CoinSelection where <> nameF "change" (listF chngs) where inpsF (txin, txout) = build txin <> " (~ " <> build txout <> ")" + +{------------------------------------------------------------------------------- + Helpers +-------------------------------------------------------------------------------} + +-- | Shuffles a list of elements. +-- +-- >>> shuffle (outputs coinSel) +-- [...] +-- +shuffle :: [a] -> IO [a] +shuffle = modifyInPlace $ \v -> do + let (lo, hi) = (0, MV.length v - 1) + forM_ [lo .. hi] $ \i -> do + j <- fromInteger <$> generateBetween (fromIntegral lo) (fromIntegral hi) + swapElems v i j + where + swapElems :: IOVector a -> Int -> Int -> IO () + swapElems v i j = do + x <- MV.read v i + y <- MV.read v j + MV.write v i y + MV.write v j x + + modifyInPlace :: forall a. (IOVector a -> IO ()) -> [a] -> IO [a] + modifyInPlace f xs = do + v' <- V.thaw $ V.fromList xs + f v' + V.toList <$> V.freeze v' diff --git a/src/Cardano/Wallet/Primitive/AddressDerivation.hs b/src/Cardano/Wallet/Primitive/AddressDerivation.hs index f13dc2facaf..9c9d7621933 100644 --- a/src/Cardano/Wallet/Primitive/AddressDerivation.hs +++ b/src/Cardano/Wallet/Primitive/AddressDerivation.hs @@ -25,6 +25,7 @@ module Cardano.Wallet.Primitive.AddressDerivation -- * Polymorphic / General Purpose Types -- $use Key + , getKey , Depth (..) , Index , getIndex @@ -132,7 +133,7 @@ import qualified Data.Text.Encoding as T -- let accountPubKey = Key 'AccountK XPub -- let addressPubKey = Key 'AddressK XPub -- @ -newtype Key (level :: Depth) key = Key key +newtype Key (level :: Depth) key = Key { getKey :: key } deriving stock (Generic, Show, Eq) instance (NFData key) => NFData (Key level key) diff --git a/src/Cardano/Wallet/Primitive/AddressDiscovery.hs b/src/Cardano/Wallet/Primitive/AddressDiscovery.hs index 94fe72683d0..058c62c1de1 100644 --- a/src/Cardano/Wallet/Primitive/AddressDiscovery.hs +++ b/src/Cardano/Wallet/Primitive/AddressDiscovery.hs @@ -2,6 +2,7 @@ {-# LANGUAGE DataKinds #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE DerivingStrategies #-} +{-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE TypeApplications #-} @@ -15,10 +16,11 @@ -- compatibility with random address scheme from the legacy Cardano wallets. module Cardano.Wallet.Primitive.AddressDiscovery - ( -- * Sequential Derivation + ( AddressScheme (..) + -- * Sequential Derivation -- ** Address Pool Gap - AddressPoolGap + , AddressPoolGap , MkAddressPoolGapError (..) , defaultAddressPoolGap , getAddressPoolGap @@ -40,13 +42,16 @@ module Cardano.Wallet.Primitive.AddressDiscovery import Prelude import Cardano.Crypto.Wallet - ( XPub ) + ( XPrv, XPub ) import Cardano.Wallet.Primitive.AddressDerivation ( ChangeChain (..) , Depth (..) , DerivationType (..) , Index , Key + , Passphrase + , deriveAccountPrivateKey + , deriveAddressPrivateKey , deriveAddressPublicKey , keyToAddress ) @@ -265,10 +270,51 @@ instance NFData SeqState -- that they are just created in sequence by the wallet software. Hence an -- address pool with a gap of 1 should be sufficient for the internal chain. instance IsOurs SeqState where - isOurs addr (SeqState !s1 !s2) = + isOurs addr (SeqState !s1 !s2) = + let + (res1, !s1') = lookupAddress addr s1 + (res2, !s2') = lookupAddress addr s2 + ours = isJust (res1 <|> res2) + in + (ours `deepseq` ours, SeqState s1' s2') + +-- TODO: We might want to move this abstraction / there is more work to be +-- done here. +-- +-- It would maybe be nice to derive IsOurs from AddressScheme automatically +-- A /possible/ way to do that would be to return +-- Maybe ((Key 'RootK XPrv, Passphrase "encryption") -> Key 'AddressK XPrv) +-- instead, such that we can use @isJust@ without knowing the rootKey and pwd. +class AddressScheme s where + keyFrom + :: Address + -> (Key 'RootK XPrv, Passphrase "encryption") + -> s + -> (Maybe (Key 'AddressK XPrv), s) + +instance AddressScheme SeqState where + keyFrom addr (rootPrv, pwd) (SeqState !s1 !s2) = let - (res1, !s1') = lookupAddress addr s1 - (res2, !s2') = lookupAddress addr s2 - ours = isJust (res1 <|> res2) + (xPrv1, !s1') = lookupAndDeriveXPrv s1 InternalChain + (xPrv2, !s2') = lookupAndDeriveXPrv s2 ExternalChain + + xPrv = (xPrv1 <|> xPrv2) + in - (ours `deepseq` ours, SeqState s1' s2') + (xPrv `deepseq` xPrv, SeqState s1' s2') + + where + -- We are assuming there is only one account + account = minBound + accountPrv = deriveAccountPrivateKey pwd rootPrv account + + lookupAndDeriveXPrv + :: AddressPool + -> ChangeChain + -> (Maybe (Key 'AddressK XPrv), AddressPool) + lookupAndDeriveXPrv pool chain = + let + (addrIx, pool') = lookupAddress addr pool + in + (deriveAddressPrivateKey pwd accountPrv chain <$> addrIx, pool') + diff --git a/src/Cardano/Wallet/Primitive/Signing.hs b/src/Cardano/Wallet/Primitive/Signing.hs new file mode 100644 index 00000000000..10cc494ee32 --- /dev/null +++ b/src/Cardano/Wallet/Primitive/Signing.hs @@ -0,0 +1,142 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE TypeApplications #-} + +-- | +-- Copyright: © 2018-2019 IOHK +-- License: MIT +-- +-- This module provides functionality for signing transactions. +-- +-- It relies on the binary CBOR format of transactions, an AddressScheme +-- for deriving address private keys, and cardano-crypto for the actual signing. +module Cardano.Wallet.Primitive.Signing + ( -- * Sign transactions + mkStdTx + , SignTxError (..) + ) + where + + +import Prelude + +import Cardano.Wallet.Binary + ( TxWitness (..), encodeTx, toByteString ) +import Cardano.Wallet.Primitive.AddressDerivation + ( Depth (AddressK, RootK) + , Key + , Passphrase (..) + , XPrv + , XPub + , getKey + , publicKey + ) +import Cardano.Wallet.Primitive.AddressDiscovery + ( AddressScheme (keyFrom) ) +import Cardano.Wallet.Primitive.Types + ( Address, Hash (..), Tx (..), TxIn, TxOut (..) ) +import Control.Monad + ( forM ) +import Crypto.Hash + ( Blake2b_256, hash ) +import Data.ByteArray + ( convert ) +import Data.ByteString + ( ByteString ) + +import qualified Cardano.Crypto.Wallet as CC +import qualified Codec.CBOR.Encoding as CBOR + + +newtype SignTxError = KeyNotFoundForAddress Address + +-- | Construct a standard transaction +-- +-- " Standard " here refers to the fact that we do not deal with redemption, +-- multisignature transactions, etc. +-- +mkStdTx + :: AddressScheme s + => s + -> (Key 'RootK XPrv, Passphrase "encryption") + -> [(TxIn, TxOut)] + -- ^ Selected inputs + -> [TxOut] + -- ^ Selected outputs (including change) + -> Either SignTxError (Tx, [TxWitness]) +mkStdTx s (rootPrv, pwd) ownedIns outs = do + let ins = (fmap fst ownedIns) + tx = Tx ins outs + txSigData = hashTx tx + + txWitnesses <- forM ownedIns (\(_in, TxOut addr _c) -> + mkWitness txSigData <$> keyFrom' addr) + + return (tx, txWitnesses) + + where + keyFrom' addr = + -- We are ignoring the new state/pool. We won't discover any new + -- addresses when submitting transactions. + case (fst $ keyFrom addr (rootPrv, pwd) s) of + Just key -> Right key + Nothing -> Left $ KeyNotFoundForAddress addr + + hashTx :: Tx -> Hash "tx" + hashTx txSigData = Hash + $ convert + $ (hash @ByteString @Blake2b_256) + $ toByteString + $ encodeTx txSigData + + + mkWitness :: Hash "tx" -> Key 'AddressK XPrv -> TxWitness + mkWitness tx xPrv = + PublicKeyWitness $ + encodeXPub (publicKey xPrv) <> + getHash (sign (SignTx tx) (xPrv, pwd)) + + + + +-- | Used for signing transactions +sign + :: SignTag + -> (Key 'AddressK XPrv, Passphrase "encryption") + -> Hash "signature" +sign tag (key, (Passphrase pwd)) = + Hash . CC.unXSignature $ CC.sign pwd (getKey key) (signTag tag) + + +-- | To protect agains replay attacks (i.e. when an attacker intercepts a +-- signed piece of data and later sends it again), we add a tag to all data +-- that we sign. This ensures that even if some bytestring can be +-- deserialized into two different types of messages (A and B), the attacker +-- can't take message A and send it as message B. +-- +-- We also automatically add the network tag ('protocolMagic') whenever it +-- makes sense, to ensure that things intended for testnet won't work for +-- mainnet. +-- +-- The wallet only cares about the 'SignTx' tag. In 'cardano-sl' there was +-- a lot more cases. +newtype SignTag + = SignTx (Hash "tx") + deriving (Eq, Ord, Show) + + +-- | Encode magic bytes & the contents of a @SignTag@. Magic bytes are +-- guaranteed to be different (and begin with a different byte) for different +-- tags. +signTag :: SignTag -> ByteString +signTag = \case + SignTx (Hash payload) -> "\x01" <> network <> payload + where + network = toByteString . CBOR.encodeInt32 $ pm + pm = 1097911063 -- testnet; TODO: need to decide on how to pass this in + + +-- | Get the underlying ByteString +encodeXPub :: (Key level XPub) -> ByteString +encodeXPub = CC.unXPub . getKey From 32bb720c57d7da90825c28338bb281dbf10a3aa1 Mon Sep 17 00:00:00 2001 From: Johannes Lund Date: Tue, 23 Apr 2019 20:07:21 +0200 Subject: [PATCH 2/3] Add generateChangeOutput --- src/Cardano/Wallet.hs | 15 ++++++++---- .../Wallet/Primitive/AddressDiscovery.hs | 24 ++++++++++++++++++- 2 files changed, 34 insertions(+), 5 deletions(-) diff --git a/src/Cardano/Wallet.hs b/src/Cardano/Wallet.hs index c83b74bb371..5e0862da194 100644 --- a/src/Cardano/Wallet.hs +++ b/src/Cardano/Wallet.hs @@ -62,7 +62,7 @@ import Cardano.Wallet.Primitive.AddressDerivation , publicKey ) import Cardano.Wallet.Primitive.AddressDiscovery - ( AddressPoolGap, SeqState (..), mkAddressPool ) + ( AddressPoolGap, SeqState (..), generateChangeOutput, mkAddressPool ) import Cardano.Wallet.Primitive.Model ( Wallet, applyBlocks, availableUTxO, currentTip, getState, initWallet ) import Cardano.Wallet.Primitive.Signing @@ -97,6 +97,8 @@ import Control.Monad.Trans.Except ( ExceptT, runExceptT, throwE, withExceptT ) import Control.Monad.Trans.Maybe ( MaybeT (..), maybeToExceptT ) +import Control.Monad.Trans.State + ( runState, state ) import Data.Functor ( ($>) ) import Data.List.NonEmpty @@ -257,12 +259,17 @@ mkWalletLayer db network = WalletLayer let signed = SignedTx $ toByteString $ encodeSignedTx (tx, witnesses) withExceptT NetworkError $ postTx network signed - , signTx = \wid rootXPrv password (CoinSelection ins outs _chgs) -> do + , signTx = \wid rootXPrv password (CoinSelection ins outs chgs) -> do -- TODO: This is untested (w, _) <- withExceptT ErrSignTxNoSuchWallet $ _readWallet wid - shuffledOuts <- liftIO $ shuffle outs - case mkStdTx (getState w) (rootXPrv, password) ins shuffledOuts of + let (changeOuts, _newState) = runState + (mapM (state . generateChangeOutput) chgs) + (getState w) + + allShuffledOuts <- liftIO $ shuffle (outs ++ changeOuts) + + case mkStdTx (getState w) (rootXPrv, password) ins allShuffledOuts of Right a -> return a Left e -> throwE $ ErrSignTx e } diff --git a/src/Cardano/Wallet/Primitive/AddressDiscovery.hs b/src/Cardano/Wallet/Primitive/AddressDiscovery.hs index 058c62c1de1..3d6e52292c7 100644 --- a/src/Cardano/Wallet/Primitive/AddressDiscovery.hs +++ b/src/Cardano/Wallet/Primitive/AddressDiscovery.hs @@ -56,13 +56,15 @@ import Cardano.Wallet.Primitive.AddressDerivation , keyToAddress ) import Cardano.Wallet.Primitive.Types - ( Address, IsOurs (..), invariant ) + ( Address, Coin (..), IsOurs (..), TxOut (..), invariant ) import Control.Applicative ( (<|>) ) import Control.DeepSeq ( NFData, deepseq ) import Data.Bifunctor ( first ) +import Data.Foldable + ( maximum ) import Data.Function ( (&) ) import Data.List @@ -292,6 +294,8 @@ class AddressScheme s where -> s -> (Maybe (Key 'AddressK XPrv), s) + generateChangeOutput :: Coin -> s -> (TxOut, s) + instance AddressScheme SeqState where keyFrom addr (rootPrv, pwd) (SeqState !s1 !s2) = let @@ -318,3 +322,21 @@ instance AddressScheme SeqState where in (deriveAddressPrivateKey pwd accountPrv chain <$> addrIx, pool') + generateChangeOutput c (SeqState intPool extPool) = + let + indexes = map snd $ Map.toList $ indexedAddresses intPool + newIndex = succ $ maximum indexes + xPub = deriveAddressPublicKey + (accountPubKey intPool) + InternalChain + newIndex + + next = Map.singleton addr newIndex + intPool' = + intPool { indexedAddresses = indexedAddresses intPool <> next } + addr = keyToAddress xPub + + in (TxOut addr c, SeqState intPool' extPool) + + + From 42fff2d086ff2238bdf2a7b494f24824fc74ea19 Mon Sep 17 00:00:00 2001 From: KtorZ Date: Wed, 24 Apr 2019 12:41:04 +0200 Subject: [PATCH 3/3] keep track of pending change indexes for transaction signing --- src/Cardano/Wallet.hs | 8 +- .../Wallet/Primitive/AddressDiscovery.hs | 189 ++++++++++++------ src/Cardano/Wallet/Primitive/Signing.hs | 34 +--- 3 files changed, 149 insertions(+), 82 deletions(-) diff --git a/src/Cardano/Wallet.hs b/src/Cardano/Wallet.hs index 5e0862da194..9f511a68915 100644 --- a/src/Cardano/Wallet.hs +++ b/src/Cardano/Wallet.hs @@ -62,7 +62,12 @@ import Cardano.Wallet.Primitive.AddressDerivation , publicKey ) import Cardano.Wallet.Primitive.AddressDiscovery - ( AddressPoolGap, SeqState (..), generateChangeOutput, mkAddressPool ) + ( AddressPoolGap + , SeqState (..) + , emptyPendingIxs + , generateChangeOutput + , mkAddressPool + ) import Cardano.Wallet.Primitive.Model ( Wallet, applyBlocks, availableUTxO, currentTip, getState, initWallet ) import Cardano.Wallet.Primitive.Signing @@ -222,6 +227,7 @@ mkWalletLayer db network = WalletLayer let checkpoint = initWallet $ SeqState { externalPool = extPool , internalPool = intPool + , pendingChangeIxs = emptyPendingIxs } now <- liftIO getCurrentTime let metadata = WalletMetadata diff --git a/src/Cardano/Wallet/Primitive/AddressDiscovery.hs b/src/Cardano/Wallet/Primitive/AddressDiscovery.hs index 3d6e52292c7..78b7352cc30 100644 --- a/src/Cardano/Wallet/Primitive/AddressDiscovery.hs +++ b/src/Cardano/Wallet/Primitive/AddressDiscovery.hs @@ -16,11 +16,11 @@ -- compatibility with random address scheme from the legacy Cardano wallets. module Cardano.Wallet.Primitive.AddressDiscovery - ( AddressScheme (..) + ( -- * Sequential Derivation -- ** Address Pool Gap - , AddressPoolGap + AddressPoolGap , MkAddressPoolGapError (..) , defaultAddressPoolGap , getAddressPoolGap @@ -35,9 +35,14 @@ module Cardano.Wallet.Primitive.AddressDiscovery , mkAddressPool , lookupAddress + -- * Pending Change Indexes + , PendingIxs + , emptyPendingIxs + -- ** State , SeqState (..) - ) where + , AddressScheme (..) + ) where import Prelude @@ -63,12 +68,8 @@ import Control.DeepSeq ( NFData, deepseq ) import Data.Bifunctor ( first ) -import Data.Foldable - ( maximum ) import Data.Function ( (&) ) -import Data.List - ( sortOn ) import Data.Map.Strict ( Map ) import Data.Maybe @@ -82,6 +83,7 @@ import GHC.Generics import Text.Read ( readMaybe ) +import qualified Data.List as L import qualified Data.Map.Strict as Map import qualified Data.Text as T @@ -95,7 +97,9 @@ import qualified Data.Text as T -------------------------------------------------------------------------------} --- ** Address Pool Gap +{------------------------------------------------------------------------------- + Address Pool Gap +-------------------------------------------------------------------------------} -- | Maximum number of consecutive undiscovered addresses allowed newtype AddressPoolGap = AddressPoolGap @@ -149,8 +153,9 @@ defaultAddressPoolGap :: AddressPoolGap defaultAddressPoolGap = AddressPoolGap 20 - --- ** Address Pool +{------------------------------------------------------------------------------- + Address Pool +-------------------------------------------------------------------------------} -- | An 'AddressPool' which keeps track of sequential addresses within a given -- Account and change chain. See 'mkAddressPool' to create a new or existing @@ -181,7 +186,7 @@ instance NFData AddressPool -- -- > mkAddressPool key g cc (addresses pool) == pool addresses :: AddressPool -> [Address] -addresses = map fst . sortOn snd . Map.toList . indexedAddresses +addresses = map fst . L.sortOn snd . Map.toList . indexedAddresses -- | Create a new Address pool from a list of addresses. Note that, the list is -- expected to be ordered in sequence (first indexes, first in the list). @@ -254,12 +259,79 @@ nextAddresses !key (AddressPoolGap !g) !cc !fromIx = (>= fromIx) newAddress = keyToAddress . deriveAddressPublicKey key cc +{------------------------------------------------------------------------------- + Pending Change Indexes +-------------------------------------------------------------------------------} + +-- | An ordered set of pending indexes. This keep track of indexes used +newtype PendingIxs = PendingIxs [Index 'Soft 'AddressK] + deriving stock (Generic, Show) +instance NFData PendingIxs + +-- | An empty pending set of change indexes. +-- +-- NOTE: We do not define a 'Monoid' instance here because there's no rational +-- of combining two pending sets. +emptyPendingIxs :: PendingIxs +emptyPendingIxs = PendingIxs mempty + +-- | Update the set of pending indexes by discarding every indexes _below_ the +-- given index. +-- +-- Why is that? +-- +-- Because we really do care about the higher index that was last used in order +-- to know from where we can generate new indexes. +updatePendingIxs + :: Index 'Soft 'AddressK + -> PendingIxs + -> PendingIxs +updatePendingIxs ix (PendingIxs ixs) = + PendingIxs $ L.filter (> ix) ixs + +-- | Get the next change index; If every available indexes have already been +-- taken, we'll rotate the pending set and re-use already provided indexes. +-- +-- This should not be a problem for users in practice, and remain okay for +-- exchanges who care less about privacy / not-reusing addresses than +-- regular users. +nextChangeIndex + :: AddressPool + -> PendingIxs + -> (Index 'Soft 'AddressK, PendingIxs) +nextChangeIndex pool (PendingIxs ixs) = + let + poolLen = length (addresses pool) + (firstUnused, lastUnused) = + ( toEnum $ poolLen - fromEnum (gap pool) + , toEnum $ poolLen - 1 + ) + (ix, ixs') = case ixs of + [] -> + (firstUnused, PendingIxs [firstUnused]) + h:_ | length ixs < fromEnum (gap pool) -> + (succ h, PendingIxs (succ h:ixs)) + h:q -> + (h, PendingIxs (q++[h])) + in + invariant "index is within first unused and last unused" (ix, ixs') + (\(i,_) -> i >= firstUnused && i <= lastUnused) + +{------------------------------------------------------------------------------- + State +-------------------------------------------------------------------------------} + data SeqState = SeqState { internalPool :: !AddressPool + -- ^ Addresses living on the 'InternalChain' , externalPool :: !AddressPool + -- ^ Addresses living on the 'ExternalChain' + , pendingChangeIxs :: !PendingIxs + -- ^ Indexes from the internal pool that have been used in pending + -- transactions. The list is maintained sorted in descending order + -- (cf: 'PendingIxs') } deriving stock (Generic, Show) - instance NFData SeqState -- NOTE @@ -267,18 +339,17 @@ instance NFData SeqState -- account discovery algorithm is only specified for the external chain so -- in theory, there's nothing forcing a wallet to generate change -- addresses on the internal chain anywhere in the available range. --- --- In practice, we may assume that user can't create change addresses and --- that they are just created in sequence by the wallet software. Hence an --- address pool with a gap of 1 should be sufficient for the internal chain. instance IsOurs SeqState where - isOurs addr (SeqState !s1 !s2) = + isOurs addr (SeqState !s1 !s2 !ixs) = let - (res1, !s1') = lookupAddress addr s1 - (res2, !s2') = lookupAddress addr s2 - ours = isJust (res1 <|> res2) + (internal, !s1') = lookupAddress addr s1 + (external, !s2') = lookupAddress addr s2 + !ixs' = case internal of + Nothing -> ixs + Just ix -> updatePendingIxs ix ixs + ours = isJust (internal <|> external) in - (ours `deepseq` ours, SeqState s1' s2') + (ixs' `deepseq` ours `deepseq` ours, SeqState s1' s2' ixs') -- TODO: We might want to move this abstraction / there is more work to be -- done here. @@ -292,51 +363,55 @@ class AddressScheme s where :: Address -> (Key 'RootK XPrv, Passphrase "encryption") -> s - -> (Maybe (Key 'AddressK XPrv), s) - - generateChangeOutput :: Coin -> s -> (TxOut, s) + -> Maybe (Key 'AddressK XPrv) + -- ^ Derive the private key corresponding to an address. Careful, this + -- operation can be costly. Note that the state is discarded from this + -- function as we do not intend to discover any addresses from this + -- operation; This is merely a lookup from known addresses. + + generateChangeOutput + :: Coin + -> s + -> (TxOut, s) + -- ^ Generate a change output 'TxOut' from a given 'Coin'. This picks + -- up the first non-used known change address and use it. We keep track + -- of pending indexes in the state. instance AddressScheme SeqState where - keyFrom addr (rootPrv, pwd) (SeqState !s1 !s2) = + keyFrom addr (rootPrv, pwd) (SeqState !s1 !s2 _) = let - (xPrv1, !s1') = lookupAndDeriveXPrv s1 InternalChain - (xPrv2, !s2') = lookupAndDeriveXPrv s2 ExternalChain - - xPrv = (xPrv1 <|> xPrv2) - + xPrv1 = lookupAndDeriveXPrv s1 InternalChain + xPrv2 = lookupAndDeriveXPrv s2 ExternalChain + xPrv = xPrv1 <|> xPrv2 in - (xPrv `deepseq` xPrv, SeqState s1' s2') - + xPrv where - -- We are assuming there is only one account - account = minBound - accountPrv = deriveAccountPrivateKey pwd rootPrv account - lookupAndDeriveXPrv :: AddressPool -> ChangeChain - -> (Maybe (Key 'AddressK XPrv), AddressPool) + -> Maybe (Key 'AddressK XPrv) lookupAndDeriveXPrv pool chain = let - (addrIx, pool') = lookupAddress addr pool + -- We are assuming there is only one account + accountPrv = deriveAccountPrivateKey pwd rootPrv minBound + (addrIx, _) = lookupAddress addr pool in - (deriveAddressPrivateKey pwd accountPrv chain <$> addrIx, pool') - - generateChangeOutput c (SeqState intPool extPool) = + deriveAddressPrivateKey pwd accountPrv chain <$> addrIx + + -- | We pick indexes in sequence from the first known available index (i.e. + -- @length addrs - gap@) but we do not generate _new change addresses_. As a + -- result, we can't generate more than @gap@ _pending_ change addresses and + -- therefore, rotate the change addresses when we need extra change outputs. + -- + -- See also: 'nextChangeIndex' + generateChangeOutput c (SeqState intPool extPool pending) = let - indexes = map snd $ Map.toList $ indexedAddresses intPool - newIndex = succ $ maximum indexes - xPub = deriveAddressPublicKey - (accountPubKey intPool) - InternalChain - newIndex - - next = Map.singleton addr newIndex - intPool' = - intPool { indexedAddresses = indexedAddresses intPool <> next } - addr = keyToAddress xPub - - in (TxOut addr c, SeqState intPool' extPool) - - - + (ix, pending') = nextChangeIndex intPool pending + accountXPub = accountPubKey intPool + addressXPub = deriveAddressPublicKey accountXPub InternalChain ix + txout = TxOut + { address = keyToAddress addressXPub + , coin = c + } + in + (txout, SeqState intPool extPool pending') diff --git a/src/Cardano/Wallet/Primitive/Signing.hs b/src/Cardano/Wallet/Primitive/Signing.hs index 10cc494ee32..98f9147cb07 100644 --- a/src/Cardano/Wallet/Primitive/Signing.hs +++ b/src/Cardano/Wallet/Primitive/Signing.hs @@ -40,14 +40,12 @@ import Control.Monad ( forM ) import Crypto.Hash ( Blake2b_256, hash ) -import Data.ByteArray - ( convert ) import Data.ByteString ( ByteString ) import qualified Cardano.Crypto.Wallet as CC import qualified Codec.CBOR.Encoding as CBOR - +import qualified Data.ByteArray as BA newtype SignTxError = KeyNotFoundForAddress Address @@ -65,37 +63,25 @@ mkStdTx -> [TxOut] -- ^ Selected outputs (including change) -> Either SignTxError (Tx, [TxWitness]) -mkStdTx s (rootPrv, pwd) ownedIns outs = do +mkStdTx s creds@(_, pwd) ownedIns outs = do let ins = (fmap fst ownedIns) tx = Tx ins outs txSigData = hashTx tx - - txWitnesses <- forM ownedIns (\(_in, TxOut addr _c) -> - mkWitness txSigData <$> keyFrom' addr) - + txWitnesses <- forM ownedIns $ \(_in, TxOut addr _c) -> mkWitness txSigData + <$> withEither (KeyNotFoundForAddress addr) (keyFrom addr creds s) return (tx, txWitnesses) - where - keyFrom' addr = - -- We are ignoring the new state/pool. We won't discover any new - -- addresses when submitting transactions. - case (fst $ keyFrom addr (rootPrv, pwd) s) of - Just key -> Right key - Nothing -> Left $ KeyNotFoundForAddress addr - + withEither :: e -> Maybe a -> Either e a + withEither e = maybe (Left e) Right hashTx :: Tx -> Hash "tx" hashTx txSigData = Hash - $ convert - $ (hash @ByteString @Blake2b_256) + $ BA.convert + $ (hash @_ @Blake2b_256) $ toByteString $ encodeTx txSigData - - mkWitness :: Hash "tx" -> Key 'AddressK XPrv -> TxWitness - mkWitness tx xPrv = - PublicKeyWitness $ - encodeXPub (publicKey xPrv) <> - getHash (sign (SignTx tx) (xPrv, pwd)) + mkWitness tx xPrv = PublicKeyWitness $ + encodeXPub (publicKey xPrv) <> getHash (sign (SignTx tx) (xPrv, pwd))