From e82a9b4c747ff324d029ab5b49603250113dc268 Mon Sep 17 00:00:00 2001 From: Johannes Lund Date: Tue, 9 Apr 2019 16:23:21 +0200 Subject: [PATCH] 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 | 13 +- .../Wallet/Primitive/AddressDerivation.hs | 3 +- src/Cardano/Wallet/Primitive/Signing.hs | 192 ++++++++++++++++++ 4 files changed, 203 insertions(+), 9 deletions(-) create mode 100644 src/Cardano/Wallet/Primitive/Signing.hs diff --git a/cardano-wallet.cabal b/cardano-wallet.cabal index 06b8eb1a0e7..51b9eaf0844 100644 --- a/cardano-wallet.cabal +++ b/cardano-wallet.cabal @@ -53,13 +53,14 @@ library , http-types , memory , servant - , servant-server , servant-client , servant-client-core + , servant-server , text , time , time-units , transformers + , vector hs-source-dirs: src exposed-modules: @@ -82,6 +83,7 @@ library Cardano.Wallet.Primitive.Mnemonic Cardano.Wallet.Primitive.Model Cardano.Wallet.Primitive.Types + Cardano.Wallet.Primitive.Signing Data.Text.Class Data.Quantity Servant.Extra.ContentTypes diff --git a/src/Cardano/Wallet.hs b/src/Cardano/Wallet.hs index 8cb64591f70..8f7fc08e127 100644 --- a/src/Cardano/Wallet.hs +++ b/src/Cardano/Wallet.hs @@ -61,6 +61,8 @@ import Cardano.Wallet.Primitive.AddressDiscovery ( AddressPoolGap, SeqState (..), mkAddressPool ) import Cardano.Wallet.Primitive.Model ( Wallet, applyBlocks, availableUTxO, getState, initWallet ) +import Cardano.Wallet.Primitive.Signing + ( mkStdTx, shuffle ) import Cardano.Wallet.Primitive.Types ( Block (..) , SignedTx (..) @@ -236,12 +238,11 @@ 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) + res <- liftIO (mkStdTx (getState w) (rootXPrv, password) shuffle ins outs) + maybe (throwE ErrSignTx) return res {--------------------------------------------------------------------------- W.I.P. / Debts @@ -286,8 +287,6 @@ mkWalletLayer db network = WalletLayer unsafeRunExceptT $ DB.putCheckpoint db (PrimaryKey wid) cp' unsafeRunExceptT $ DB.putTxHistory db (PrimaryKey wid) txs - mkStdTx = error "TODO: mkStdTx not implemented yet" - {------------------------------------------------------------------------------- Helpers -------------------------------------------------------------------------------} diff --git a/src/Cardano/Wallet/Primitive/AddressDerivation.hs b/src/Cardano/Wallet/Primitive/AddressDerivation.hs index 870ca0f3d1b..f53e474f635 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 + , unKey , Depth (..) , Index , getIndex @@ -120,7 +121,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 { unKey :: key } deriving stock (Generic, Show, Eq) instance (NFData key) => NFData (Key level key) diff --git a/src/Cardano/Wallet/Primitive/Signing.hs b/src/Cardano/Wallet/Primitive/Signing.hs new file mode 100644 index 00000000000..b4cf196bc11 --- /dev/null +++ b/src/Cardano/Wallet/Primitive/Signing.hs @@ -0,0 +1,192 @@ +{-# 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, looking up address keys +-- from AddressPools, and cardano-crypto for the actual signing. +module Cardano.Wallet.Primitive.Signing + ( -- * Sign transactions + mkStdTx + + -- * Extra + , shuffle + ) + where + + +import Prelude + +import Cardano.Wallet.Binary + ( TxWitness (..), encodeTx, toByteString ) +import Cardano.Wallet.Primitive.AddressDerivation + ( ChangeChain (ExternalChain) + , Depth (AddressK, RootK) + , Key + , Passphrase (..) + , XPrv + , XPub + , deriveAccountPrivateKey + , deriveAddressPrivateKey + , publicKey + , unKey + ) +import Cardano.Wallet.Primitive.AddressDiscovery + ( SeqState (externalPool), lookupAddress ) +import Cardano.Wallet.Primitive.Types + ( Address, Hash (..), Tx (..), TxIn, TxOut (..) ) +import Control.Monad + ( forM, forM_ ) +import Crypto.Hash + ( Blake2b_256, hash ) +import Crypto.Number.Generate + ( generateBetween ) +import Data.ByteArray + ( convert ) +import Data.ByteString + ( ByteString ) +import Data.Vector.Mutable + ( IOVector ) + +import qualified Cardano.Crypto.Wallet as CC +import qualified Codec.CBOR.Encoding as CBOR +import qualified Data.Vector as V +import qualified Data.Vector.Mutable as MV + +-- | Build a transaction + +-- | Construct a standard transaction +-- +-- " Standard " here refers to the fact that we do not deal with redemption, +-- multisignature transactions, etc. +-- +mkStdTx + :: Monad m + => SeqState + -> (Key 'RootK XPrv, Passphrase "encryption") + -> (forall a. [a] -> m [a]) + -- ^ Function for shuffeling outputs + -> [(TxIn, TxOut)] + -- ^ Selected inputs + -> [TxOut] + -- ^ Selected outputs (including change) + -> m (Maybe (Tx, [TxWitness])) +mkStdTx seqState (rootPrv, pwd) shuffle' ownedIns unshuffledOuts = do + + outs <- shuffle' unshuffledOuts + + return $ 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 + hashTx :: Tx -> Hash "tx" + hashTx tx = Hash + $ convert + $ (hash @ByteString @Blake2b_256) + $ toByteString + $ encodeTx tx + + keyFrom :: Address -> (Maybe (Key 'AddressK XPrv)) + keyFrom addr = do + -- We are assuming there is only one account + let account = minBound + let accountPrv = deriveAccountPrivateKey pwd rootPrv account + + -- We are ignoring the new state/pool. We won't discover any new + -- addresses when submitting transactions. + index <- fst $ lookupAddress addr (externalPool seqState) + + return $ deriveAddressPrivateKey pwd accountPrv ExternalChain index + + 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 (unKey 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 . unKey + + +{------------------------------------------------------------------------------- + Extra +-------------------------------------------------------------------------------} + +-- | Shuffles a list. Meant to be passed to @mkStdTx@. +-- +-- Implementation was copied from cardano-sl +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' + +