extend API and specifications to include the 'signMetadata' operation

lib/core/src/Cardano/Wallet/Api.hs

@@ -28,6 +28,7 @@ module Cardano.Wallet.Api
         , PutWallet
         , PutWalletPassphrase
         , GetUTxOsStatistics
+        , SignMetadata
 
     , Addresses
         , ListAddresses
@@ -132,6 +133,7 @@ import Cardano.Wallet.Api.Types
     , ApiWalletMigrationInfo
     , ApiWalletMigrationPostDataT
     , ApiWalletPassphrase
+    , ApiWalletSignData
     , ByronWalletPutPassphraseData
     , Iso8601Time
     , MinWithdrawal
@@ -149,7 +151,7 @@ import Cardano.Wallet.DB
 import Cardano.Wallet.Network
     ( NetworkLayer )
 import Cardano.Wallet.Primitive.AddressDerivation
-    ( Depth )
+    ( AccountingStyle, Depth, DerivationIndex )
 import Cardano.Wallet.Primitive.SyncProgress
     ( SyncTolerance )
 import Cardano.Wallet.Primitive.Types
@@ -166,6 +168,8 @@ import Cardano.Wallet.Transaction
     ( TransactionLayer )
 import Control.Tracer
     ( Tracer, contramap )
+import Data.ByteString
+    ( ByteString )
 import Data.Generics.Internal.VL.Lens
     ( Lens' )
 import Data.Generics.Labels
@@ -233,6 +237,7 @@ type Wallets =
     :<|> PutWallet
     :<|> PutWalletPassphrase
     :<|> GetUTxOsStatistics
+    :<|> SignMetadata
 
 -- | https://input-output-hk.github.io/cardano-wallet/api/#operation/deleteWallet
 type DeleteWallet = "wallets"
@@ -273,6 +278,14 @@ type GetUTxOsStatistics = "wallets"
     :> "utxos"
     :> Get '[JSON] ApiUtxoStatistics
 
+-- | https://input-output-hk.github.io/cardano-wallet/api/#operation/signMetadata
+type SignMetadata = "wallets"
+    :> Capture "walletId" (ApiT WalletId)
+    :> Capture "role" (ApiT AccountingStyle)
+    :> Capture "index" (ApiT DerivationIndex)
+    :> ReqBody '[JSON] ApiWalletSignData
+    :> Post '[OctetStream] ByteString
+
 {-------------------------------------------------------------------------------
                                   Addresses
 

lib/core/src/Cardano/Wallet/Api/Client.hs

@@ -223,6 +223,7 @@ walletClient =
             :<|> _putWallet
             :<|> _putWalletPassphrase
             :<|> _getWalletUtxoStatistics
+            :<|> _signMetadata
             = client (Proxy @("v2" :> Wallets))
     in
         WalletClient

lib/core/src/Cardano/Wallet/Api/Types.hs

@@ -93,6 +93,7 @@ module Cardano.Wallet.Api.Types
     , ApiWalletMigrationPostData (..)
     , ApiWalletMigrationInfo (..)
     , ApiWithdrawal (..)
+    , ApiWalletSignData (..)
 
     -- * API Types (Byron)
     , ApiByronWallet (..)
@@ -735,6 +736,11 @@ data ApiWalletMigrationInfo = ApiWalletMigrationInfo
 newtype ApiWithdrawRewards = ApiWithdrawRewards Bool
     deriving (Eq, Generic, Show)
 
+data ApiWalletSignData = ApiWalletSignData
+    { metadata :: ApiT TxMetadata
+    , passphrase :: ApiT (Passphrase "lenient")
+    } deriving (Eq, Generic, Show)
+
 -- | Error codes returned by the API, in the form of snake_cased strings
 data ApiErrorCode
     = NoSuchWallet
@@ -1538,6 +1544,11 @@ instance FromJSON ApiNetworkParameters where
 instance ToJSON ApiNetworkParameters where
     toJSON = genericToJSON defaultRecordTypeOptions
 
+instance FromJSON ApiWalletSignData where
+    parseJSON = genericParseJSON defaultRecordTypeOptions
+instance ToJSON ApiWalletSignData where
+    toJSON = genericToJSON defaultRecordTypeOptions
+
 instance DecodeStakeAddress n => FromJSON (ApiWithdrawal n) where
     parseJSON = genericParseJSON defaultRecordTypeOptions
 instance EncodeStakeAddress n => ToJSON (ApiWithdrawal n) where

lib/core/src/Cardano/Wallet/Primitive/AddressDerivation.hs

@@ -285,7 +285,7 @@ instance FromText DerivationIndex where
                 Nothing ->
                     Left $ TextDecodingError
                         "expected a number as string with an optional 'H' \
-                         \suffix (e.g. \"1815H\" or \"44\""
+                         \suffix (e.g. \"1815H\" or \"44\")."
                 Just s ->
                     pure s
 

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

@@ -60,6 +60,7 @@ import Cardano.Wallet.Api.Types
     , ApiTxId
     , ApiWalletMigrationPostData
     , ApiWalletPassphrase
+    , ApiWalletSignData
     , ByronWalletPutPassphraseData
     , PostExternalTransactionData
     , PostTransactionData
@@ -71,7 +72,7 @@ import Cardano.Wallet.Api.Types
     , WalletPutPassphraseData
     )
 import Cardano.Wallet.Primitive.AddressDerivation
-    ( NetworkDiscriminant (..) )
+    ( AccountingStyle (..), DerivationIndex (..), NetworkDiscriminant (..) )
 import Cardano.Wallet.Primitive.Types
     ( Address, WalletId, walletNameMaxLength )
 import Control.Arrow
@@ -181,10 +182,83 @@ instance Wellformed (PathParam ApiAddressInspectData) where
 instance Malformed (PathParam ApiAddressInspectData) where
     malformed = []
 
+instance Wellformed (PathParam (ApiT AccountingStyle)) where
+    wellformed = PathParam <$>
+        [ "utxo_internal"
+        , "utxo_external"
+        , "mutable_account"
+        ]
+
+instance Malformed (PathParam (ApiT AccountingStyle)) where
+    malformed = first PathParam <$>
+        [ ( "patate", msgMalformed )
+        , ( "💩", msgMalformed )
+        , ( "utxoInternal", msgMalformed )
+        ]
+      where
+        msgMalformed =
+            "Unable to decode the given value: 'utxo_internal'. Please specify \
+            \one of the following values: utxo_external, utxo_internal, \
+            \mutable_account."
+
+instance Wellformed (PathParam (ApiT DerivationIndex)) where
+    wellformed = PathParam <$>
+        [ "0"
+        , "1234"
+        , "2147483647"
+        , "0H"
+        , "1234H"
+        ]
+
+instance Malformed (PathParam (ApiT DerivationIndex)) where
+    malformed = first PathParam <$>
+        [ ( "patate", msgMalformed )
+        , ( "💩", msgMalformed )
+        , ( "2147483648", msgOutOfBounds )
+        , ( "1234H1234", msgMalformed )
+        , ( "H", msgMalformed )
+        ]
+      where
+        msgMalformed =
+            "expected a number as string with an optional 'H' suffix \
+            \(e.g. '1815H' or '44')."
+
+        msgOutOfBounds =
+            "A derivation index must be a natural number between 0 and 2147483647."
+
 --
 -- Class instances (BodyParam)
 --
 
+instance Malformed (BodyParam ApiWalletSignData) where
+    malformed = first BodyParam <$>
+        [ ( ""
+          , "Error in $: parsing SomeByronWallet failed, expected Object, but encountered String"
+          )
+        , ( Aeson.encode [aesonQQ|
+            { "metadata": null
+            , "passphrase": #{wPassphrase}
+            }|]
+          , "Error in $.metadata: TODO"
+          )
+        , ( Aeson.encode [aesonQQ|
+            { "metadata": { "0": { "string": "metadata" } }
+            , "passphrase": 100
+            }|]
+          , "Error in $.passphrase: parsing Text failed, expected String, but encountered Number"
+          )
+        , ( Aeson.encode [aesonQQ|
+            { "metadata": null
+            }|]
+          , "TODO"
+          )
+        , ( Aeson.encode [aesonQQ|
+            { "passphrase": #{wPassphrase}
+            }|]
+          , "TODO"
+          )
+        ]
+
 instance Malformed (BodyParam SomeByronWalletPostData) where
     malformed = jsonValid ++ jsonInvalid
      where
@@ -1068,6 +1142,17 @@ instance Malformed (Header "Accept" JSON) where
           )
         ]
 
+instance Wellformed (Header "Accept" OctetStream) where
+    wellformed =
+        [Header "application/octet-stream"]
+
+instance Malformed (Header "Accept" OctetStream) where
+    malformed = first Header <$>
+        [ ( "application/json"
+          , "It seems as though you don't accept 'application/octet-stream', but unfortunately I only speak 'application/octet-stream'! Please double-check your 'Accept' request header and make sure it's set to 'application/octet-stream'."
+          )
+        ]
+
 --
 -- Test Data
 --

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

@@ -82,6 +82,7 @@ import Cardano.Wallet.Api.Types
     , ApiWalletMigrationPostData (..)
     , ApiWalletPassphrase (..)
     , ApiWalletPassphraseInfo (..)
+    , ApiWalletSignData (..)
     , ApiWithdrawal (..)
     , ApiWithdrawalPostData (..)
     , ByronWalletFromXPrvPostData (..)
@@ -1180,6 +1181,10 @@ instance Arbitrary StakePoolTicker where
         len <- choose (3, 5)
         replicateM len arbitrary
 
+instance Arbitrary ApiWalletSignData where
+    arbitrary = ApiWalletSignData <$> arbitrary <*> arbitrary
+    shrink = genericShrink
+
 instance Arbitrary PoolOwner where
     arbitrary = PoolOwner . BS.pack <$> vector 32
 
@@ -1759,6 +1764,9 @@ instance ToSchema ApiWalletDelegation where
 instance ToSchema ApiPostRandomAddressData where
     declareNamedSchema _ = declareSchemaForDefinition "ApiPostRandomAddressData"
 
+instance ToSchema ApiWalletSignData where
+    declareNamedSchema _ = declareSchemaForDefinition "ApiWalletSignData"
+
 -- FIXME: #ADP-417
 --
 -- OpenAPI 2.0 does not support sum-types and the 'oneOf' combinator. When we

lib/core/test/unit/Cardano/Wallet/ApiSpec.hs

@@ -30,6 +30,9 @@
 -- See comment in Cardano.Wallet.Jormungandr.Compatibility
 {-# OPTIONS_GHC -fno-warn-orphans #-}
 
+-- Required to use the HLINT pragma
+{-# OPTIONS_GHC -Wno-unrecognised-pragmas #-}
+
 module Cardano.Wallet.ApiSpec
     ( spec
     ) where
@@ -242,6 +245,31 @@ instance
         forM_ wellformed $ \w -> gSpec (toRequest w) toSpec
         forM_ wellformed $ \w -> gSpec (`toRequest` w) toSpec
 
+instance
+    ( Typeable a, Wellformed (PathParam a)
+    , GenericApiSpec (PathParam a -> [Request])
+    , Typeable b, Wellformed (PathParam b)
+    , GenericApiSpec (PathParam b -> [Request])
+    , Wellformed (PathParam c)
+    , GenericApiSpec (PathParam c -> [Request])
+    ) => GenericApiSpec (PathParam a -> PathParam b -> PathParam c -> [Request])
+  where
+    gSpec toRequest toSpec = do
+        forM_
+            [ (b,c) | b <- wellformed, c <- wellformed ]
+            (\(b,c) -> gSpec (\a -> toRequest a b c) toSpec)
+
+        forM_
+            [ (a,c) | a <- wellformed, c <- wellformed ]
+            (\(a,c) -> gSpec (\b -> toRequest a b c) toSpec)
+
+        forM_
+            [ (a,b) | a <- wellformed, b <- wellformed ]
+            (\(a,b) -> gSpec (\c -> toRequest a b c) toSpec)
+
+        -- The lambda above helps readability and make the pattern obvious
+        {-# HLINT ignore "Avoid lambda" #-}
+
 instance
     ( Typeable a, Malformed (BodyParam a)
     ) => GenericApiSpec (BodyParam a -> IO [Request])

lib/jormungandr/src/Cardano/Wallet/Jormungandr/Api/Server.hs

@@ -170,6 +170,7 @@ server byron icarus jormungandr spl ntp =
         :<|> putWallet jormungandr mkShelleyWallet
         :<|> putWalletPassphrase jormungandr
         :<|> getUTxOsStatistics jormungandr
+        :<|> (\_ _ _ _ -> throwError err501)
 
     addresses :: Server (Addresses n)
     addresses = listAddresses jormungandr (normalizeDelegationAddress @_ @JormungandrKey @n)

lib/shelley/src/Cardano/Wallet/Shelley/Api/Server.hs

@@ -143,7 +143,14 @@ import Fmt
 import Network.Ntp
     ( NtpClient )
 import Servant
-    ( (:<|>) (..), Handler (..), NoContent (..), Server, err400, throwError )
+    ( (:<|>) (..)
+    , Handler (..)
+    , NoContent (..)
+    , Server
+    , err400
+    , err501
+    , throwError
+    )
 import Servant.Server
     ( ServerError (..) )
 import Type.Reflection
@@ -189,6 +196,7 @@ server byron icarus shelley spl ntp =
         :<|> putWallet shelley mkShelleyWallet
         :<|> putWalletPassphrase shelley
         :<|> getUTxOsStatistics shelley
+        :<|> (\_ _ _ _ -> throwError err501) -- FIXME: ADP-509
 
     addresses :: Server (Addresses n)
     addresses = listAddresses shelley (normalizeDelegationAddress @_ @ShelleyKey @n)