Use Read.ChainPoint in Cardano.Wallet.Deposit.Read

Author: HeinrichApfelmus

lib/customer-deposit-wallet/customer-deposit-wallet.cabal

@@ -156,6 +156,7 @@ test-suite unit
     , base
     , bytestring
     , cardano-crypto
+    , cardano-wallet-read
     , cardano-wallet-test-utils
     , customer-deposit-wallet
     , customer-deposit-wallet:customer-deposit-wallet-http

lib/customer-deposit-wallet/data/swagger.json

@@ -15,6 +15,13 @@
                     },
                     {
                         "properties": {
+                            "header_hash": {
+                                "description": "Hash (Blake2b_256) of a block header.",
+                                "format": "hex",
+                                "maxLength": 64,
+                                "minLength": 64,
+                                "type": "string"
+                            },
                             "slot_no": {
                                 "maximum": 1.8446744073709551615e19,
                                 "minimum": 0,

lib/customer-deposit-wallet/http/Cardano/Wallet/Deposit/HTTP/Types/JSON.hs

@@ -1,5 +1,6 @@
 {-# LANGUAGE DerivingVia #-}
 {-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE NamedFieldPuns #-}
 {-# LANGUAGE StandaloneDeriving #-}
 {-# LANGUAGE TypeApplications #-}
 
@@ -37,8 +38,6 @@ import Cardano.Wallet.Deposit.Pure
 import Cardano.Wallet.Deposit.Read
     ( Address
     , ChainPoint (..)
-    , fromSlot
-    , toSlot
     )
 import Control.Applicative
     ( (<|>)
@@ -80,17 +79,12 @@ import Data.Text.Class
     , ToText (..)
     , getTextDecodingError
     )
-import Data.Word
-    ( Word64
-    )
-import Numeric.Natural
-    ( Natural
-    )
 import Servant
     ( FromHttpApiData (..)
     )
 
 import qualified Cardano.Wallet.Read as Read
+import qualified Cardano.Wallet.Read.Hash as Hash
 import qualified Data.Text as T
 import qualified Data.Text.Encoding as T
 
@@ -192,21 +186,29 @@ instance ToSchema (ApiT CustomerList) where
                 customerListSchema
 
 instance ToJSON (ApiT ChainPoint) where
-    toJSON (ApiT Origin) = "genesis"
-    toJSON (ApiT (At sl)) = object
-        [ "slot_no" .= toJSON (fromIntegral @Natural @Word64 $ fromSlot sl)
+    toJSON (ApiT Read.GenesisPoint) = "genesis"
+    toJSON (ApiT (Read.BlockPoint{slotNo,headerHash})) = object
+        [ "slot_no" .=
+            Read.unSlotNo slotNo
+        , "header_hash" .=
+            Hash.hashToTextAsHex headerHash
         ]
 
 instance FromJSON (ApiT ChainPoint) where
     parseJSON payload = parseOrigin payload <|> parseSlot payload
       where
-          parseOrigin = withText "genesis" $ \txt ->
-            if txt == "genesis" then
-                pure $ ApiT Origin
-            else
-                fail "'origin' is expected."
-          parseSlot = withObject "slot no" $ \obj ->
-              ApiT . At . toSlot <$>  obj .: "slot_no"
+        parseOrigin = withText "genesis" $ \txt ->
+            if txt == "genesis"
+            then pure $ ApiT Read.GenesisPoint
+            else fail "'genesis' is expected."
+        parseSlot = withObject "slot_no" $ \obj -> do
+            slotNo <- Read.SlotNo <$> obj .: "slot_no"
+            headerHashText <- obj .: "header_hash"
+            headerHash <-
+                case Hash.hashFromTextAsHex headerHashText of
+                    Nothing -> fail "invalid 'header_hash'"
+                    Just hash -> pure hash
+            pure $ ApiT Read.BlockPoint{slotNo,headerHash}
 
 instance ToSchema (ApiT ChainPoint) where
     declareNamedSchema _ = do

lib/customer-deposit-wallet/http/Cardano/Wallet/Deposit/HTTP/Types/OpenAPI.hs

@@ -39,7 +39,9 @@ import Data.OpenApi
     , HasInfo (..)
     , HasItems (..)
     , HasLicense (license)
+    , HasMaxLength (..)
     , HasMaximum (..)
+    , HasMinLength (..)
     , HasMinimum (..)
     , HasName (..)
     , HasOneOf (..)
@@ -217,12 +219,26 @@ chainPointAtSlotSchema =
     mempty
         & type_ ?~ OpenApiObject
         & properties
-            .~ [ ("slot_no", Inline slotSchema)
-               ]
+            .~  [ ("slot_no", Inline slotSchema)
+                , ("header_hash", Inline headerHashSchema)
+                ]
 
 slotSchema :: Schema
 slotSchema =
     mempty
         & type_ ?~ OpenApiInteger
         & minimum_ ?~ 0
         & maximum_ ?~ fromIntegral (maxBound :: Word64)
+
+headerHashSchema :: Schema
+headerHashSchema =
+    blake2b_256Schema
+        & description ?~ "Hash (Blake2b_256) of a block header."
+
+blake2b_256Schema :: Schema
+blake2b_256Schema =
+    mempty
+        & type_ ?~ OpenApiString
+        & format ?~ "hex"
+        & minLength ?~ (2*32)
+        & maxLength ?~ (2*32)

lib/customer-deposit-wallet/src/Cardano/Wallet/Deposit/IO/Network/Mock.hs

@@ -1,3 +1,4 @@
+{-# LANGUAGE DuplicateRecordFields #-}
 {-|
 Copyright: © 2024 Cardano Foundation
 License: Apache-2.0
@@ -93,10 +94,19 @@ newNetworkEnvMock = do
         }
 
 genesis :: Read.ChainPoint
-genesis = Read.Origin
+genesis = Read.GenesisPoint
 
 getBlockPoint :: Read.Block -> Read.ChainPoint
-getBlockPoint = Read.At . Read.slotNo . Read.blockHeaderBody . Read.blockHeader
+getBlockPoint block =
+    Read.BlockPoint
+        { Read.slotNo = slot
+        , Read.headerHash =
+            Read.mockRawHeaderHash
+            $ fromIntegral $ fromEnum slot
+        }
+  where
+    bhBody = Read.blockHeaderBody $ Read.blockHeader block
+    slot = Read.slotNo bhBody
 
 mkNextBlock :: Read.ChainPoint -> [Tx Conway] -> Read.Block
 mkNextBlock tipOld txs =
@@ -114,5 +124,5 @@ mkNextBlock tipOld txs =
         }
  where
     slotNext = case tipOld of
-        Read.Origin -> 1
-        Read.At n -> succ n
+        Read.GenesisPoint -> 1
+        Read.BlockPoint{slotNo = n} -> succ n

lib/customer-deposit-wallet/src/Cardano/Wallet/Deposit/Read.hs

@@ -8,9 +8,7 @@
 module Cardano.Wallet.Deposit.Read
     ( Network (..)
     , Read.SlotNo
-    , toSlot
-    , fromSlot
-    , ChainPoint (..)
+    , Read.ChainPoint (..)
 
     , Address
     , KeyHash
@@ -34,6 +32,7 @@ module Cardano.Wallet.Deposit.Read
     , BlockNo
     , Block (..)
     , BHeader (..)
+    , Read.mockRawHeaderHash
     , BHBody (..)
 
     , GenesisData
@@ -78,11 +77,6 @@ import qualified Data.ByteString.Short as SBS
 ------------------------------------------------------------------------------}
 data Network = Testnet | Mainnet
 
-data ChainPoint
-    = Origin
-    | At Read.SlotNo
-    deriving (Eq, Ord, Show)
-
 -- | Synonym for readability.
 -- The ledger specifications define @Addr@.
 -- Byron addresses are represented by @Addr_bootstrap@.

lib/customer-deposit-wallet/test/unit/Cardano/Wallet/Deposit/HTTP/JSON/JSONSpec.hs

@@ -30,7 +30,6 @@ import Cardano.Wallet.Deposit.Pure
     )
 import Cardano.Wallet.Deposit.Read
     ( mkEnterpriseAddress
-    , toSlot
     )
 import Data.Aeson
     ( FromJSON (..)
@@ -50,9 +49,6 @@ import Data.OpenApi
 import Data.Word
     ( Word64
     )
-import Numeric.Natural
-    ( Natural
-    )
 import Test.Hspec
     ( Expectation
     , Spec
@@ -68,14 +64,16 @@ import Test.QuickCheck
     , arbitrarySizedBoundedIntegral
     , chooseInt
     , counterexample
+    , elements
     , forAll
-    , oneof
+    , frequency
     , property
     , shrinkIntegral
     , vectorOf
     , (===)
     )
 
+import qualified Cardano.Wallet.Read as Read
 import qualified Data.ByteString as BS
 import qualified Data.ByteString.Lazy.Char8 as BL
 import qualified Data.List as L
@@ -155,10 +153,19 @@ genApiTCustomerList = do
     pure $ ApiT $ uniqueAddr $ uniqueCustomer vectors
 
 genApiTChainPoint :: Gen (ApiT ChainPoint)
-genApiTChainPoint = oneof
-        [ pure . ApiT $ Origin
-        , ApiT . At . toSlot . fromIntegral @Word64 @Natural <$> arbitrary
-        ]
+genApiTChainPoint = ApiT <$> genChainPoint
+
+genChainPoint :: Gen Read.ChainPoint
+genChainPoint = frequency
+    [ ( 1, pure Read.GenesisPoint)  -- "common" but not "very common"
+    , (40, Read.BlockPoint <$> genReadSlotNo <*> genHeaderHash)
+    ]
+  where
+    genReadSlotNo = Read.SlotNo . fromIntegral <$> (arbitrary :: Gen Word64)
+    genHeaderHash = elements mockHashes
+
+mockHashes :: [Read.RawHeaderHash]
+mockHashes = map Read.mockRawHeaderHash [0..2]
 
 instance Arbitrary (ApiT Address) where
     arbitrary = genApiTAddress