actually get rid of 'HasRewardAccount' type-class altogether

This type class only existed in order to be able to get a reward account from a sequential state to assess whether an account was ours or not. We had to defined an unsound 'HasRewardAccount' on 'IcarusKey' because of that and carry this instance in many places in the API. Instead, we can simply carry a 'IsOurs _ ChimericAccount' constraints up to API instantiation.
cardano-foundation · Jul 30, 2020 · 04c96ea · 04c96ea
1 parent 7a71a7e
commit 04c96ea
Show file tree

Hide file tree

Showing 8 changed files with 66 additions and 52 deletions.
diff --git a/lib/core/src/Cardano/Wallet.hs b/lib/core/src/Cardano/Wallet.hs
@@ -229,7 +229,6 @@ import Cardano.Wallet.Primitive.AddressDerivation.Shelley
 import Cardano.Wallet.Primitive.AddressDiscovery
     ( CompareDiscovery (..)
     , GenChange (..)
-    , HasRewardAccount (..)
     , IsOurs (..)
     , IsOwned (..)
     , KnownAddresses (..)
@@ -955,15 +954,15 @@ readChimericAccount
     -> WalletId
     -> ExceptT ErrReadChimericAccount IO ChimericAccount
 readChimericAccount ctx wid = db & \DBLayer{..} -> do
-    cp <- withExceptT ErrReadChimericNoSuchWallet
+    cp <- withExceptT ErrReadChimericAccountNoSuchWallet
         $ mapExceptT atomically
         $ withNoSuchWallet wid
         $ readCheckpoint (PrimaryKey wid)
     case testEquality (typeRep @s) (typeRep @shelley) of
         Nothing -> throwE ErrReadChimericAccountNotAShelleyWallet
         Just Refl -> pure
             $ toChimericAccount
-            $ rewardAccountKey @shelley @ShelleyKey
+            $ Seq.rewardAccountKey
             $ getState cp
   where
     db = ctx ^. dbLayer @s @k
@@ -1161,14 +1160,14 @@ importRandomAddresses ctx wid addrs = db & \DBLayer{..} -> mapExceptT atomically
 normalizeDelegationAddress
     :: forall s k n.
         ( DelegationAddress n k
-        , HasRewardAccount s k
+        , s ~ SeqState n k
         )
     => s
     -> Address
     -> Maybe Address
 normalizeDelegationAddress s addr = do
     fingerprint <- eitherToMaybe (paymentKeyFingerprint addr)
-    pure $ liftDelegationAddress @n fingerprint (rewardAccountKey @s @k s)
+    pure $ liftDelegationAddress @n fingerprint $ Seq.rewardAccountKey s
 
 {-------------------------------------------------------------------------------
                                   Transaction
@@ -2282,7 +2281,7 @@ data ErrNotASequentialWallet
 
 data ErrReadChimericAccount
     = ErrReadChimericAccountNotAShelleyWallet
-    | ErrReadChimericNoSuchWallet ErrNoSuchWallet
+    | ErrReadChimericAccountNoSuchWallet ErrNoSuchWallet
     deriving (Generic, Eq, Show)
 
 {-------------------------------------------------------------------------------

diff --git a/lib/core/src/Cardano/Wallet/Api/Server.hs b/lib/core/src/Cardano/Wallet/Api/Server.hs
@@ -116,6 +116,7 @@ import Cardano.Wallet
     , ErrNotASequentialWallet (..)
     , ErrPostTx (..)
     , ErrQuitStakePool (..)
+    , ErrReadChimericAccount (..)
     , ErrRemovePendingTx (..)
     , ErrSelectCoinsExternal (..)
     , ErrSelectForDelegation (..)
@@ -224,6 +225,7 @@ import Cardano.Wallet.Primitive.AddressDerivation
     , Passphrase (..)
     , PaymentAddress (..)
     , SoftDerivation (..)
+    , ToChimericAccount (..)
     , WalletKey (..)
     , deriveRewardAccount
     , digest
@@ -234,10 +236,11 @@ import Cardano.Wallet.Primitive.AddressDerivation.Byron
     ( ByronKey, mkByronKeyFromMasterKey )
 import Cardano.Wallet.Primitive.AddressDerivation.Icarus
     ( IcarusKey )
+import Cardano.Wallet.Primitive.AddressDerivation.Shelley
+    ( ShelleyKey )
 import Cardano.Wallet.Primitive.AddressDiscovery
     ( CompareDiscovery
     , GenChange (ArgGenChange)
-    , HasRewardAccount
     , IsOurs
     , IsOwned
     , KnownAddresses
@@ -410,6 +413,8 @@ import System.IO.Error
     )
 import System.Random
     ( getStdRandom, random )
+import Type.Reflection
+    ( Typeable )
 
 import qualified Cardano.Wallet as W
 import qualified Cardano.Wallet.Api.Types as Api
@@ -548,11 +553,13 @@ postWallet
         , SoftDerivation k
         , MkKeyFingerprint k (Proxy n, k 'AddressK XPub)
         , MkKeyFingerprint k Address
-        , HasRewardAccount s k
         , WalletKey k
         , Bounded (Index (AddressIndexDerivationType k) 'AddressK)
         , HasDBFactory s k ctx
         , HasWorkerRegistry s k ctx
+        , IsOurs s ChimericAccount
+        , Typeable s
+        , Typeable n
         )
     => ctx
     -> ((SomeMnemonic, Maybe SomeMnemonic) -> Passphrase "encryption" -> k 'RootK XPrv)
@@ -563,7 +570,8 @@ postWallet ctx generateKey liftKey (WalletOrAccountPostData body) = case body of
     Left  body' ->
         postShelleyWallet ctx generateKey body'
     Right body' ->
-        postAccountWallet ctx mkShelleyWallet liftKey W.manageRewardBalance body'
+        postAccountWallet ctx mkShelleyWallet liftKey
+            (W.manageRewardBalance @_ @_ @_ @_ @n) body'
 
 postShelleyWallet
     :: forall ctx s t k n.
@@ -576,7 +584,9 @@ postShelleyWallet
         , Bounded (Index (AddressIndexDerivationType k) 'AddressK)
         , HasDBFactory s k ctx
         , HasWorkerRegistry s k ctx
-        , HasRewardAccount s k
+        , IsOurs s ChimericAccount
+        , Typeable s
+        , Typeable n
         )
     => ctx
     -> ((SomeMnemonic, Maybe SomeMnemonic) -> Passphrase "encryption" -> k 'RootK XPrv)
@@ -587,7 +597,7 @@ postShelleyWallet ctx generateKey body = do
     void $ liftHandler $ initWorker @_ @s @k ctx wid
         (\wrk -> W.createWallet  @(WorkerCtx ctx) @s @k wrk wid wName state)
         (\wrk -> W.restoreWallet @(WorkerCtx ctx) @s @t @k wrk wid)
-        (\wrk -> W.manageRewardBalance @(WorkerCtx ctx) @s @t @k wrk wid)
+        (\wrk -> W.manageRewardBalance @(WorkerCtx ctx) @s @t @k @n wrk wid)
     withWorkerCtx @_ @s @k ctx wid liftE liftE $ \wrk -> liftHandler $
         W.attachPrivateKeyFromPwd @_ @s @k wrk wid (rootXPrv, pwd)
     fst <$> getWallet ctx (mkShelleyWallet @_ @s @t @k) (ApiT wid)
@@ -608,8 +618,8 @@ postAccountWallet
         , MkKeyFingerprint k (Proxy n, k 'AddressK XPub)
         , MkKeyFingerprint k Address
         , WalletKey k
-        , HasRewardAccount s k
         , HasWorkerRegistry s k ctx
+        , IsOurs s ChimericAccount
         )
     => ctx
     -> MkApiWallet ctx s w
@@ -1200,8 +1210,9 @@ postTransaction
         , ctx ~ ApiLayer s t k
         , HardDerivation k
         , Bounded (Index (AddressIndexDerivationType k) 'AddressK)
-        , HasRewardAccount s k
         , WalletKey k
+        , Typeable s
+        , Typeable n
         )
     => ctx
     -> ArgGenChange s
@@ -1213,7 +1224,7 @@ postTransaction ctx genChange (ApiT wid) withdrawRewards = \case
     PostPaymentOrWithdrawalData (Left body) -> do
         let pwd = coerce $ getApiT $ body ^. #passphrase
         let src = getApiMnemonicT $ body ^. #source
-        let (xprv, acct) = W.someChimericAccount src
+        let (xprv, acct) = W.someChimericAccount @ShelleyKey src
 
         selection <- withWorkerCtx ctx wid liftE liftE $ \wrk -> do
             withdrawal <- if withdrawRewards
@@ -1253,7 +1264,7 @@ postTransaction ctx genChange (ApiT wid) withdrawRewards = \case
         selection <- withWorkerCtx ctx wid liftE liftE $ \wrk -> do
             withdrawal <- if withdrawRewards
                 then do
-                    acct <- liftHandler $ W.readChimericAccount @_ @s @k wrk wid
+                    acct <- liftHandler $ W.readChimericAccount @_ @s @k @n wrk wid
                     raw <- liftHandler $ W.queryRewardBalance @_ @t wrk acct
                     liftIO $ W.readNextWithdrawal @_ @s @t @k wrk wid raw
                 else pure (Quantity 0)
@@ -1355,8 +1366,9 @@ apiFee (FeeEstimation estMin estMax) = ApiFee (qty estMin) (qty estMax)
 postTransactionFee
     :: forall ctx s t k n.
         ( Buildable (ErrValidateSelection t)
-        , HasRewardAccount s k
         , ctx ~ ApiLayer s t k
+        , Typeable s
+        , Typeable n
         )
     => ctx
     -> ApiT WalletId
@@ -1372,7 +1384,7 @@ postTransactionFee ctx (ApiT wid) withdrawRewards = \case
         withWorkerCtx ctx wid liftE liftE $ \wrk -> do
             withdrawal <- if withdrawRewards
                 then do
-                    acct <- liftHandler $ W.readChimericAccount @_ @s @k wrk wid
+                    acct <- liftHandler $ W.readChimericAccount @_ @s @k @n wrk wid
                     raw <- liftHandler $ W.queryRewardBalance @_ @t wrk acct
                     liftIO $ W.readNextWithdrawal @_ @s @t @k wrk wid raw
                 else pure $ Quantity 0
@@ -2391,9 +2403,19 @@ instance LiftHandler ErrJoinStakePool where
 
 instance LiftHandler ErrFetchRewards where
     handler = \case
-        ErrFetchRewardsNoSuchWallet e -> handler e
+        ErrFetchRewardsReadChimericAccount e -> handler e
         ErrFetchRewardsNetworkUnreachable e -> handler e
 
+instance LiftHandler ErrReadChimericAccount where
+    handler = \case
+        ErrReadChimericAccountNoSuchWallet e -> handler e
+        ErrReadChimericAccountNotAShelleyWallet ->
+            apiError err403 InvalidWalletType $ mconcat
+                [ "It is regrettable but you've just attempted an operation "
+                , "that is invalid for this type of wallet. Only new 'Shelley' "
+                , "wallets can do something with rewards and this one isn't."
+                ]
+
 instance LiftHandler ErrQuitStakePool where
     handler = \case
         ErrQuitStakePoolNoSuchWallet e -> handler e

diff --git a/lib/core/src/Cardano/Wallet/Primitive/AddressDerivation/Icarus.hs b/lib/core/src/Cardano/Wallet/Primitive/AddressDerivation/Icarus.hs
@@ -414,7 +414,7 @@ instance PaymentAddress n IcarusKey
       where
         err = ErrInvalidAddress (proxy, k) Proxy
 
-instance {-# OVERLAPS #-} IsOurs (SeqState n IcarusKey) ChimericAccount where
+instance IsOurs (SeqState n IcarusKey) ChimericAccount where
     isOurs _account state = (False, state)
 
 {-------------------------------------------------------------------------------

diff --git a/lib/core/src/Cardano/Wallet/Primitive/AddressDerivation/Jormungandr.hs b/lib/core/src/Cardano/Wallet/Primitive/AddressDerivation/Jormungandr.hs
@@ -80,9 +80,9 @@ import Cardano.Wallet.Primitive.AddressDerivation
     , networkDiscriminantVal
     )
 import Cardano.Wallet.Primitive.AddressDiscovery
-    ( HasRewardAccount (..) )
-import Cardano.Wallet.Primitive.AddressDiscovery.Sequential as Seq
-    ( SeqState )
+    ( IsOurs (..) )
+import Cardano.Wallet.Primitive.AddressDiscovery.Sequential
+    ( SeqState, rewardAccountKey )
 import Cardano.Wallet.Primitive.Types
     ( Address (..), Hash (..), invariant )
 import Control.DeepSeq
@@ -108,7 +108,6 @@ import GHC.Generics
 import GHC.Stack
     ( HasCallStack )
 
-import qualified Cardano.Wallet.Primitive.AddressDiscovery.Sequential as Seq
 import qualified Data.ByteArray as BA
 import qualified Data.ByteString as BS
 import qualified Data.ByteString.Lazy as BL
@@ -435,8 +434,12 @@ instance MkKeyFingerprint JormungandrKey (Proxy (n :: NetworkDiscriminant), Jorm
                           Dealing with Rewards
 -------------------------------------------------------------------------------}
 
-instance forall n. HasRewardAccount (SeqState n JormungandrKey) JormungandrKey where
-    rewardAccountKey  = Seq.rewardAccountKey
+instance IsOurs (SeqState n JormungandrKey) ChimericAccount
+  where
+    isOurs account state =
+        (account == ourAccount, state)
+      where
+        ourAccount = toChimericAccount $ rewardAccountKey state
 
 instance ToChimericAccount JormungandrKey where
     toChimericAccount = ChimericAccount . xpubPublicKey . getKey

diff --git a/lib/core/src/Cardano/Wallet/Primitive/AddressDerivation/Shelley.hs b/lib/core/src/Cardano/Wallet/Primitive/AddressDerivation/Shelley.hs
@@ -76,9 +76,9 @@ import Cardano.Wallet.Primitive.AddressDerivation
     , hex
     )
 import Cardano.Wallet.Primitive.AddressDiscovery
-    ( HasRewardAccount (..) )
+    ( IsOurs (..) )
 import Cardano.Wallet.Primitive.AddressDiscovery.Sequential
-    ( SeqState )
+    ( SeqState, rewardAccountKey )
 import Cardano.Wallet.Primitive.Types
     ( Address (..), Hash (..), invariant )
 import Control.DeepSeq
@@ -108,7 +108,6 @@ import Data.Word
 import GHC.Generics
     ( Generic )
 
-import qualified Cardano.Wallet.Primitive.AddressDiscovery.Sequential as Seq
 import qualified Data.ByteArray as BA
 import qualified Data.ByteString as BS
 import qualified Data.ByteString.Lazy as BL
@@ -349,8 +348,12 @@ instance MkKeyFingerprint ShelleyKey (Proxy (n :: NetworkDiscriminant), ShelleyK
                           Dealing with Rewards
 -------------------------------------------------------------------------------}
 
-instance forall n. HasRewardAccount (SeqState n ShelleyKey) ShelleyKey where
-    rewardAccountKey  = Seq.rewardAccountKey
+instance IsOurs (SeqState n ShelleyKey) ChimericAccount
+  where
+    isOurs account state =
+        (account == ourAccount, state)
+      where
+        ourAccount = toChimericAccount $ rewardAccountKey state
 
 instance ToChimericAccount ShelleyKey where
     toChimericAccount = toChimericAccountRaw . getKey

diff --git a/lib/core/src/Cardano/Wallet/Primitive/AddressDiscovery.hs b/lib/core/src/Cardano/Wallet/Primitive/AddressDiscovery.hs
@@ -25,15 +25,14 @@ module Cardano.Wallet.Primitive.AddressDiscovery
     , GenChange(..)
     , CompareDiscovery(..)
     , KnownAddresses(..)
-    , HasRewardAccount(..)
     ) where
 
 import Prelude
 
 import Cardano.Crypto.Wallet
-    ( XPrv, XPub )
+    ( XPrv )
 import Cardano.Wallet.Primitive.AddressDerivation
-    ( Depth (..), Passphrase (..), ToChimericAccount (..) )
+    ( Depth (..), Passphrase (..) )
 import Cardano.Wallet.Primitive.Types
     ( Address (..) )
 
@@ -127,11 +126,3 @@ class KnownAddresses s where
     knownAddresses
         :: s
         -> [Address]
-
--- | Interface for getting access to a wallet's reward account. Every wallet is
--- assumed to have a single account on a specific location.
---
--- Each account key can also be encoded to a 'ChimericAccount' (also called
--- reward address in cardano-node).
-class ToChimericAccount k => HasRewardAccount s k where
-    rewardAccountKey  :: s -> k 'AddressK XPub
diff --git a/lib/core/src/Cardano/Wallet/Primitive/AddressDiscovery/Sequential.hs b/lib/core/src/Cardano/Wallet/Primitive/AddressDiscovery/Sequential.hs
@@ -64,7 +64,6 @@ import Cardano.Crypto.Wallet
     ( XPrv, XPub )
 import Cardano.Wallet.Primitive.AddressDerivation
     ( AccountingStyle (..)
-    , ChimericAccount (..)
     , Depth (..)
     , DerivationType (..)
     , HardDerivation (..)
@@ -76,7 +75,6 @@ import Cardano.Wallet.Primitive.AddressDerivation
     , PaymentAddress (..)
     , PersistPublicKey (..)
     , SoftDerivation (..)
-    , ToChimericAccount (..)
     , WalletKey (..)
     , deriveRewardAccount
     )
@@ -616,13 +614,6 @@ instance
         in
             (ixs' `deepseq` ours `deepseq` ours, SeqState s1' s2' ixs' rpk)
 
-instance (ToChimericAccount k) => IsOurs (SeqState n k) ChimericAccount
-  where
-    isOurs account state =
-        (account == ourAccount, state)
-      where
-        ourAccount = toChimericAccount @k $ rewardAccountKey state
-
 instance
     ( SoftDerivation k
     ) => GenChange (SeqState n k) where

diff --git a/lib/shelley/src/Cardano/Wallet/Shelley/Api/Server.hs b/lib/shelley/src/Cardano/Wallet/Shelley/Api/Server.hs
@@ -91,6 +91,8 @@ import Cardano.Wallet.Api.Types
     ( ApiErrorCode (..)
     , ApiStakePool
     , ApiT (..)
+    , PostPaymentOrWithdrawalData (..)
+    , PostPaymentOrWithdrawalFeeData (..)
     , SomeByronWalletPostData (..)
     )
 import Cardano.Wallet.Primitive.AddressDerivation
@@ -272,6 +274,7 @@ server byron icarus shelley spl ntp =
                     let pwd = coerce (getApiT $ tx ^. #passphrase)
                     genChange <- rndStateChange byron wid pwd
                     postTransaction byron genChange wid False tx
+
                  )
                  (icarus, do
                     let genChange k _ = paymentAddress @n k
@@ -285,8 +288,8 @@ server byron icarus shelley spl ntp =
              )
         :<|>
             (\wid tx -> withLegacyLayer wid
-                (byron , postTransactionFee byron wid False tx)
-                (icarus, postTransactionFee icarus wid False tx)
+                (byron , postTransactionFee byron wid False (byronFee tx))
+                (icarus, postTransactionFee icarus wid False (byronFee tx))
             )
         :<|> (\wid txid -> withLegacyLayer wid
                 (byron , deleteTransaction byron wid txid)
@@ -296,6 +299,8 @@ server byron icarus shelley spl ntp =
                 (byron , getTransaction byron wid txid)
                 (icarus, getTransaction icarus wid txid)
              )
+      where
+        byronFee = PostPaymentOrWithdrawalFeeData . Right
 
     byronMigrations :: Server (ByronMigrations n)
     byronMigrations =