add endpoint scaffolding plus needed types

cardano-foundation · Oct 16, 2020 · d381540 · d381540
1 parent 5a9b3d5
commit d381540
Show file tree

Hide file tree

Showing 7 changed files with 71 additions and 2 deletions.
diff --git a/lib/core/src/Cardano/Wallet/Api.hs b/lib/core/src/Cardano/Wallet/Api.hs
@@ -29,6 +29,9 @@ module Cardano.Wallet.Api
         , PutWalletPassphrase
         , GetUTxOsStatistics
 
+    , WalletKeys
+        , GetWalletKey
+
     , Addresses
         , ListAddresses
         , InspectAddress
@@ -128,6 +131,7 @@ import Cardano.Wallet.Api.Types
     , ApiTransactionT
     , ApiTxId
     , ApiUtxoStatistics
+    , ApiVerificationKeyHash
     , ApiWallet
     , ApiWalletMigrationInfo
     , ApiWalletMigrationPostDataT
@@ -156,6 +160,7 @@ import Cardano.Wallet.Primitive.Types
     ( AddressState
     , Block
     , Coin (..)
+    , DerivationIndex
     , NetworkParameters
     , SortOrder (..)
     , WalletId (..)
@@ -205,6 +210,7 @@ type ApiV2 n apiPool = "v2" :> Api n apiPool
 -- The API used in cardano-wallet-jormungandr may differ from this one.
 type Api n apiPool =
          Wallets
+    :<|> WalletKeys
     :<|> Addresses n
     :<|> CoinSelections n
     :<|> Transactions n
@@ -273,6 +279,22 @@ type GetUTxOsStatistics = "wallets"
     :> "utxos"
     :> Get '[JSON] ApiUtxoStatistics
 
+{-------------------------------------------------------------------------------
+                                  Wallet Keys
+  See also: https://input-output-hk.github.io/cardano-wallet/api/#tag/WalletKeys
+-------------------------------------------------------------------------------}
+
+type WalletKeys =
+    GetWalletKey
+
+-- | https://input-output-hk.github.io/cardano-wallet/api/#operation/getWalletKey
+type GetWalletKey = "wallets"
+    :> Capture "walletId" (ApiT WalletId)
+    :> "keys"
+    :> "script"
+    :> Capture "index" (ApiT DerivationIndex)
+    :> Get '[JSON] ApiVerificationKeyHash
+
 {-------------------------------------------------------------------------------
                                   Addresses
 

diff --git a/lib/core/src/Cardano/Wallet/Api/Types.hs b/lib/core/src/Cardano/Wallet/Api/Types.hs
@@ -90,6 +90,7 @@ module Cardano.Wallet.Api.Types
     , ApiWalletMigrationPostData (..)
     , ApiWalletMigrationInfo (..)
     , ApiWithdrawal (..)
+    , ApiVerificationKeyHash (..)
 
     -- * API Types (Byron)
     , ApiByronWallet (..)
@@ -711,6 +712,10 @@ data ApiWalletMigrationInfo = ApiWalletMigrationInfo
 newtype ApiWithdrawRewards = ApiWithdrawRewards Bool
     deriving (Eq, Generic, Show)
 
+newtype ApiVerificationKeyHash = ApiVerificationKeyHash
+    { unApiVerificationKeyHash :: ApiT (Hash "ScriptKey")
+    } deriving (Eq, Generic, Show)
+
 -- | Error codes returned by the API, in the form of snake_cased strings
 data ApiErrorCode
     = NoSuchWallet
@@ -986,6 +991,17 @@ instance FromJSON (ApiT DerivationIndex) where
                 Just s ->
                     pure s
 
+instance FromJSON (ApiT (Hash "ScriptKey")) where
+    parseJSON =
+        parseJSON >=> eitherToParser . bimap ShowFmt ApiT . fromText
+instance ToJSON (ApiT (Hash "ScriptKey")) where
+    toJSON = toJSON . toText . getApiT
+
+instance ToJSON ApiVerificationKeyHash where
+    toJSON = genericToJSON defaultRecordTypeOptions
+instance FromJSON ApiVerificationKeyHash where
+    parseJSON = genericParseJSON defaultRecordTypeOptions
+
 instance FromJSON ApiEpochInfo where
     parseJSON = genericParseJSON defaultRecordTypeOptions
 instance ToJSON ApiEpochInfo where

diff --git a/lib/core/src/Cardano/Wallet/Primitive/Types.hs b/lib/core/src/Cardano/Wallet/Primitive/Types.hs
@@ -1191,6 +1191,9 @@ newtype DerivationIndex
 
 instance NFData DerivationIndex
 
+instance FromText DerivationIndex where
+    fromText = fmap DerivationIndex . fromText
+
 {-------------------------------------------------------------------------------
                                      Coin
 -------------------------------------------------------------------------------}
@@ -1848,6 +1851,7 @@ instance FromText (Hash "Genesis")         where fromText = hashFromText 32
 instance FromText (Hash "Block")           where fromText = hashFromText 32
 instance FromText (Hash "BlockHeader")     where fromText = hashFromText 32
 instance FromText (Hash "ChimericAccount") where fromText = hashFromText 28
+instance FromText (Hash "ScriptKey")       where fromText = hashFromText 28
 
 hashFromText
     :: forall t. (KnownSymbol t)

diff --git a/lib/jormungandr/src/Cardano/Wallet/Jormungandr/Api/Server.hs b/lib/jormungandr/src/Cardano/Wallet/Jormungandr/Api/Server.hs
@@ -142,6 +142,7 @@ server
     -> Server (Api n ApiStakePool)
 server byron icarus jormungandr spl ntp =
          wallets
+    :<|> (\ _ _ -> throwError err501)
     :<|> addresses
     :<|> coinSelections
     :<|> transactions

diff --git a/lib/shelley/src/Cardano/Wallet/Shelley/Api/Server.hs b/lib/shelley/src/Cardano/Wallet/Shelley/Api/Server.hs
@@ -134,7 +134,14 @@ import Fmt
 import Network.Ntp
     ( NtpClient )
 import Servant
-    ( (:<|>) (..), Handler (..), NoContent (..), Server, err400 )
+    ( (:<|>) (..)
+    , Handler (..)
+    , NoContent (..)
+    , Server
+    , err400
+    , err501
+    , throwError
+    )
 import Servant.Server
     ( ServerError (..) )
 import Type.Reflection
@@ -158,6 +165,7 @@ server
     -> Server (Api n ApiStakePool)
 server byron icarus shelley spl ntp =
          wallets
+    :<|> (\ _ _ -> throwError err501)
     :<|> addresses
     :<|> coinSelections
     :<|> transactions

diff --git a/lib/text-class/src/Data/Text/Class.hs b/lib/text-class/src/Data/Text/Class.hs
@@ -35,7 +35,7 @@ module Data.Text.Class
 import Prelude
 
 import Control.Monad
-    ( unless )
+    ( unless, (<=<) )
 import Data.Bifunctor
     ( first )
 import Data.List
@@ -48,6 +48,8 @@ import Data.Text
     ( Text )
 import Data.Text.Read
     ( decimal, signed )
+import Data.Word
+    ( Word32 )
 import Fmt
     ( Buildable )
 import GHC.Generics
@@ -116,6 +118,19 @@ instance FromText Natural where
 instance ToText Natural where
     toText = T.pack . show
 
+instance FromText Word32 where
+    fromText =
+        validate <=< (fmap fromIntegral . fromText @Natural)
+      where
+        validate x
+            | (x >= (minBound @Word32)) && (x <= (maxBound @Word32))  =
+                return x
+            | otherwise =
+                Left $ TextDecodingError "Word32 is out of bounds"
+
+instance ToText Word32 where
+    toText = T.pack . show
+
 instance FromText Integer where
     fromText t = do
         (parsedValue, unconsumedInput) <- first (const err) $ signed decimal t

diff --git a/lib/text-class/test/unit/Data/Text/ClassSpec.hs b/lib/text-class/test/unit/Data/Text/ClassSpec.hs
@@ -28,6 +28,8 @@ import Data.Text.Class
     , fromTextToBoundedEnum
     , toTextFromBoundedEnum
     )
+import Data.Word
+    ( Word32 )
 import GHC.Generics
     ( Generic )
 import Numeric.Natural
@@ -111,6 +113,7 @@ spec = do
         textRoundtrip $ Proxy @Natural
         textRoundtrip $ Proxy @Int
         textRoundtrip $ Proxy @Text
+        textRoundtrip $ Proxy @Word32
 
     describe "BoundedEnum" $ do
         it "fromTextToBoundedEnum s (toTextFromBoundedEnum s a) == Right a" $