add endpoint scaffolding plus needed types

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

@@ -30,6 +30,9 @@ module Cardano.Wallet.Api
         , GetUTxOsStatistics
         , SignMetadata
 
+    , WalletKeys
+        , GetWalletKey
+
     , Addresses
         , ListAddresses
         , InspectAddress
@@ -129,6 +132,7 @@ import Cardano.Wallet.Api.Types
     , ApiTransactionT
     , ApiTxId
     , ApiUtxoStatistics
+    , ApiVerificationKeyHash
     , ApiWallet
     , ApiWalletMigrationInfo
     , ApiWalletMigrationPostDataT
@@ -158,6 +162,7 @@ import Cardano.Wallet.Primitive.Types
     ( AddressState
     , Block
     , Coin (..)
+    , DerivationIndex
     , NetworkParameters
     , SortOrder (..)
     , WalletId (..)
@@ -209,6 +214,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
@@ -287,6 +293,22 @@ type SignMetadata = "wallets"
     :> ReqBody '[JSON] ApiWalletSignData
     :> Post '[OctetStream] ByteString
 
+{-------------------------------------------------------------------------------
+                                  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
 

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

@@ -96,6 +96,7 @@ module Cardano.Wallet.Api.Types
     , ApiWalletMigrationInfo (..)
     , ApiWithdrawal (..)
     , ApiWalletSignData (..)
+    , ApiVerificationKeyHash (..)
 
     -- * API Types (Byron)
     , ApiByronWallet (..)
@@ -755,6 +756,10 @@ data ApiWalletSignData = ApiWalletSignData
     , passphrase :: ApiT (Passphrase "lenient")
     } 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
@@ -996,6 +1001,17 @@ instance FromJSON (ApiT DerivationIndex) where
     parseJSON = parseJSON
         >=> fmap ApiT . eitherToParser . first ShowFmt . fromText
 
+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

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

@@ -1193,6 +1193,31 @@ instance Buildable AddressState where
 
 instance NFData AddressState
 
+-- | A thin wrapper around derivation indexes. This can be used to represent
+-- derivation path as homogeneous lists of 'DerivationIndex'. This is slightly
+-- more convenient than having to carry heterogeneous lists of 'Index depth type'
+-- and works fine because:
+--
+-- 1. The 'depth' matters not because what the depth captures is actually the
+--    position of the index in that list. It makes sense to carry at the type
+--    level when manipulating standalone indexes to avoid mistakes, but when
+--    treating them as a part of a list it is redundant.
+--
+-- 2. The derivationType is captured by representing indexes as plain Word32.
+--    The Soft / Hardened notation is for easing human-readability but in the
+--    end, a soft index is simply a value < 2^31, whereas a "hardened" index is
+--    simply a value >= 2^31. Therefore, instead of representing indexes as
+--    derivationType + relative index within 0 and 2^31, we can represent them
+--    as just an index between 0 and 2^32, which is what DerivationIndex does.
+newtype DerivationIndex
+    = DerivationIndex Word32
+    deriving (Show, Eq, Ord, Generic)
+
+instance NFData DerivationIndex
+
+instance FromText DerivationIndex where
+    fromText = fmap DerivationIndex . fromText
+
 {-------------------------------------------------------------------------------
                                      Coin
 -------------------------------------------------------------------------------}
@@ -1850,6 +1875,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)

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

@@ -149,6 +149,7 @@ server
     -> Server (Api n ApiStakePool)
 server byron icarus jormungandr spl ntp =
          wallets
+    :<|> (\ _ _ -> throwError err501)
     :<|> addresses
     :<|> coinSelections
     :<|> transactions

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

@@ -168,6 +168,7 @@ server
     -> Server (Api n ApiStakePool)
 server byron icarus shelley spl ntp =
          wallets
+    :<|> (\ _ _ -> throwError err501)
     :<|> addresses
     :<|> coinSelections
     :<|> transactions

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
@@ -64,7 +64,6 @@ import Text.Read
 import qualified Data.Char as C
 import qualified Data.Text as T
 import qualified Data.Text.Lazy as T
-    ( toStrict )
 import qualified Data.Text.Lazy.Builder as B
 import qualified Data.Text.Lazy.Builder.Int as B
 import qualified Data.Text.Lazy.Builder.RealFloat as B
@@ -125,6 +124,16 @@ instance FromText Natural where
 instance ToText Natural where
     toText = intToText
 
+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 FromText Integer where
     fromText t = do
         (parsedValue, unconsumedInput) <- first (const err) $ signed decimal t

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" $