Merge #2692 #2693

2692: Test the generation of change maps for non-user-specified assets. r=jonathanknowles a=jonathanknowles # Issue Number ADP-346 # Overview This PR: - extracts out function `collateNonUserSpecifiedAssetQuantities`. - extracts out function `makeChangeForNonUserSpecifiedAssets`. - adds property tests to verify the expected behaviour of each function. - adds unit tests to illustrate the expected behaviour of each function. The `collateNonUserSpecifiedAssetQuantities` function is designed to produce a map of all assets that do **NOT** appear in the user-specified outputs of a coin selection. Each asset `a` is mapped to the complete list of discrete quantities of `a` found in the selected inputs. The `makeChangeForNonUserSpecifiedAssets` function is designed to make a list of change maps for all assets that do **NOT** appear in the user-specified outputs of coin selection. The number of change maps is intended to be exactly equal to the number of user-specified outputs. 2693: Allow specifying purpose for acc x pub r=paweljakubas a=paweljakubas # Issue Number  adp-950 # Overview  - [x] updated swagger - [x] enable passing purpose - [x] adjust core unit tests - [x] add integration test - [x] guard purpose with integration test # Comments   Co-authored-by: Jonathan Knowles <jonathan.knowles@iohk.io> Co-authored-by: Pawel Jakubas <pawel.jakubas@iohk.io>
cardano-foundation · Jun 8, 2021 · 60d5e89 · 60d5e89
3 parents 518b4a4 + 8f2e54d + 23a18ff
commit 60d5e89
Show file tree

Hide file tree

Showing 12 changed files with 765 additions and 63 deletions.
diff --git a/lib/core-integration/src/Test/Integration/Scenario/API/Shelley/Addresses.hs b/lib/core-integration/src/Test/Integration/Scenario/API/Shelley/Addresses.hs
@@ -52,7 +52,7 @@ import Data.Text
 import Test.Hspec
     ( SpecWith, describe )
 import Test.Hspec.Expectations.Lifted
-    ( shouldBe, shouldNotSatisfy, shouldSatisfy )
+    ( shouldBe, shouldNotBe, shouldNotSatisfy, shouldSatisfy )
 import Test.Hspec.Extra
     ( it )
 import Test.Integration.Framework.DSL
@@ -935,6 +935,40 @@ spec = describe "SHELLEY_ADDRESSES" $ do
             (_, accPub) <- unsafeRequest @ApiAccountKey ctx accountPath payload2
             pure [accXPub, accPub]
         length (concat accountPublicKeys) `shouldBe` 20
+
+    it "POST_ACCOUNT_02 - Can get account public key using purpose" $ \ctx -> runResourceT $ do
+        let initPoolGap = 10
+        w <- emptyWalletWith ctx ("Wallet", fixturePassphrase, initPoolGap)
+        let accountPath = Link.postAccountKey @'Shelley w (DerivationIndex $ 2147483648 + 1)
+        let payload1 = Json [json|{
+                "passphrase": #{fixturePassphrase},
+                "format": "extended"
+            }|]
+        (_, accXPub1) <- unsafeRequest @ApiAccountKey ctx accountPath payload1
+
+        let payload2 = Json [json|{
+                "passphrase": #{fixturePassphrase},
+                "format": "extended",
+                "purpose": "1852H"
+            }|]
+        (_, accXPub2) <- unsafeRequest @ApiAccountKey ctx accountPath payload2
+        accXPub1 `shouldBe` accXPub2
+
+        let payload3 = Json [json|{
+                "passphrase": #{fixturePassphrase},
+                "format": "extended",
+                "purpose": "1854H"
+            }|]
+        (_, accXPub3) <- unsafeRequest @ApiAccountKey ctx accountPath payload3
+        accXPub1 `shouldNotBe` accXPub3
+
+        let payload4 = Json [json|{
+                "passphrase": #{fixturePassphrase},
+                "format": "extended",
+                "purpose": "1854"
+            }|]
+        resp <- request @ApiAccountKey ctx accountPath Default payload4
+        expectErrorMessage errMsg403WrongIndex resp
   where
     validateAddr resp expected = do
         let addr = getFromResponse id resp

diff --git a/lib/core/src/Cardano/Wallet.hs b/lib/core/src/Cardano/Wallet.hs
@@ -200,6 +200,8 @@ import Cardano.BM.Data.Severity
     ( Severity (..) )
 import Cardano.BM.Data.Tracer
     ( HasPrivacyAnnotation (..), HasSeverityAnnotation (..) )
+import Cardano.Crypto.Wallet
+    ( toXPub )
 import Cardano.Slotting.Slot
     ( SlotNo (..) )
 import Cardano.Wallet.DB
@@ -254,11 +256,12 @@ import Cardano.Wallet.Primitive.AddressDerivation.Icarus
 import Cardano.Wallet.Primitive.AddressDerivation.SharedKey
     ( SharedKey (..) )
 import Cardano.Wallet.Primitive.AddressDerivation.Shelley
-    ( ShelleyKey )
+    ( ShelleyKey, deriveAccountPrivateKeyShelley )
 import Cardano.Wallet.Primitive.AddressDiscovery
     ( CompareDiscovery (..)
     , GenChange (..)
     , GetAccount (..)
+    , GetPurpose (..)
     , IsOurs (..)
     , IsOwned (..)
     , KnownAddresses (..)
@@ -1305,11 +1308,11 @@ selectionToUnsignedTx wdrl sel s =
         -> t a
         -> t (a, NonEmpty DerivationIndex)
     qualifyAddresses getAddress hasAddresses =
-        case traverse withDerivationPath hasAddresses of
-            Just as -> as
-            Nothing -> error
-                "selectionToUnsignedTx: unable to find derivation path of a \
-                \known input or change address. This is impossible."
+        fromMaybe
+        (error
+         "selectionToUnsignedTx: unable to find derivation path of a known \
+         \input or change address. This is impossible.")
+        (traverse withDerivationPath hasAddresses)
       where
         withDerivationPath hasAddress =
             (hasAddress,) <$> fst (isOurs (getAddress hasAddress) s)
@@ -2332,16 +2335,21 @@ readAccountPublicKey ctx wid = db & \DBLayer{..} -> do
 getAccountPublicKeyAtIndex
     :: forall ctx s k.
         ( HasDBLayer IO s k ctx
-        , HardDerivation k
         , WalletKey k
+        , GetPurpose k
         )
     => ctx
     -> WalletId
     -> Passphrase "raw"
     -> DerivationIndex
+    -> Maybe DerivationIndex
     -> ExceptT ErrReadAccountPublicKey IO (k 'AccountK XPub)
-getAccountPublicKeyAtIndex ctx wid pwd ix = db & \DBLayer{..} -> do
-    acctIx <- withExceptT ErrReadAccountPublicKeyInvalidIndex $ guardHardIndex ix
+getAccountPublicKeyAtIndex ctx wid pwd ix purposeM = db & \DBLayer{..} -> do
+    acctIx <- withExceptT ErrReadAccountPublicKeyInvalidAccountIndex $ guardHardIndex ix
+
+    purpose <- maybe (pure (getPurpose @k))
+        (withExceptT ErrReadAccountPublicKeyInvalidPurposeIndex . guardHardIndex)
+        purposeM
 
     _cp <- mapExceptT atomically
         $ withExceptT ErrReadAccountPublicKeyNoSuchWallet
@@ -2351,7 +2359,8 @@ getAccountPublicKeyAtIndex ctx wid pwd ix = db & \DBLayer{..} -> do
     withRootKey @ctx @s @k ctx wid pwd ErrReadAccountPublicKeyRootKey
         $ \rootK scheme -> do
             let encPwd = preparePassphrase scheme pwd
-            pure $ publicKey $ deriveAccountPrivateKey encPwd rootK acctIx
+            let xprv = deriveAccountPrivateKeyShelley purpose encPwd (getRawKey rootK) acctIx
+            pure $ liftRawKey $ toXPub xprv
   where
     db = ctx ^. dbLayer @IO @s @k
 
@@ -2367,7 +2376,7 @@ guardSoftIndex ix =
 guardHardIndex
     :: Monad m
     => DerivationIndex
-    -> ExceptT (ErrInvalidDerivationIndex 'Hardened 'AccountK) m (Index 'Hardened whatever)
+    -> ExceptT (ErrInvalidDerivationIndex 'Hardened level) m (Index 'Hardened whatever)
 guardHardIndex ix =
     if ix > DerivationIndex (getIndex @'Hardened maxBound) || ix < DerivationIndex (getIndex @'Hardened minBound)
     then throwE $ ErrIndexOutOfBound minBound maxBound ix
@@ -2466,8 +2475,10 @@ data ErrConstructSharedWallet
 data ErrReadAccountPublicKey
     = ErrReadAccountPublicKeyNoSuchWallet ErrNoSuchWallet
         -- ^ The wallet doesn't exist?
-    | ErrReadAccountPublicKeyInvalidIndex (ErrInvalidDerivationIndex 'Hardened 'AccountK)
-        -- ^ User provided a derivation index outside of the 'Hard' domain
+    | ErrReadAccountPublicKeyInvalidAccountIndex (ErrInvalidDerivationIndex 'Hardened 'AccountK)
+        -- ^ User provided a derivation index for account outside of the 'Hard' domain
+    | ErrReadAccountPublicKeyInvalidPurposeIndex (ErrInvalidDerivationIndex 'Hardened 'PurposeK)
+        -- ^ User provided a derivation index for purpose outside of the 'Hard' domain
     | ErrReadAccountPublicKeyRootKey ErrWithRootKey
         -- ^ The wallet exists, but there's no root key attached to it
     deriving (Eq, Show)

diff --git a/lib/core/src/Cardano/Wallet/Api.hs b/lib/core/src/Cardano/Wallet/Api.hs
@@ -173,6 +173,7 @@ import Cardano.Wallet.Api.Types
     , ApiNetworkParameters
     , ApiPoolId
     , ApiPostAccountKeyData
+    , ApiPostAccountKeyDataWithPurpose
     , ApiPostRandomAddressData
     , ApiPutAddressesDataT
     , ApiSelectCoinsDataT
@@ -396,7 +397,7 @@ type PostAccountKey = "wallets"
     :> Capture "walletId" (ApiT WalletId)
     :> "keys"
     :> Capture "index" (ApiT DerivationIndex)
-    :> ReqBody '[JSON] ApiPostAccountKeyData
+    :> ReqBody '[JSON] ApiPostAccountKeyDataWithPurpose
     :> PostAccepted '[JSON] ApiAccountKey
 
 -- | https://input-output-hk.github.io/cardano-wallet/api/#operation/getAccountKey

diff --git a/lib/core/src/Cardano/Wallet/Api/Server.hs b/lib/core/src/Cardano/Wallet/Api/Server.hs
@@ -207,7 +207,7 @@ import Cardano.Wallet.Api.Types
     , ApiOurStakeKey (..)
     , ApiPendingSharedWallet (..)
     , ApiPoolId (..)
-    , ApiPostAccountKeyData (..)
+    , ApiPostAccountKeyDataWithPurpose (..)
     , ApiPostRandomAddressData (..)
     , ApiPutAddressesData (..)
     , ApiRawMetadata (..)
@@ -306,6 +306,7 @@ import Cardano.Wallet.Primitive.AddressDiscovery
     ( CompareDiscovery
     , GenChange (ArgGenChange)
     , GetAccount
+    , GetPurpose (..)
     , IsOurs
     , IsOwned
     , KnownAddresses
@@ -2481,18 +2482,18 @@ derivePublicKey ctx mkVer (ApiT wid) (ApiT role_) (ApiT ix) hashed = do
 postAccountPublicKey
     :: forall ctx s k account.
         ( ctx ~ ApiLayer s k
-        , HardDerivation k
         , WalletKey k
+        , GetPurpose k
         )
     => ctx
     -> (ByteString -> KeyFormat -> account)
     -> ApiT WalletId
     -> ApiT DerivationIndex
-    -> ApiPostAccountKeyData
+    -> ApiPostAccountKeyDataWithPurpose
     -> Handler account
-postAccountPublicKey ctx mkAccount (ApiT wid) (ApiT ix) (ApiPostAccountKeyData (ApiT pwd) extd) = do
+postAccountPublicKey ctx mkAccount (ApiT wid) (ApiT ix) (ApiPostAccountKeyDataWithPurpose (ApiT pwd) extd purposeM) = do
     withWorkerCtx @_ @s @k ctx wid liftE liftE $ \wrk -> do
-        k <- liftHandler $ W.getAccountPublicKeyAtIndex @_ @s @k wrk wid pwd ix
+        k <- liftHandler $ W.getAccountPublicKeyAtIndex @_ @s @k wrk wid pwd ix (getApiT <$> purposeM)
         pure $ mkAccount (publicKeyToBytes' extd $ getRawKey k) extd
 
 publicKeyToBytes' :: KeyFormat -> XPub -> ByteString
@@ -3407,7 +3408,8 @@ instance IsServerError ErrReadAccountPublicKey where
     toServerError = \case
         ErrReadAccountPublicKeyRootKey e -> toServerError e
         ErrReadAccountPublicKeyNoSuchWallet e -> toServerError e
-        ErrReadAccountPublicKeyInvalidIndex e -> toServerError e
+        ErrReadAccountPublicKeyInvalidAccountIndex e -> toServerError e
+        ErrReadAccountPublicKeyInvalidPurposeIndex e -> toServerError e
 
 instance IsServerError ErrDerivePublicKey where
     toServerError = \case

diff --git a/lib/core/src/Cardano/Wallet/Api/Types.hs b/lib/core/src/Cardano/Wallet/Api/Types.hs
@@ -139,6 +139,7 @@ module Cardano.Wallet.Api.Types
     , ApiAccountKeyShared (..)
     , KeyFormat (..)
     , ApiPostAccountKeyData (..)
+    , ApiPostAccountKeyDataWithPurpose (..)
 
     -- * API Types (Byron)
     , ApiByronWallet (..)
@@ -1140,6 +1141,13 @@ data ApiPostAccountKeyData = ApiPostAccountKeyData
     } deriving (Eq, Generic, Show)
       deriving anyclass NFData
 
+data ApiPostAccountKeyDataWithPurpose = ApiPostAccountKeyDataWithPurpose
+    { passphrase :: ApiT (Passphrase "raw")
+    , format :: KeyFormat
+    , purpose :: Maybe (ApiT DerivationIndex)
+    } deriving (Eq, Generic, Show)
+      deriving anyclass NFData
+
 data ApiAccountKey = ApiAccountKey
     { getApiAccountKey :: ByteString
     , format :: KeyFormat
@@ -1783,6 +1791,11 @@ instance FromJSON ApiPostAccountKeyData where
 instance ToJSON ApiPostAccountKeyData where
     toJSON = genericToJSON defaultRecordTypeOptions
 
+instance FromJSON ApiPostAccountKeyDataWithPurpose where
+    parseJSON = genericParseJSON defaultRecordTypeOptions
+instance ToJSON ApiPostAccountKeyDataWithPurpose where
+    toJSON = genericToJSON defaultRecordTypeOptions
+
 instance FromJSON ApiEpochInfo where
     parseJSON = genericParseJSON defaultRecordTypeOptions
 instance ToJSON ApiEpochInfo where

diff --git a/lib/core/src/Cardano/Wallet/Primitive/CoinSelection/MA/RoundRobin.hs b/lib/core/src/Cardano/Wallet/Primitive/CoinSelection/MA/RoundRobin.hs
@@ -62,7 +62,9 @@ module Cardano.Wallet.Primitive.CoinSelection.MA.RoundRobin
     , makeChangeForCoin
     , makeChangeForUserSpecifiedAsset
     , makeChangeForNonUserSpecifiedAsset
+    , makeChangeForNonUserSpecifiedAssets
     , assignCoinsToChangeMaps
+    , collateNonUserSpecifiedAssetQuantities
 
     -- * Splitting bundles
     , splitBundleIfAssetCountExcessive
@@ -1083,11 +1085,8 @@ makeChange criteria
     -- Change for non-user-specified assets: assets that were not present
     -- in the original set of user-specified outputs ('outputsToCover').
     changeForNonUserSpecifiedAssets :: NonEmpty TokenMap
-    changeForNonUserSpecifiedAssets = F.foldr
-        (NE.zipWith (<>)
-            . makeChangeForNonUserSpecifiedAsset outputMaps)
-        (TokenMap.empty <$ outputMaps)
-        nonUserSpecifiedAssets
+    changeForNonUserSpecifiedAssets = makeChangeForNonUserSpecifiedAssets
+        outputMaps nonUserSpecifiedAssetQuantities
 
     totalInputValueInsufficient = error
         "makeChange: not (totalOutputValue <= totalInputValue)"
@@ -1136,15 +1135,34 @@ makeChange criteria
     --
     -- Each asset is paired with the complete list of quantities of that asset
     -- present in the selected inputs.
-    nonUserSpecifiedAssets :: [(AssetId, NonEmpty TokenQuantity)]
-    nonUserSpecifiedAssets = Map.toList $
-        F.foldr discardUserSpecifiedAssets mempty inputBundles
+    nonUserSpecifiedAssetQuantities :: Map AssetId (NonEmpty TokenQuantity)
+    nonUserSpecifiedAssetQuantities =
+        collateNonUserSpecifiedAssetQuantities
+            (view #tokens <$> inputBundles) userSpecifiedAssetIds
 
+-- | Generates a map of all non-user-specified assets and their quantities.
+--
+-- Each key in the resulting map corresponds to an asset that was NOT included
+-- in the original set of user-specified outputs, but that was nevertheless
+-- selected during the selection process.
+--
+-- The value associated with each key corresponds to the complete list of all
+-- discrete non-zero quantities of that asset present in the selected inputs.
+--
+collateNonUserSpecifiedAssetQuantities
+    :: NonEmpty TokenMap
+      -- ^ Token maps of all selected inputs.
+    -> Set AssetId
+      -- ^ Set of all assets in user-specified outputs.
+    -> Map AssetId (NonEmpty TokenQuantity)
+collateNonUserSpecifiedAssetQuantities inputMaps userSpecifiedAssetIds =
+    F.foldr discardUserSpecifiedAssets mempty inputMaps
+  where
     discardUserSpecifiedAssets
-        :: TokenBundle
+        :: TokenMap
         -> Map AssetId (NonEmpty TokenQuantity)
         -> Map AssetId (NonEmpty TokenQuantity)
-    discardUserSpecifiedAssets (TokenBundle _ tokens) m =
+    discardUserSpecifiedAssets tokens m =
         foldr (\(k, v) -> Map.insertWith (<>) k (v :| [])) m filtered
       where
         filtered = filter
@@ -1309,15 +1327,34 @@ makeChangeForUserSpecifiedAsset targets (asset, excess) =
 -- with the `leq` function.
 --
 makeChangeForNonUserSpecifiedAsset
-    :: NonEmpty TokenMap
-        -- ^ A list of weights for the distribution. The list is only used for
-        -- its number of elements.
+    :: NonEmpty a
+        -- ^ Determines the number of change maps to create.
     -> (AssetId, NonEmpty TokenQuantity)
         -- ^ An asset quantity to distribute.
     -> NonEmpty TokenMap
+        -- ^ The resultant change maps.
 makeChangeForNonUserSpecifiedAsset n (asset, quantities) =
     TokenMap.singleton asset <$> padCoalesce quantities n
 
+-- | Constructs change outputs for all non-user-specified assets: assets that
+--   were not present in the original set of outputs.
+--
+-- The resultant list is sorted into ascending order when maps are compared
+-- with the `leq` function.
+--
+makeChangeForNonUserSpecifiedAssets
+    :: NonEmpty a
+        -- ^ Determines the number of change maps to create.
+    -> Map AssetId (NonEmpty TokenQuantity)
+        -- ^ A map of asset quantities to distribute.
+    -> NonEmpty TokenMap
+        -- ^ The resultant change maps.
+makeChangeForNonUserSpecifiedAssets n nonUserSpecifiedAssetQuantities =
+    F.foldr
+        (NE.zipWith (<>) . makeChangeForNonUserSpecifiedAsset n)
+        (TokenMap.empty <$ n)
+        (Map.toList nonUserSpecifiedAssetQuantities)
+
 -- | Constructs a list of ada change outputs based on the given distribution.
 --
 -- If the sum of weights in given distribution is equal to zero, this function