Merge #3925 #3970

3925: Withdrawals in multisig r=paweljakubas a=paweljakubas

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

Before you submit, don't forget to:

* Make sure the GitHub PR fields are correct:
   ✓ Set a good Title for your PR.
   ✓ Assign yourself to the PR.
   ✓ Assign one or more reviewer(s).
   ✓ Link to a Jira issue, and/or other GitHub issues or PRs.
   ✓ In the PR description delete any empty sections
     and all text commented in <!--, so that this text does not appear
     in merge commit messages.

* Don't waste reviewers' time:
   ✓ If it's a draft, select the Create Draft PR option.
   ✓ Self-review your changes to make sure nothing unexpected slipped through.

* Try to make your intent clear:
   ✓ Write a good Description that explains what this PR is meant to do.
   ✓ Jira will detect and link to this PR once created, but you can also
     link this PR in the description of the corresponding Jira ticket.
   ✓ Highlight what Testing you have done.
   ✓ Acknowledge any changes required to the Documentation.
-->


-  [x] Added withdrawal support for multisig
-  [x] Added withdrawal integration test
-  [x] Added quit integration test
-  [x] Make sure getTransaction exposes certificates - shown in integration testing

### Comments

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

### Issue Number
adp-2604
<!-- Reference the Jira/GitHub issue that this PR relates to, and which requirements it tackles.
  Note: Jira issues of the form ADP- will be auto-linked. -->


3970: Derive arithmetic operations for `{Coin,TokenQuantity}`. r=jonathanknowles a=jonathanknowles

## Summary

This PR uses classes defined by the [`monoid-subclasses`](https://hackage.haskell.org/package/monoid-subclasses-1.2.3#readme) library to derive the definitions of all arithmetic operations for the `Coin` and `TokenQuantity` types.

This takes advantage of the fact that both `Coin` and `TokenQuantity` have `Semigroup` and `Monoid` instances that are identical to those for `Sum Natural`.

Co-authored-by: Pawel Jakubas <pawel.jakubas@iohk.io>
Co-authored-by: Piotr Stachyra <piotr.stachyra@iohk.io>
Co-authored-by: Jonathan Knowles <jonathan.knowles@iohk.io>

lib/primitive/cardano-wallet-primitive.cabal

@@ -50,6 +50,7 @@ library
     , cardano-numeric
     , cardano-wallet-test-utils
     , cborg
+    , commutative-semigroups
     , containers
     , cryptonite
     , delta-types
@@ -64,6 +65,7 @@ library
     , lattices
     , memory
     , MonadRandom
+    , monoid-subclasses
     , network-uri
     , nothunks
     , OddWord

lib/primitive/lib/Cardano/Wallet/Primitive/Types/Coin.hs

@@ -63,8 +63,20 @@ import Data.List.NonEmpty
     ( NonEmpty (..) )
 import Data.Maybe
     ( fromMaybe )
+import Data.Monoid
+    ( Sum (..) )
+import Data.Monoid.Cancellative
+    ( LeftReductive, Reductive ((</>)), RightReductive )
+import Data.Monoid.GCD
+    ( GCDMonoid, LeftGCDMonoid, RightGCDMonoid )
+import Data.Monoid.Monus
+    ( Monus ((<\>)), OverlappingGCDMonoid )
+import Data.Monoid.Null
+    ( MonoidNull )
 import Data.Quantity
     ( Quantity (..) )
+import Data.Semigroup.Commutative
+    ( Commutative )
 import Data.Text.Class
     ( FromText (..), ToText (..) )
 import Data.Word
@@ -94,16 +106,11 @@ newtype Coin = Coin
     { unCoin :: Natural
     }
     deriving stock (Ord, Eq, Generic)
-    deriving (Read, Show) via (Quiet Coin)
-
--- | The 'Semigroup' instance for 'Coin' corresponds to ordinary addition.
---
-instance Semigroup Coin where
-    -- Natural doesn't have a default Semigroup instance.
-    (<>) = add
-
-instance Monoid Coin where
-    mempty = Coin 0
+    deriving (Read, Show) via Quiet Coin
+    deriving (Commutative, Semigroup, Monoid, MonoidNull) via Sum Natural
+    deriving (LeftReductive, RightReductive, Reductive) via Sum Natural
+    deriving (LeftGCDMonoid, RightGCDMonoid, GCDMonoid) via Sum Natural
+    deriving (OverlappingGCDMonoid, Monus) via Sum Natural
 
 instance ToText Coin where
     toText (Coin c) = T.pack $ show c
@@ -252,25 +259,23 @@ unsafeToWord64 c = fromMaybe onError (toWord64Maybe c)
 -- Returns 'Nothing' if the second coin is strictly greater than the first.
 --
 subtract :: Coin -> Coin -> Maybe Coin
-subtract (Coin a) (Coin b)
-    | a >= b    = Just $ Coin (a - b)
-    | otherwise = Nothing
+subtract = (</>)
 
 -- | Calculates the combined value of two coins.
 --
 add :: Coin -> Coin -> Coin
-add (Coin a) (Coin b) = Coin (a + b)
+add = (<>)
 
 -- | Subtracts the second coin from the first.
 --
 -- Returns 'Coin 0' if the second coin is strictly greater than the first.
 --
 difference :: Coin -> Coin -> Coin
-difference a b = fromMaybe (Coin 0) (subtract a b)
+difference = (<\>)
 
 -- | Absolute difference between two coin amounts. The result is never negative.
 distance :: Coin -> Coin -> Coin
-distance (Coin a) (Coin b) = if a < b then Coin (b - a) else Coin (a - b)
+distance a b = (a <\> b) <> (b <\> a)
 
 --------------------------------------------------------------------------------
 -- Partitioning

lib/primitive/lib/Cardano/Wallet/Primitive/Types/TokenQuantity.hs

@@ -40,18 +40,26 @@ import Cardano.Numeric.Util
     ( equipartitionNatural, partitionNatural )
 import Control.DeepSeq
     ( NFData (..) )
-import Control.Monad
-    ( guard )
 import Data.Aeson
     ( FromJSON (..), ToJSON (..) )
-import Data.Functor
-    ( ($>) )
 import Data.Hashable
     ( Hashable )
 import Data.List.NonEmpty
     ( NonEmpty (..) )
 import Data.Maybe
     ( fromMaybe )
+import Data.Monoid
+    ( Sum (..) )
+import Data.Monoid.Cancellative
+    ( LeftReductive, Reductive ((</>)), RightReductive )
+import Data.Monoid.GCD
+    ( GCDMonoid, LeftGCDMonoid, RightGCDMonoid )
+import Data.Monoid.Monus
+    ( Monus ((<\>)), OverlappingGCDMonoid )
+import Data.Monoid.Null
+    ( MonoidNull )
+import Data.Semigroup.Commutative
+    ( Commutative )
 import Data.Text.Class
     ( FromText (..), ToText (..) )
 import Fmt
@@ -79,19 +87,17 @@ import Quiet
 newtype TokenQuantity = TokenQuantity
     { unTokenQuantity :: Natural }
     deriving stock (Eq, Ord, Generic)
-    deriving (Read, Show) via (Quiet TokenQuantity)
     deriving anyclass (NFData, Hashable)
+    deriving (Read, Show) via Quiet TokenQuantity
+    deriving (Commutative, Semigroup, Monoid, MonoidNull) via Sum Natural
+    deriving (LeftReductive, RightReductive, Reductive) via Sum Natural
+    deriving (LeftGCDMonoid, RightGCDMonoid, GCDMonoid) via Sum Natural
+    deriving (OverlappingGCDMonoid, Monus) via Sum Natural
 
 --------------------------------------------------------------------------------
 -- Instances
 --------------------------------------------------------------------------------
 
-instance Semigroup TokenQuantity where
-    (<>) = add
-
-instance Monoid TokenQuantity where
-    mempty = zero
-
 instance Buildable TokenQuantity where
     build = build . toText . unTokenQuantity
 
@@ -118,14 +124,14 @@ zero = TokenQuantity 0
 --------------------------------------------------------------------------------
 
 add :: TokenQuantity -> TokenQuantity -> TokenQuantity
-add (TokenQuantity x) (TokenQuantity y) = TokenQuantity $ x + y
+add = (<>)
 
 -- | Subtracts the second token quantity from the first.
 --
 -- Returns 'Nothing' if the first quantity is less than the second quantity.
 --
 subtract :: TokenQuantity -> TokenQuantity -> Maybe TokenQuantity
-subtract x y = guard (x >= y) $> unsafeSubtract x y
+subtract = (</>)
 
 -- | Finds the predecessor of a given token quantity.
 --
@@ -155,7 +161,7 @@ succ = (`add` TokenQuantity 1)
 -- Returns 'zero' if the first quantity is less than the second quantity.
 --
 difference :: TokenQuantity -> TokenQuantity -> TokenQuantity
-difference x y = fromMaybe zero $ subtract x y
+difference = (<\>)
 
 --------------------------------------------------------------------------------
 -- Partitioning

lib/wallet/api/http/Cardano/Wallet/Api/Http/Server/Error.hs

@@ -715,11 +715,22 @@ instance IsServerError ErrFetchRewards where
 instance IsServerError ErrReadRewardAccount where
     toServerError = \case
         ErrReadRewardAccountNotAShelleyWallet ->
-            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."
+            apiError err403 InvalidWalletType $ mconcat errMsg
+        ErrReadRewardAccountNotASharedWallet ->
+            apiError err403 InvalidWalletType $ mconcat errMsg
+        ErrReadRewardAccountMissing ->
+            apiError err501 MissingRewardAccount $ mconcat
+                [ "Unable to read the reward account required for withdrawals. "
+                , "It appears that the withdrawals feature was utilized for a "
+                , "shared wallet without the corresponding delegation template."
                 ]
+      where
+        errMsg =
+            [ "It is regrettable but you've just attempted an operation "
+            , "that is invalid for this type of wallet. Only new 'Shelley' and "
+            , "'Shared' wallets have the capability to perform actions with rewards, "
+            , "which is not applicable to the current wallet."
+            ]
 
 instance IsServerError ErrReadPolicyPublicKey where
     toServerError = \case