Skip to content

Commit

Permalink
Merge #2693 #2694
Browse files Browse the repository at this point in the history 
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.
-->


2694: Factor `getAccountBalance` into `getCachedAccountBalance` and `fetchAccountBalances` r=Anviking a=Anviking

# 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. -->

Split off from #2684 


# Overview

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

- [x] Rename `getAccountBalance` to `getCachedAccountBalance` for clarity
- [x] Add `fetchAccountBalances` function for un-cached behaviour
- [x] `fetchAccountBalances` from `listStakeKeys`  


# 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 <[email protected]>
Co-authored-by: Johannes Lund <[email protected]>
  • Loading branch information
@iohk-bors @paweljakubas @Anviking
3 people authored Jun 8, 2021
3 parents 518b4a4 + d66fa2e + d81089b commit db028e6
Show file tree
Hide file tree
Showing 13 changed files with 261 additions and 67 deletions.
36 changes: 35 additions & 1 deletion lib/core-integration/src/Test/Integration/Scenario/API/Shelley/Addresses.hs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down Expand Up @@ -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
Expand Down
46 changes: 26 additions & 20 deletions lib/core/src/Cardano/Wallet.hs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand All @@ -216,8 +218,7 @@ import Cardano.Wallet.DB
import Cardano.Wallet.Logging
( BracketLog, bracketTracer, traceWithExceptT, unliftIOTracer )
import Cardano.Wallet.Network
( ErrGetAccountBalance (..)
, ErrPostTx (..)
( ErrPostTx (..)
, FollowAction (..)
, FollowExceptionRecovery (..)
, FollowLog (..)
Expand Down Expand Up @@ -254,11 +255,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 (..)
Expand Down Expand Up @@ -1057,13 +1059,9 @@ queryRewardBalance
-> RewardAccount
-> ExceptT ErrFetchRewards IO Coin
queryRewardBalance ctx acct = do
mapExceptT (fmap handleErr) $ getAccountBalance nw acct
liftIO $ getCachedRewardAccountBalance nw acct
where
nw = ctx ^. networkLayer
handleErr = \case
Right x -> Right x
Left (ErrGetAccountBalanceAccountNotFound _) ->
Right $ Coin 0

manageRewardBalance
:: forall ctx s k (n :: NetworkDiscriminant).
Expand Down Expand Up @@ -1305,11 +1303,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)
Expand Down Expand Up @@ -2332,16 +2330,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
Expand All @@ -2351,7 +2354,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

Expand All @@ -2367,7 +2371,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
Expand Down Expand Up @@ -2466,8 +2470,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)
Expand Down
3 changes: 2 additions & 1 deletion lib/core/src/Cardano/Wallet/Api.hs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -173,6 +173,7 @@ import Cardano.Wallet.Api.Types
, ApiNetworkParameters
, ApiPoolId
, ApiPostAccountKeyData
, ApiPostAccountKeyDataWithPurpose
, ApiPostRandomAddressData
, ApiPutAddressesDataT
, ApiSelectCoinsDataT
Expand Down Expand Up @@ -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
Expand Down
42 changes: 19 additions & 23 deletions lib/core/src/Cardano/Wallet/Api/Server.hs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -207,7 +207,7 @@ import Cardano.Wallet.Api.Types
, ApiOurStakeKey (..)
, ApiPendingSharedWallet (..)
, ApiPoolId (..)
, ApiPostAccountKeyData (..)
, ApiPostAccountKeyDataWithPurpose (..)
, ApiPostRandomAddressData (..)
, ApiPutAddressesData (..)
, ApiRawMetadata (..)
Expand Down Expand Up @@ -273,7 +273,7 @@ import Cardano.Wallet.Compat
import Cardano.Wallet.DB
( DBFactory (..) )
import Cardano.Wallet.Network
( NetworkLayer, getAccountBalance, timeInterpreter )
( NetworkLayer, fetchRewardAccountBalances, timeInterpreter )
import Cardano.Wallet.Primitive.AddressDerivation
( DelegationAddress (..)
, Depth (..)
Expand Down Expand Up @@ -306,6 +306,7 @@ import Cardano.Wallet.Primitive.AddressDiscovery
( CompareDiscovery
, GenChange (ArgGenChange)
, GetAccount
, GetPurpose (..)
, IsOurs
, IsOwned
, KnownAddresses
Expand Down Expand Up @@ -2086,7 +2087,7 @@ listStakeKeys'
-- ^ The wallet's UTxO
-> (Address -> Maybe RewardAccount)
-- ^ Lookup reward account of addr
-> (Set RewardAccount -> m (Map RewardAccount (Maybe Coin)))
-> (Set RewardAccount -> m (Map RewardAccount Coin))
-- ^ Batch fetch of rewards
-> [(RewardAccount, Natural, ApiWalletDelegation)]
-- ^ The wallet's known stake keys, along with derivation index, and
Expand All @@ -2102,13 +2103,12 @@ listStakeKeys' utxo lookupStakeRef fetchRewards ourKeysWithInfo = do
let allKeys = ourKeys <> stakeKeysInUTxO

-- If we wanted to know whether a stake key is registered or not, we
-- could look at the difference between @Nothing@ and
-- @Just (Coin 0)@ from the response here, instead of hiding the
-- difference.
-- could expose the difference between `Nothing` and `Just 0` in the
-- `NetworkLayer` interface.
rewardsMap <- fetchRewards $ Set.fromList allKeys

let rewards acc = fromMaybe (Coin 0) $
join $ Map.lookup acc rewardsMap
Map.lookup acc rewardsMap

let mkOurs (acc, ix, deleg) = ApiOurStakeKey
{ _index = ix
Expand Down Expand Up @@ -2165,18 +2165,13 @@ listStakeKeys lookupStakeRef ctx (ApiT wid) = do
Just acc -> [(acc, 0, ourApiDelegation)]
Nothing -> []

let fetchRewards = flip lookupUsing rewardsOfAccount . Set.toList
liftIO $ listStakeKeys' @n utxo lookupStakeRef fetchRewards ourKeys

liftIO $ listStakeKeys' @n
utxo
lookupStakeRef
(fetchRewardAccountBalances nl)
ourKeys
where
lookupUsing
:: (Traversable t, Monad m, Ord a) => t a -> (a -> m b) -> m (Map a b)
lookupUsing xs f =
Map.fromList . F.toList <$> forM xs (\x -> f x >>= \x' -> pure (x,x') )

rewardsOfAccount :: forall m. MonadIO m => RewardAccount -> m (Maybe Coin)
rewardsOfAccount acc = fmap eitherToMaybe <$> liftIO . runExceptT $
getAccountBalance (ctx ^. networkLayer) acc
nl = ctx ^. networkLayer

{-------------------------------------------------------------------------------
Migrations
Expand Down Expand Up @@ -2481,18 +2476,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
Expand Down Expand Up @@ -3407,7 +3402,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
Expand Down
13 changes: 13 additions & 0 deletions lib/core/src/Cardano/Wallet/Api/Types.hs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -139,6 +139,7 @@ module Cardano.Wallet.Api.Types
, ApiAccountKeyShared (..)
, KeyFormat (..)
, ApiPostAccountKeyData (..)
, ApiPostAccountKeyDataWithPurpose (..)

-- * API Types (Byron)
, ApiByronWallet (..)
Expand Down Expand Up @@ -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
Expand Down Expand Up @@ -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
Expand Down
24 changes: 17 additions & 7 deletions lib/core/src/Cardano/Wallet/Network.hs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -28,7 +28,6 @@ module Cardano.Wallet.Network

-- * Errors
, ErrPostTx (..)
, ErrGetAccountBalance (..)

-- * Logging
, FollowLog (..)
Expand Down Expand Up @@ -84,8 +83,12 @@ import Data.Functor
( ($>) )
import Data.List.NonEmpty
( NonEmpty (..) )
import Data.Map
( Map )
import Data.Quantity
( Quantity (..) )
import Data.Set
( Set )
import Data.Text
( Text )
import Data.Text.Class
Expand Down Expand Up @@ -172,9 +175,20 @@ data NetworkLayer m block = NetworkLayer
:: Coin -- Stake to consider for rewards
-> m StakePoolsSummary

, getAccountBalance
, getCachedRewardAccountBalance
:: RewardAccount
-> ExceptT ErrGetAccountBalance m Coin
-> m Coin
-- ^ Return the cached reward balance of an account.
--
-- If there is no cached value, it will return `Coin 0`, and add the
-- account to the internal set of observed account, such that it will be
-- fetched later.

, fetchRewardAccountBalances
:: Set RewardAccount
-> m (Map RewardAccount Coin)
-- ^ Fetch the reward account balance of a set of accounts without
-- any caching.

, timeInterpreter
:: TimeInterpreter (ExceptT PastHorizonException m)
Expand Down Expand Up @@ -202,10 +216,6 @@ instance ToText ErrPostTx where
ErrPostTxBadRequest msg -> msg
ErrPostTxProtocolFailure msg -> msg

newtype ErrGetAccountBalance
= ErrGetAccountBalanceAccountNotFound RewardAccount
deriving (Generic, Eq, Show)

{-------------------------------------------------------------------------------
Initialization
-------------------------------------------------------------------------------}
Expand Down
Loading

0 comments on commit db028e6

Please sign in to comment.