Merge #2693

2693: Allow specifying purpose for acc x pub r=paweljakubas a=paweljakubas

# Issue Number

<!-- Put here a reference to the issue that this PR relates to and which requirements it tackles. Jira issues of the form ADP- will be auto-linked. -->
adp-950

# Overview

<!-- Detail in a few bullet points the work accomplished in this PR -->

- [x] updated swagger
- [x] enable passing purpose
- [x] adjust core unit tests
- [x] add integration test
- [x] guard purpose with integration test  


# Comments

<!-- Additional comments or screenshots to attach if any -->

<!--
Don't forget to:

 ✓ Self-review your changes to make sure nothing unexpected slipped through
 ✓ Assign yourself to the PR
 ✓ Assign one or several reviewer(s)
 ✓ Jira will detect and link to this PR once created, but you can also link this PR in the description of the corresponding ticket
 ✓ Acknowledge any changes required to the Wiki
 ✓ Finally, in the PR description delete any empty sections and all text commented in <!--, so that this text does not appear in merge commit messages.
-->


Co-authored-by: Pawel Jakubas <pawel.jakubas@iohk.io>

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

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)

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

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

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

lib/core/test/unit/Cardano/Wallet/Api/Malformed.hs

@@ -55,6 +55,7 @@ import Cardano.Wallet.Api.Types
     , ApiMaintenanceActionPostData
     , ApiPoolId
     , ApiPostAccountKeyData
+    , ApiPostAccountKeyDataWithPurpose
     , ApiPostRandomAddressData
     , ApiPutAddressesData
     , ApiSelectCoinsData
@@ -1127,6 +1128,48 @@ instance Malformed (BodyParam ApiPostAccountKeyData) where
               )
             ]
 
+instance Malformed (BodyParam ApiPostAccountKeyDataWithPurpose) where
+    malformed = jsonValid ++ jsonInvalid
+     where
+         jsonInvalid = first BodyParam <$>
+            [ ("1020344", "Error in $: parsing Cardano.Wallet.Api.Types.ApiPostAccountKeyDataWithPurpose(ApiPostAccountKeyDataWithPurpose) failed, expected Object, but encountered Number")
+            , ("\"1020344\"", "Error in $: parsing Cardano.Wallet.Api.Types.ApiPostAccountKeyDataWithPurpose(ApiPostAccountKeyDataWithPurpose) failed, expected Object, but encountered String")
+            , ("\"slot_number : \"random\"}", "trailing junk after valid JSON: endOfInput")
+            , ("{\"name : \"random\"}", msgJsonInvalid)
+            ]
+         jsonValid = first (BodyParam . Aeson.encode) <$>
+            [ ( [aesonQQ| { "passphrase": #{nameTooLong}, "format": "extended" }|]
+              , "Error in $.passphrase: passphrase is too long: expected at most 255 characters"
+              )
+            , ( [aesonQQ| { "passphrase": 123, "format": "extended" }|]
+              , "Error in $.passphrase: parsing Passphrase failed, expected String, but encountered Number"
+              )
+            , ( [aesonQQ| { "passphrase": [], "format": "extended" }|]
+              , "Error in $.passphrase: parsing Passphrase failed, expected String, but encountered Array"
+              )
+            , ( [aesonQQ| { "passphrase": 1.5, "format": "extended" }|]
+              , "Error in $.passphrase: parsing Passphrase failed, expected String, but encountered Number"
+              )
+            , ( [aesonQQ| { "format": "extended" }|]
+              , "Error in $: parsing Cardano.Wallet.Api.Types.ApiPostAccountKeyDataWithPurpose(ApiPostAccountKeyDataWithPurpose) failed, key 'passphrase' not found"
+              )
+            , ( [aesonQQ| { "passphrase": "The proper passphrase" }|]
+              , "Error in $: parsing Cardano.Wallet.Api.Types.ApiPostAccountKeyDataWithPurpose(ApiPostAccountKeyDataWithPurpose) failed, key 'format' not found"
+              )
+            , ( [aesonQQ| { "passphrase": "The proper passphrase", "format": 123 }|]
+              , "Error in $.format: parsing Cardano.Wallet.Api.Types.KeyFormat failed, expected String, but encountered Number"
+              )
+            , ( [aesonQQ| { "passphrase": "The proper passphrase", "format": [] }|]
+              , "Error in $.format: parsing Cardano.Wallet.Api.Types.KeyFormat failed, expected String, but encountered Array"
+              )
+            , ( [aesonQQ| { "passphrase": "The proper passphrase", "format": 1.5 }|]
+              , "Error in $.format: parsing Cardano.Wallet.Api.Types.KeyFormat failed, expected String, but encountered Number"
+              )
+            , ( [aesonQQ| { "passphrase": "The proper passphrase", "format": "ok" }|]
+              , "Error in $.format: parsing Cardano.Wallet.Api.Types.KeyFormat failed, expected one of the tags ['extended','non_extended'], but found tag 'ok'"
+              )
+            ]
+
 instance Malformed (BodyParam (ApiSelectCoinsData ('Testnet pm))) where
     malformed = jsonValid ++ jsonInvalid
      where

lib/core/test/unit/Cardano/Wallet/Api/TypesSpec.hs

@@ -92,6 +92,7 @@ import Cardano.Wallet.Api.Types
     , ApiOurStakeKey
     , ApiPendingSharedWallet (..)
     , ApiPostAccountKeyData
+    , ApiPostAccountKeyDataWithPurpose
     , ApiPostRandomAddressData
     , ApiPutAddressesData (..)
     , ApiRawMetadata (..)
@@ -401,6 +402,7 @@ spec = parallel $ do
             jsonRoundtripAndGolden $ Proxy @ApiAddressData
             jsonRoundtripAndGolden $ Proxy @(ApiT DerivationIndex)
             jsonRoundtripAndGolden $ Proxy @ApiPostAccountKeyData
+            jsonRoundtripAndGolden $ Proxy @ApiPostAccountKeyDataWithPurpose
             jsonRoundtripAndGolden $ Proxy @ApiAccountKey
             jsonRoundtripAndGolden $ Proxy @ApiAccountKeyShared
             jsonRoundtripAndGolden $ Proxy @ApiEpochInfo
@@ -2051,6 +2053,10 @@ instance Arbitrary ApiPostAccountKeyData where
     arbitrary = genericArbitrary
     shrink = genericShrink
 
+instance Arbitrary ApiPostAccountKeyDataWithPurpose where
+    arbitrary = genericArbitrary
+    shrink = genericShrink
+
 instance Arbitrary TokenFingerprint where
     arbitrary = do
         AssetId policy aName <- genAssetIdSmallRange
@@ -2380,6 +2386,9 @@ instance ToSchema ApiWalletSignData where
 instance ToSchema ApiPostAccountKeyData where
     declareNamedSchema _ = declareSchemaForDefinition "ApiPostAccountKeyData"
 
+instance ToSchema ApiPostAccountKeyDataWithPurpose where
+    declareNamedSchema _ = declareSchemaForDefinition "ApiPostAccountKeyDataWithPurpose"
+
 instance ToSchema ApiAccountKey where
     declareNamedSchema _ = declareSchemaForDefinition "ApiAccountKey"