add roundtrip tests for stake address and show that withdrawals are r…

…eturned from the API
cardano-foundation · Jul 10, 2020 · 002e52f · 002e52f
1 parent fd55332
commit 002e52f
Show file tree

Hide file tree

Showing 3 changed files with 52 additions and 18 deletions.
diff --git a/lib/core-integration/src/Test/Integration/Scenario/API/Shelley/StakePools.hs b/lib/core-integration/src/Test/Integration/Scenario/API/Shelley/StakePools.hs
@@ -18,7 +18,6 @@ import Cardano.Wallet.Api.Types
     ( ApiStakePool
     , ApiT (..)
     , ApiTransaction
-    , ApiTxId (..)
     , ApiWallet
     , ApiWithdrawRewards (..)
     , DecodeAddress
@@ -192,9 +191,8 @@ spec = do
             (Link.createTransaction @'Shelley w)
             Default (Json payload)
         expectResponseCode HTTP.status202 r1
-        let txId1 = getFromResponse #id r1
         eventually "Wallet has not consumed rewards" $ do
-          let linkSrc = Link.getTransaction @'Shelley w (ApiTxId txId1)
+          let linkSrc = Link.getTransaction @'Shelley w (getFromResponse Prelude.id r1)
           request @(ApiTransaction n) ctx linkSrc Default Empty  >>= flip verify
               [ expectField (#status . #getApiT) (`shouldBe` InLedger)
               ]
@@ -203,12 +201,13 @@ spec = do
               ]
 
         -- can use rewards with special transaction query param (ApiWithdrawRewards True)
-        request @(ApiTransaction n) ctx
+        rTx <- request @(ApiTransaction n) ctx
             (Link.createTransaction' @'Shelley w (ApiWithdrawRewards True))
-            Default (Json payload) >>= flip verify
-                [ expectField #amount (.> (Quantity coin))
-                , expectField (#direction . #getApiT) (`shouldBe` Outgoing)
-                ]
+            Default (Json payload)
+        verify rTx
+            [ expectField #amount (.> (Quantity coin))
+            , expectField (#direction . #getApiT) (`shouldBe` Outgoing)
+            ]
 
         -- Rewards are have been consumed.
         eventually "Wallet has consumed rewards" $ do
@@ -217,6 +216,15 @@ spec = do
                 , expectField (#balance . #getApiT . #available) (.> previousBalance)
                 ]
 
+        eventually "There's at least one transaction with a withdrawal" $ do
+            rWithdrawal <- request @(ApiTransaction n) ctx
+                (Link.getTransaction @'Shelley w (getFromResponse Prelude.id rTx))
+                Default Empty
+            verify rWithdrawal
+                [ expectResponseCode HTTP.status200
+                , expectField #withdrawals (`shouldSatisfy` (not . null))
+                ]
+
         -- Quit delegation altogether.
         quitStakePool @n ctx (w, fixturePassphrase) >>= flip verify
             [ expectResponseCode HTTP.status202

diff --git a/lib/shelley/src/Cardano/Wallet/Shelley/Compatibility.hs b/lib/shelley/src/Cardano/Wallet/Shelley/Compatibility.hs
@@ -117,6 +117,8 @@ import Codec.Binary.Bech32
     ( dataPartFromBytes, dataPartToBytes )
 import Control.Applicative
     ( (<|>) )
+import Control.Arrow
+    ( left )
 import Control.Monad
     ( when )
 import Crypto.Hash.Utils
@@ -128,7 +130,7 @@ import Data.Binary.Get
 import Data.Binary.Put
     ( putByteString, putWord8, runPut )
 import Data.Bits
-    ( (.|.) )
+    ( (.&.), (.|.) )
 import Data.ByteArray.Encoding
     ( Base (Base16), convertFromBase )
 import Data.ByteString
@@ -845,6 +847,9 @@ instance DecodeStakeAddress ('Testnet pm) where
 stakeAddressPrefix :: Word8
 stakeAddressPrefix = 0xE0
 
+networkIdMask :: Word8
+networkIdMask = 0x0F
+
 toNetworkId :: SL.Network -> Word8
 toNetworkId = \case
     SL.Testnet -> 0
@@ -859,33 +864,38 @@ _encodeStakeAddress network (W.ChimericAccount acct) =
   where
     hrp = [Bech32.humanReadablePart|stake_addr|]
     bytes = BL.toStrict $ runPut $ do
-        putWord8 (toNetworkId network .|. stakeAddressPrefix)
+        putWord8 $ (networkIdMask .&. toNetworkId network) .|. stakeAddressPrefix
         putByteString acct
 
 _decodeStakeAddress
     :: SL.Network
     -> Text
     -> Either TextDecodingError W.ChimericAccount
 _decodeStakeAddress serverNetwork txt = do
-    rewardAcnt <- runGetOrFail' SL.getRewardAcnt (T.encodeUtf8 txt)
+    (_, dp) <- left (const errBech32) $ Bech32.decodeLenient txt
+    bytes <- maybe (Left errBech32) Right $ dataPartToBytes dp
+    rewardAcnt <- runGetOrFail' SL.getRewardAcnt bytes
 
     guardNetwork (SL.getRwdNetwork rewardAcnt) serverNetwork
 
     pure $ fromStakeCredential $ SL.getRwdCred rewardAcnt
   where
     runGetOrFail' decoder bytes =
         case runGetOrFail decoder (BL.fromStrict bytes) of
-            Left{} ->
-                Left msg
+            Left e ->
+                Left (TextDecodingError (show e))
 
             Right (remaining,_,_) | not (BL.null remaining) ->
-                Left msg
+                Left errDecode
 
             Right (_,_,a) ->
                 Right a
-      where
-        msg = TextDecodingError
-            "Unable to decode stake-address: not a well-formed address."
+
+    errDecode = TextDecodingError
+        "Unable to decode stake-address: not a well-formed address."
+
+    errBech32 = TextDecodingError
+        "Unable to decode stake-address: must be a valid bech32 string."
 
 instance EncodeAddress 'Mainnet where
     encodeAddress = _encodeAddress

diff --git a/lib/shelley/test/unit/Cardano/Wallet/Shelley/CompatibilitySpec.hs b/lib/shelley/test/unit/Cardano/Wallet/Shelley/CompatibilitySpec.hs
@@ -1,4 +1,5 @@
 {-# LANGUAGE DataKinds #-}
+{-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE FlexibleInstances #-}
 {-# LANGUAGE QuasiQuotes #-}
 {-# LANGUAGE ScopedTypeVariables #-}
@@ -26,7 +27,7 @@ import Cardano.Mnemonic
     , entropyToMnemonic
     )
 import Cardano.Wallet.Api.Types
-    ( DecodeAddress (..) )
+    ( DecodeAddress (..), DecodeStakeAddress (..), EncodeStakeAddress (..) )
 import Cardano.Wallet.Primitive.AddressDerivation
     ( Depth (..)
     , NetworkDiscriminant (..)
@@ -40,6 +41,7 @@ import Cardano.Wallet.Primitive.AddressDerivation.Shelley
     ( ShelleyKey (..) )
 import Cardano.Wallet.Primitive.Types
     ( Address (..)
+    , ChimericAccount (..)
     , DecentralizationLevel (..)
     , EpochLength (..)
     , Hash (..)
@@ -122,6 +124,17 @@ spec = do
             let toPoint' = toPoint gh epochLength
             toPoint' (fromTip' tip) === (getTipPoint tip)
 
+    describe "Shelley StakeAddress" $ do
+        prop "roundtrip / Mainnet" $ \x ->
+            (decodeStakeAddress @'Mainnet . encodeStakeAddress @'Mainnet) x
+            ===
+            Right x
+
+        prop "roundtrip / Testnet" $ \x ->
+            (decodeStakeAddress @('Testnet 0) . encodeStakeAddress @('Testnet 0)) x
+            ===
+            Right x
+
     describe "Shelley Addresses" $ do
         prop "(Mainnet) can be deserialised by shelley ledger spec" $ \k -> do
             let Address addr = paymentAddress @'Mainnet @ShelleyKey k
@@ -214,6 +227,9 @@ instance Arbitrary (Hash "Genesis") where
 instance Arbitrary (Hash "BlockHeader") where
     arbitrary = Hash . BS.pack <$> vector 32
 
+instance Arbitrary ChimericAccount where
+    arbitrary = ChimericAccount . BS.pack <$> vector 28
+
 instance Arbitrary (Tip ShelleyBlock) where
     arbitrary = frequency
         [ (10, return TipGenesis)