gRPC: add timestamp to chain tip in rpc query responses

Author: carbolymer

.claude/skills/build-fix/SKILL.md

@@ -0,0 +1,37 @@
+---
+name: build-fix
+description: Build a cabal component with nix, parse GHC errors and warnings, fix them, and rebuild until clean.
+disable-model-invocation: true
+argument-hint: [nix-flake-target]
+---
+
+Build and iteratively fix GHC errors/warnings for the given nix flake target.
+
+If no argument is given, default to `'.#cardano-rpc:lib:cardano-rpc'`.
+
+Target: $ARGUMENTS
+
+## Procedure
+
+1. Run `nix build '<target>' 2>&1` and capture the output.
+2. Parse the output for GHC errors and warnings.
+3. If there are errors, fix them one category at a time:
+   - **Missing imports**: Look up which module exports the symbol. Remember that RIO does NOT re-export everything from Prelude/Data.List (e.g. `sortBy`, `on` need explicit imports).
+   - **Type mismatches**: Analyze carefully. In cardano-rpc, remember that `Proto msg` is a grapesy wrapper — internal functions use plain proto-lens types, `getProto`/`fmap getProto` at handler boundaries only.
+   - **Not in scope**: Check if it's a missing import or a typo.
+   - **Redundant constraints**: Remove them.
+   - **Redundant imports**: Remove them.
+   - **Deprecated functions**: Replace with the recommended alternative (e.g. `valueToList` -> `toList` from `GHC.IsList`).
+4. After fixing, rebuild.
+5. Repeat until the build succeeds with no errors.
+6. If there are warnings remaining, fix them too:
+   - Redundant imports/constraints: remove
+   - hlint-style suggestions: apply (e.g. lambda to infix)
+   - Deprecated usage: replace
+7. Rebuild one final time to confirm clean output.
+
+## Important rules
+- NEVER manually edit files under `gen/` — those are generated by proto-lens.
+- If proto generated code needs updating, use `/proto-gen` instead.
+- RIO's `^.` works with proto-lens lenses. Do NOT add `lens-family` as a dependency.
+- Verify fixes carefully before rebuilding to minimize nix build round-trips (each takes minutes).

.claude/skills/proto-gen/SKILL.md

@@ -0,0 +1,23 @@
+---
+name: proto-gen
+description: Regenerate proto-lens Haskell code from .proto files using buf in the nix dev shell.
+disable-model-invocation: true
+argument-hint: [package-dir]
+---
+
+Regenerate proto-lens code from .proto files.
+
+If no argument is given, default to `cardano-rpc`.
+
+Package directory: $ARGUMENTS
+
+## Procedure
+
+1. Run: `nix develop --command bash -c "cd <package-dir> && buf generate proto"`
+2. Verify the command succeeded.
+3. Show a summary of which files were regenerated (check git status for changed files under `<package-dir>/gen/`).
+
+## Important rules
+- NEVER manually edit files under `gen/` — they are overwritten by this command.
+- If buf or proto-lens-protoc are not found, it means you're not in the nix dev shell — always use `nix develop --command`.
+- After regeneration, you may need to run `/build-fix` to ensure everything compiles.

.claude/skills/rio-check/SKILL.md

@@ -0,0 +1,30 @@
+---
+name: rio-check
+description: Check if a Haskell function or type is re-exported by the RIO module.
+disable-model-invocation: true
+argument-hint: [symbol-name]
+---
+
+Check whether the symbol `$ARGUMENTS` is re-exported by RIO.
+
+## Procedure
+
+1. Find the RIO package source in the nix store by searching for the RIO module file:
+   ```
+   find /nix/store -path '*/RIO.hs' -name 'RIO.hs' 2>/dev/null | head -5
+   ```
+   Or search the project's dependency tree:
+   ```
+   grep -r 'module RIO' $(nix build '.#cardano-rpc:lib:cardano-rpc' --print-out-paths 2>/dev/null)/lib/ 2>/dev/null
+   ```
+2. Search for the symbol in RIO's module exports and re-exports.
+3. Report:
+   - Whether the symbol is available from RIO
+   - If NOT available, which module to import it from (e.g. `Data.List`, `Data.Map`, etc.)
+   - Whether RIO hides it (some symbols are explicitly hidden, like `toList`)
+
+## Known RIO gaps (common gotchas)
+- `sortBy` — NOT in RIO, import from `Data.List`
+- `on` — NOT in RIO, import from `Data.Function`
+- `toList` — RIO re-exports from GHC.Exts but some modules hide it; use `GHC.IsList` or import explicitly
+- `sortOn`, `sort` — available in RIO

cardano-api/src/Cardano/Api/Internal/Orphans/Misc.hs

@@ -31,6 +31,7 @@ import Cardano.Ledger.HKD (NoUpdate (..))
 import Cardano.Ledger.Plutus.Language qualified as L
 import Cardano.Ledger.Shelley.PParams qualified as Ledger
 import Ouroboros.Consensus.Cardano.Block (EraMismatch (..))
+import Ouroboros.Consensus.HardFork.History.Qry (PastHorizonException)
 import PlutusLedgerApi.Common qualified as P
 
 import Codec.Binary.Bech32 qualified as Bech32
@@ -299,6 +300,9 @@ instance Error Byron.GenesisDataGenerationError where
 instance Error P.ParseError where
   prettyError = pretty . show
 
+instance Error PastHorizonException where
+  prettyError = pretty . show
+
 deriving via ShowOf TypeRep instance Pretty TypeRep
 
 instance TestEquality L.SLanguage where

cardano-api/src/Cardano/Api/Query.hs

@@ -37,6 +37,7 @@ module Cardano.Api.Query
   , LedgerState (..)
   , getProgress
   , getSlotForRelativeTime
+  , slotToUTCTime
   , decodeBigLedgerPeerSnapshot
 
     -- * Convenience functions

cardano-api/src/Cardano/Api/Query/Internal/Type/QueryInMode.hs

@@ -57,6 +57,7 @@ module Cardano.Api.Query.Internal.Type.QueryInMode
   , LedgerState (..)
   , getProgress
   , getSlotForRelativeTime
+  , slotToUTCTime
   , decodeBigLedgerPeerSnapshot
 
     -- * Internal conversion functions
@@ -100,7 +101,7 @@ import Cardano.Ledger.Shelley.API qualified as Shelley
 import Cardano.Ledger.Shelley.Core qualified as Core
 import Cardano.Slotting.EpochInfo (hoistEpochInfo)
 import Cardano.Slotting.Slot (WithOrigin (..))
-import Cardano.Slotting.Time (SystemStart (..))
+import Cardano.Slotting.Time (SystemStart (..), fromRelativeTime)
 import Ouroboros.Consensus.BlockchainTime.WallClock.Types (RelativeTime, SlotLength)
 import Ouroboros.Consensus.Byron.Ledger qualified as Consensus
 import Ouroboros.Consensus.Cardano.Block (LedgerState (..), StandardCrypto)
@@ -134,6 +135,7 @@ import Data.Set qualified as Set
 import Data.Singletons qualified as Singletons
 import Data.Text (Text)
 import Data.Text qualified as Text
+import Data.Time (UTCTime)
 import Data.Word (Word64)
 import GHC.Exts (IsList (..))
 import GHC.Stack
@@ -204,6 +206,17 @@ getSlotForRelativeTime relTime (EraHistory interpreter) = do
   (slotNo, _, _) <- Qry.interpretQuery interpreter $ Qry.wallclockToSlot relTime
   pure slotNo
 
+-- | Convert a 'SlotNo' to a 'UTCTime' given the 'SystemStart' and 'EraHistory'.
+slotToUTCTime
+  :: ()
+  => SystemStart
+  -> EraHistory
+  -> SlotNo
+  -> Either Qry.PastHorizonException UTCTime
+slotToUTCTime systemStart eraHistory slotNo = do
+  (relTime, _slotLen) <- getProgress slotNo eraHistory
+  pure $ fromRelativeTime systemStart relTime
+
 newtype LedgerEpochInfo = LedgerEpochInfo {unLedgerEpochInfo :: Consensus.EpochInfo (Either Text)}
 
 toLedgerEpochInfo

cardano-rpc/cardano-rpc.cabal

@@ -91,6 +91,7 @@ library
     random,
     rio,
     text,
+    time,
 
 -- this should be replaced by utxorpc package from hackage
 -- ideally we should upstream whatever is implemented in Proto.Cardano.Rpc.Node

cardano-rpc/src/Cardano/Rpc/Server/Internal/UtxoRpc/Query.hs

@@ -3,6 +3,7 @@
 {-# LANGUAGE DerivingVia #-}
 {-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE GADTs #-}
+{-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE QuantifiedConstraints #-}
 {-# LANGUAGE RankNTypes #-}
 {-# LANGUAGE ScopedTypeVariables #-}
@@ -27,6 +28,7 @@ import RIO hiding (toList)
 
 import Data.Default
 import Data.ProtoLens (defMessage)
+import Data.Time.Clock.POSIX (utcTimeToPOSIXSeconds)
 import GHC.IsList
 import Network.GRPC.Spec
 
@@ -44,15 +46,19 @@ readParamsMethod _req = do
   let sbe = convert eon
 
   let target = VolatileTip
-  (pparams, chainPoint, blockNo) <- liftIO . (throwEither =<<) $ executeLocalStateQueryExpr nodeConnInfo target $ do
+  (pparams, chainPoint, blockNo, systemStart, eraHistory) <- liftIO . (throwEither =<<) $ executeLocalStateQueryExpr nodeConnInfo target $ do
     pparams <- throwEither =<< throwEither =<< queryProtocolParameters sbe
     chainPoint <- throwEither =<< queryChainPoint
     blockNo <- throwEither =<< queryChainBlockNo
-    pure (pparams, chainPoint, blockNo)
+    systemStart <- throwEither =<< querySystemStart
+    eraHistory <- throwEither =<< queryEraHistory
+    pure (pparams, chainPoint, blockNo, systemStart, eraHistory)
+
+  timestamp <- slotToTimestampMs systemStart eraHistory chainPoint
 
   pure $
     def
-      & U5c.ledgerTip .~ mkChainPointMsg chainPoint blockNo
+      & U5c.ledgerTip .~ mkChainPointMsg chainPoint blockNo timestamp
       & U5c.values . U5c.cardano .~ obtainCommonConstraints eon (protocolParamsToUtxoRpcPParams eon pparams)
 
 readUtxosMethod
@@ -73,15 +79,19 @@ readUtxosMethod req = do
   eon <- forEraInEon @Era era (error "Minimum Conway era required") pure
 
   let target = VolatileTip
-  (utxo, chainPoint, blockNo) <- liftIO . (throwEither =<<) $ executeLocalStateQueryExpr nodeConnInfo target $ do
+  (utxo, chainPoint, blockNo, systemStart, eraHistory) <- liftIO . (throwEither =<<) $ executeLocalStateQueryExpr nodeConnInfo target $ do
     utxo <- throwEither =<< throwEither =<< queryUtxo (convert eon) utxoFilter
     chainPoint <- throwEither =<< queryChainPoint
     blockNo <- throwEither =<< queryChainBlockNo
-    pure (utxo, chainPoint, blockNo)
+    systemStart <- throwEither =<< querySystemStart
+    eraHistory <- throwEither =<< queryEraHistory
+    pure (utxo, chainPoint, blockNo, systemStart, eraHistory)
+
+  timestamp <- slotToTimestampMs systemStart eraHistory chainPoint
 
   pure $
     defMessage
-      & U5c.ledgerTip .~ mkChainPointMsg chainPoint blockNo
+      & U5c.ledgerTip .~ mkChainPointMsg chainPoint blockNo timestamp
       & U5c.items .~ obtainCommonConstraints eon (utxoToUtxoRpcAnyUtxoData utxo)
  where
   txoRefToTxIn :: MonadRpc e m => Proto UtxoRpc.TxoRef -> m TxIn
@@ -93,3 +103,14 @@ readUtxosMethod req = do
 -- readAddress :: MonadRpc e m => ByteString -> m AddressAny
 -- readAddress =
 --   throwEither . first stringException . P.runParser parseAddressAny <=< throwEither . T.decodeUtf8'
+
+slotToTimestampMs
+  :: HasCallStack
+  => MonadIO m
+  => SystemStart -> EraHistory -> ChainPoint -> m Word64
+slotToTimestampMs systemStart eraHistory =
+  fmap (round . (* 1000) . utcTimeToPOSIXSeconds) . \case
+    ChainPointAtGenesis ->
+      let SystemStart t = systemStart in pure t
+    ChainPoint slotNo _ ->
+      throwEither $ slotToUTCTime systemStart eraHistory slotNo

cardano-rpc/src/Cardano/Rpc/Server/Internal/UtxoRpc/Type.hs

@@ -19,6 +19,7 @@ module Cardano.Rpc.Server.Internal.UtxoRpc.Type
   , simpleScriptToUtxoRpcNativeScript
   , utxoRpcBigIntToInteger
   , mkChainPointMsg
+  , utxoRpcChainPointMsgToChainPoint
   )
 where
 
@@ -324,8 +325,10 @@ utxoRpcPParamsToProtocolParams era pp = conwayEraOnwardsConstraints (convert era
 mkChainPointMsg
   :: ChainPoint
   -> WithOrigin BlockNo
+  -> Word64
+  -- ^ timestamp in milliseconds
   -> Proto UtxoRpc.ChainPoint
-mkChainPointMsg chainPoint blockNo = do
+mkChainPointMsg chainPoint blockNo timestamp = do
   let (slotNo, blockHash) = case chainPoint of
         ChainPointAtGenesis -> (0, mempty)
         ChainPoint (SlotNo slot) (HeaderHash hash) -> (slot, SBS.fromShort hash)
@@ -336,6 +339,30 @@ mkChainPointMsg chainPoint blockNo = do
     & U5c.slot .~ slotNo
     & U5c.hash .~ blockHash
     & U5c.height .~ blockHeight
+    & U5c.timestamp .~ timestamp
+
+-- | Inverse of 'mkChainPointMsg'. Note: @Origin@ and @At (BlockNo 0)@ both
+-- encode to @height=0@, so the decode always maps @0@ back to @Origin@.
+utxoRpcChainPointMsgToChainPoint
+  :: HasCallStack
+  => MonadThrow m
+  => Proto UtxoRpc.ChainPoint
+  -> m (ChainPoint, WithOrigin BlockNo, Word64)
+utxoRpcChainPointMsgToChainPoint msg = do
+  let slot = msg ^. U5c.slot
+      blockHash = msg ^. U5c.hash
+      blockHeight = msg ^. U5c.height
+      timestampMs = msg ^. U5c.timestamp
+  chainPoint <-
+    if slot == 0 && blockHash == mempty
+      then pure ChainPointAtGenesis
+      else do
+        headerHash <- liftEitherError $ deserialiseFromRawBytes (AsHash asType) blockHash
+        pure $ ChainPoint (SlotNo slot) headerHash
+  let blockNo
+        | blockHeight == 0 = Origin
+        | otherwise = At (BlockNo blockHeight)
+  pure (chainPoint, blockNo, timestampMs)
 
 simpleScriptToUtxoRpcNativeScript :: SimpleScript -> Proto UtxoRpc.NativeScript
 simpleScriptToUtxoRpcNativeScript = \case

cardano-rpc/test/cardano-rpc-test/Test/Cardano/Rpc/Type.hs

@@ -4,11 +4,16 @@
 
 module Test.Cardano.Rpc.Type where
 
+import Cardano.Api (BlockNo (..), ChainPoint (..), SlotNo (..))
 import Cardano.Api.Experimental.Era
 import Cardano.Rpc.Server.Internal.UtxoRpc.Type
 
+import Cardano.Ledger.BaseTypes (WithOrigin (..))
+
 import RIO
 
+import Test.Gen.Cardano.Api.Typed (genBlockHeaderHash)
+
 import Hedgehog as H
 import Hedgehog.Extras qualified as H
 import Hedgehog.Gen qualified as H
@@ -28,6 +33,40 @@ hprop_roundtrip_bigint = H.property $ do
   H.note_ "Check that BigInt -> Integer -> BigInt preserves the value"
   bigInt === bigInt'
 
+-- | Test that ChainPoint protobuf message roundtrips, including the timestamp field.
+-- Note: @At (BlockNo 0)@ is excluded because it encodes identically to @Origin@.
+hprop_roundtrip_chain_point_msg :: Property
+hprop_roundtrip_chain_point_msg = H.property $ do
+  chainPoint <- forAll genChainPoint
+  blockNo <- forAll genWithOriginBlockNo
+  timestamp <- forAll $ H.word64 (H.linearFrom 0 0 maxBound)
+
+  H.tripping
+    (chainPoint, blockNo, timestamp)
+    (uncurry3 mkChainPointMsg)
+    (first @Either displayException . utxoRpcChainPointMsgToChainPoint)
+ where
+  uncurry3 f (a, b, c) = f a b c
+
+-- | Generate a 'ChainPoint', avoiding @ChainPoint (SlotNo 0) hash@ which is
+-- ambiguous with 'ChainPointAtGenesis' after protobuf encoding (both map to
+-- @slot=0, hash=empty@).
+genChainPoint :: Gen ChainPoint
+genChainPoint =
+  H.choice
+    [ pure ChainPointAtGenesis
+    , ChainPoint . SlotNo <$> H.word64 (H.linear 1 maxBound) <*> genBlockHeaderHash
+    ]
+
+-- | Generate a @WithOrigin BlockNo@, excluding @At (BlockNo 0)@ which is
+-- ambiguous with 'Origin' after protobuf encoding (both map to @height=0@).
+genWithOriginBlockNo :: Gen (WithOrigin BlockNo)
+genWithOriginBlockNo =
+  H.choice
+    [ pure Origin
+    , At . BlockNo <$> H.word64 (H.linear 1 maxBound)
+    ]
+
 -- generate integer for each of the BigInt proto type constructors
 genLargeInteger :: Gen Integer
 genLargeInteger =