[ADP-3488] Implement signTx (#4851)

This pull request implements the `signTx` function in the Deposit
Wallet.

This pull request also changes the semantics of
`credentialsFromMnemonics` to store the *account* `XPub` as well as the
*root* `XPrv` (the latter only if available).

### Issue Number

ADP-3488

lib/customer-deposit-wallet/customer-deposit-wallet.cabal

@@ -62,6 +62,7 @@ library
     , cardano-addresses
     , cardano-balance-tx
     , cardano-crypto
+    , cardano-crypto-class
     , cardano-ledger-api
     , cardano-ledger-core
     , cardano-strict-containers

lib/customer-deposit-wallet/rest/Cardano/Wallet/Deposit/REST.hs

@@ -82,6 +82,7 @@ import Cardano.Wallet.Deposit.Pure
     ( Credentials
     , Customer
     , ErrCreatePayment
+    , Passphrase
     , Word31
     , fromCredentialsAndGenesis
     )
@@ -90,7 +91,7 @@ import Cardano.Wallet.Deposit.Pure.API.TxHistory
     , ByTime
     )
 import Cardano.Wallet.Deposit.Pure.State.Creation
-    ( xpubFromCredentials
+    ( accountXPubFromCredentials
     )
 import Cardano.Wallet.Deposit.Read
     ( Address
@@ -320,7 +321,7 @@ createTheDepositWalletOnDisk _tr dir credentials users action = do
             . convertToBase Base16
             . blake2b160
             . xpubToBytes
-            . xpubFromCredentials
+            . accountXPubFromCredentials
 
 -- | Load an existing wallet from disk.
 loadWallet
@@ -450,5 +451,6 @@ getBIP32PathsForOwnedInputs =
 
 signTx
     :: Write.Tx
+    -> Passphrase
     -> WalletResourceM (Maybe Write.Tx)
-signTx = onWalletInstance . WalletIO.signTx
+signTx tx = onWalletInstance . WalletIO.signTx tx

lib/customer-deposit-wallet/src/Cardano/Wallet/Deposit/IO.hs

@@ -344,8 +344,9 @@ getBIP32PathsForOwnedInputs
 getBIP32PathsForOwnedInputs a w =
     Wallet.getBIP32PathsForOwnedInputs a <$> readWalletState w
 
-signTx :: Write.Tx -> WalletInstance -> IO (Maybe Write.Tx)
-signTx a w = Wallet.signTx a <$> readWalletState w
+signTx
+    :: Write.Tx -> Wallet.Passphrase -> WalletInstance -> IO (Maybe Write.Tx)
+signTx a b w = Wallet.signTx a b <$> readWalletState w
 
 {-----------------------------------------------------------------------------
     Operations

lib/customer-deposit-wallet/src/Cardano/Wallet/Deposit/Pure.hs

@@ -50,6 +50,7 @@ module Cardano.Wallet.Deposit.Pure
     , BIP32Path (..)
     , DerivationType (..)
     , getBIP32PathsForOwnedInputs
+    , Passphrase
     , signTx
     , addTxSubmission
     , listTxsInSubmission
@@ -74,7 +75,8 @@ import Cardano.Wallet.Deposit.Pure.State.Rolling
     , rollForwardOne
     )
 import Cardano.Wallet.Deposit.Pure.State.Signing
-    ( getBIP32PathsForOwnedInputs
+    ( Passphrase
+    , getBIP32PathsForOwnedInputs
     , signTx
     )
 import Cardano.Wallet.Deposit.Pure.State.Submissions

lib/customer-deposit-wallet/src/Cardano/Wallet/Deposit/Pure/State/Creation.hs

@@ -1,13 +1,16 @@
 {-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE TypeSynonymInstances #-}
 {-# OPTIONS_GHC -Wno-orphans #-}
+
 module Cardano.Wallet.Deposit.Pure.State.Creation
     ( WalletPublicIdentity (..)
     , fromCredentialsAndGenesis
+    , deriveAccountXPrv
     , Credentials (..)
     , credentialsFromMnemonics
     , credentialsFromEncodedXPub
-    , xpubFromCredentials
-    , xprvFromCredentials
+    , accountXPubFromCredentials
+    , rootXPrvFromCredentials
     , ErrDecodingXPub (..)
     , encodedXPubFromCredentials
     ) where
@@ -21,11 +24,14 @@ import Cardano.Address.Derivation
     , xpubToBytes
     )
 import Cardano.Crypto.Wallet
+    ( generate
+    )
+import Cardano.Wallet.Address.BIP32_Ed25519
     ( XPrv
     , XPub
-    , generate
+    , deriveXPrvHard
+    , rawSerialiseXPrv
     , toXPub
-    , unXPrv
     )
 import Cardano.Wallet.Deposit.Pure.State.Type
     ( WalletState (..)
@@ -60,18 +66,34 @@ data Credentials
     deriving (Generic, Show, Eq)
 
 instance Show XPrv where
-    show = B8.unpack . B16.encode . unXPrv
+    show = B8.unpack . B16.encode . rawSerialiseXPrv
 
 instance Eq XPrv where
-    a == b = unXPrv a == unXPrv b
+    a == b = rawSerialiseXPrv a == rawSerialiseXPrv b
+
+-- | Get /account/ 'XPub' from credentials if available.
+--
+-- The account public key corresponds to the account
+-- private key obtained from 'deriveAccountXPrv',
+-- /not/ the root private key.
+accountXPubFromCredentials :: Credentials -> XPub
+accountXPubFromCredentials (XPubCredentials xpub) = xpub
+accountXPubFromCredentials (XPrvCredentials _ xpub) = xpub
 
-xpubFromCredentials :: Credentials -> XPub
-xpubFromCredentials (XPubCredentials xpub) = xpub
-xpubFromCredentials (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
 
-xprvFromCredentials :: Credentials -> Maybe XPrv
-xprvFromCredentials (XPubCredentials _) = Nothing
-xprvFromCredentials (XPrvCredentials xprv _) = Just xprv
+-- | Get root 'XPrv' from credentials if available.
+rootXPrvFromCredentials :: Credentials -> Maybe XPrv
+rootXPrvFromCredentials (XPubCredentials _) = Nothing
+rootXPrvFromCredentials (XPrvCredentials xprv _) = Just xprv
 
 fromCredentialsAndGenesis
     :: Credentials -> Word31 -> Read.GenesisData -> WalletState
@@ -81,12 +103,12 @@ fromCredentialsAndGenesis credentials knownCustomerCount genesisData =
         , addresses =
             Address.fromXPubAndCount
                 network
-                (xpubFromCredentials credentials)
+                (accountXPubFromCredentials credentials)
                 knownCustomerCount
         , utxoHistory = UTxOHistory.fromOrigin initialUTxO
         , txHistory = mempty
         , submissions = Sbm.empty
-        , rootXSignKey = xprvFromCredentials credentials
+        , rootXSignKey = rootXPrvFromCredentials credentials
         }
   where
     network = Read.getNetworkId genesisData
@@ -110,7 +132,9 @@ credentialsFromMnemonics mnemonics passphrase =
                 (T.encodeUtf8 mnemonics)
                 (T.encodeUtf8 passphrase)
     in
-        XPrvCredentials encryptedXPrv (toXPub unencryptedXPrv)
+        XPrvCredentials
+            encryptedXPrv
+            (toXPub $ deriveAccountXPrv unencryptedXPrv)
 
 -- | Create 'Credentials' from an extended public key failures to decode
 data ErrDecodingXPub = ErrFromXPubBase16 | ErrFromXPubDecodeKey

lib/customer-deposit-wallet/src/Cardano/Wallet/Deposit/Pure/State/Signing.hs

@@ -1,12 +1,22 @@
 module Cardano.Wallet.Deposit.Pure.State.Signing
     ( getBIP32PathsForOwnedInputs
     , signTx
+    , Passphrase
     ) where
 
 import Prelude
 
+import Cardano.Crypto.Wallet
+    ( xPrvChangePass
+    )
 import Cardano.Wallet.Address.BIP32
     ( BIP32Path (..)
+    , DerivationType (..)
+    )
+import Cardano.Wallet.Address.BIP32_Ed25519
+    ( XPrv
+    , deriveXPrvHard
+    , deriveXPrvSoft
     )
 import Cardano.Wallet.Deposit.Pure.State.Submissions
     ( availableUTxO
@@ -20,11 +30,16 @@ import Data.Maybe
 import Data.Set
     ( Set
     )
+import Data.Text
+    ( Text
+    )
 
 import qualified Cardano.Wallet.Deposit.Pure.Address as Address
 import qualified Cardano.Wallet.Deposit.Pure.UTxO as UTxO
 import qualified Cardano.Wallet.Deposit.Read as Read
 import qualified Cardano.Wallet.Deposit.Write as Write
+import qualified Data.ByteString as BS
+import qualified Data.Text.Encoding as T
 
 getBIP32PathsForOwnedInputs :: Write.Tx -> WalletState -> [BIP32Path]
 getBIP32PathsForOwnedInputs tx w =
@@ -42,5 +57,26 @@ getBIP32Paths :: WalletState -> [Read.Address] -> [BIP32Path]
 getBIP32Paths w =
     mapMaybe $ Address.getBIP32Path (addresses w)
 
-signTx :: Write.Tx -> WalletState -> Maybe Write.Tx
-signTx _tx _w = undefined
+type Passphrase = Text
+
+-- | Sign the transaction if 'rootXSignKey' is 'Just'.
+signTx :: Write.Tx -> Passphrase -> WalletState -> Maybe Write.Tx
+signTx tx passphrase w = signTx' <$> rootXSignKey w
+  where
+    signTx' encryptedXPrv =
+        foldr Write.addAddressWitness tx keys
+      where
+        unencryptedXPrv =
+            xPrvChangePass
+                (T.encodeUtf8 passphrase)
+                BS.empty
+                encryptedXPrv
+        keys = deriveBIP32Path unencryptedXPrv
+            <$> getBIP32PathsForOwnedInputs tx w
+
+deriveBIP32Path :: XPrv -> BIP32Path -> XPrv
+deriveBIP32Path xprv Root = xprv
+deriveBIP32Path xprv (Segment path Hardened ix) =
+    deriveXPrvHard (deriveBIP32Path xprv path) ix
+deriveBIP32Path xprv (Segment path Soft ix) =
+    deriveXPrvSoft (deriveBIP32Path xprv path) ix

lib/customer-deposit-wallet/src/Cardano/Wallet/Deposit/Write.hs

@@ -1,3 +1,5 @@
+{-# LANGUAGE DataKinds #-}
+
 -- | Indirection module that re-exports types
 -- used for writing transactions to the blockchain,
 -- in the most recent and the next future eras.
@@ -31,6 +33,9 @@ module Cardano.Wallet.Deposit.Write
     , Write.ErrBalanceTx (..)
     , Write.balanceTx
 
+      -- * Signing
+    , addAddressWitness
+
       -- ** Time interpreter
     , Write.TimeTranslation
 
@@ -45,9 +50,24 @@ module Cardano.Wallet.Deposit.Write
 
 import Prelude
 
+import Cardano.Crypto.Wallet
+    ( xpubPublicKey
+    )
+import Cardano.Ledger.Keys
+    ( SignedDSIGN
+    , VKey (..)
+    )
 import Cardano.Read.Ledger.Tx.Output
     ( Output (..)
     )
+import Cardano.Wallet.Address.BIP32_Ed25519
+    ( XPrv
+    , XPub
+    , XSignature
+    , rawSerialiseXSignature
+    , sign
+    , toXPub
+    )
 import Cardano.Wallet.Deposit.Read
     ( Address
     , Ix
@@ -63,12 +83,16 @@ import Cardano.Wallet.Read.Tx
 import Control.Lens
     ( Lens'
     , lens
+    , (%~)
     , (&)
     , (.~)
     )
 import Data.Map
     ( Map
     )
+import Data.Maybe
+    ( fromMaybe
+    )
 import Data.Maybe.Strict
     ( StrictMaybe (..)
     , maybeToStrictMaybe
@@ -81,22 +105,67 @@ import Data.Set
     ( Set
     )
 
+import qualified Cardano.Crypto.DSIGN as DSIGN
 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.Read as Read
+import qualified Cardano.Wallet.Read.Hash as Hash
 import qualified Cardano.Write.Eras as Write
 import qualified Cardano.Write.Tx as Write
 import qualified Data.Map.Strict as Map
 import qualified Data.Set as Set
 
 {-----------------------------------------------------------------------------
-    Convenience TxBody
+    Types
 ------------------------------------------------------------------------------}
 type Tx = Read.Tx Read.Conway
 
 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) =
+    Read.Tx
+        (ledgerTx & (L.witsTxL . L.addrTxWitsL) %~ Set.insert witnessVKey)
+  where
+    txHash = Read.hashFromTxId $ Read.getTxId tx
+    xpub = toXPub xprv
+    xsign = sign xprv (Hash.hashToBytes txHash)
+    witnessVKey =
+        L.WitVKey (vkeyFromXPub xpub) (signedDSIGNfromXSignature xsign)
+
+-- | Convert 'XPub' to a type that 'Cardano.Ledger' accepts.
+vkeyFromXPub :: XPub -> VKey 'L.Witness L.StandardCrypto
+vkeyFromXPub =
+    VKey
+    . fromMaybe impossible
+    . DSIGN.rawDeserialiseVerKeyDSIGN
+    . xpubPublicKey
+  where
+    impossible = error "impossible: Cannot convert XPub to VKey"
+
+-- | Convert 'XSignature' to a type that 'Cardano.Ledger' accepts.
+signedDSIGNfromXSignature
+    :: XSignature
+    -> SignedDSIGN L.StandardCrypto
+        (Hash.Hash Hash.Blake2b_256 Read.EraIndependentTxBody)
+signedDSIGNfromXSignature =
+    DSIGN.SignedDSIGN
+    . fromMaybe impossible
+    . DSIGN.rawDeserialiseSigDSIGN
+    . rawSerialiseXSignature
+  where
+    impossible = error "impossible: Cannot convert XSignature to SignedDSIGN"
+
+{-----------------------------------------------------------------------------
+    Convenience TxBody
+------------------------------------------------------------------------------}
+
 data TxBody = TxBody
     { spendInputs :: Set TxIn
     , collInputs :: Set TxIn