wip: straighten out slot and block references in api

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

@@ -159,6 +159,7 @@ import Cardano.Wallet.Api.Types
     , AddressAmount (..)
     , ApiAccountPublicKey (..)
     , ApiAddress (..)
+    , ApiBlockInfo (..)
     , ApiBlockReference (..)
     , ApiBlockReference (..)
     , ApiByronWallet (..)
@@ -176,6 +177,7 @@ import Cardano.Wallet.Api.Types
     , ApiPostRandomAddressData (..)
     , ApiPutAddressesData (..)
     , ApiSelectCoinsData (..)
+    , ApiSlotId (..)
     , ApiSlotReference (..)
     , ApiT (..)
     , ApiTransaction (..)
@@ -264,7 +266,6 @@ import Cardano.Wallet.Primitive.Model
     ( Wallet, availableBalance, currentTip, getState, totalBalance )
 import Cardano.Wallet.Primitive.Slotting
     ( PastHorizonException
-    , SlotNo
     , TimeInterpreter
     , currentEpoch
     , endTimeOfEpoch
@@ -287,6 +288,8 @@ import Cardano.Wallet.Primitive.Types
     , PassphraseScheme (..)
     , PoolId
     , PoolLifeCycleStatus (..)
+    , SlotId
+    , SlotNo
     , SortOrder (..)
     , TransactionInfo (TransactionInfo)
     , Tx (..)
@@ -1614,7 +1617,7 @@ getNetworkInformation
 getNetworkInformation st nl = do
     now <- liftIO getCurrentTime
     nodeTip <-  liftHandler (NW.currentNodeTip nl)
-    apiNodeTip <- liftIO $ mkApiBlockReference ti nodeTip
+    apiNodeTip <- liftIO $ makeApiBlockReferenceFromHeader ti nodeTip
     nowInfo <- liftIO $ runMaybeT $ networkTipInfo now
     progress <- handle (\(_ :: PastHorizonException) -> pure NotResponding)
         $ liftIO (syncProgress st ti nodeTip now)
@@ -1628,23 +1631,13 @@ getNetworkInformation st nl = do
     ti :: TimeInterpreter IO
     ti = timeInterpreter nl
 
-    makeApiSlotReference :: TimeInterpreter IO -> SlotNo -> ApiSlotReference
-    makeApiSlotReference ti sl =
-        ApiSlotReference (ApiT sl)
-            <$> (fmap apiSlotId $ ti $ toSlotId sl)
-            <*> (ti $ startTime sl)
-      where
-        apiSlotId theSlotId = ApiSlotId
-            (ApiT $ theSlotId ^. #epochNumber)
-            (ApiT $ theSlotId ^. #slotNumber)
-
     -- (network tip, next epoch)
     -- May be unavailible if the node is still syncing.
     networkTipInfo :: UTCTime -> MaybeT IO (ApiSlotReference, ApiEpochInfo)
     networkTipInfo now = handle handlePastHorizonException $ do
         networkTipSlot <- MaybeT (ti $ ongoingSlotAt now)
         tip <- lift $ makeApiSlotReference ti networkTipSlot
-        let curEpoch = networkTip ^. #epochNumber
+        let curEpoch = tip ^. #slotId . #epochNumber . #getApiT
         nextEpochStart <- lift $ ti $ endTimeOfEpoch curEpoch
         let nextEpoch = ApiEpochInfo
                 (ApiT $ unsafeEpochSucc curEpoch)
@@ -1809,7 +1802,7 @@ mkApiTransaction
     -> Lens' (ApiTransaction n) (Maybe ApiBlockReference)
     -> m (ApiTransaction n)
 mkApiTransaction ti txid ins outs ws (meta, timestamp) txMeta setTimeReference = do
-    timeRef <- timeReference
+    timeRef <- metaBlockReference meta
     expRef <- expirySlotReference
     return $ tx & setTimeReference .~ Just timeRef & #expiresAt .~ expRef
   where
@@ -1829,39 +1822,13 @@ mkApiTransaction ti txid ins outs ws (meta, timestamp) txMeta setTimeReference =
         , metadata = apiTxMetadata txMeta
         }
 
-    timeReference :: m ApiBlockReference
-    timeReference = do
-        slotId <- ti (toSlotId $ meta ^. #slotNo)
-        -- TODO: We get passed the timestamp, but still have to do additional
-        -- time-conversions here. We should probably do both
-        --  SlotNo -> SlotId
-        --  SlotNo -> UTCTime
-        -- conversions in the same place.
-        return $
-            ApiBlockReference
-                { absoluteSlotNumber = ApiT $ meta ^. #slotNo
-                , slotId = ApiSlotId
-                    { epochNumber = ApiT $ slotId ^. #epochNumber
-                    , slotNumber = ApiT $ slotId ^. #slotNumber
-                    }
-                , time = timestamp
-                , block = ApiBlockInfo
-                    { height = natural (meta ^. #blockHeight)
-                    }
-                  }
+    metaBlockReference :: W.TxMeta -> m ApiBlockReference
+    metaBlockReference meta = makeApiBlockReference ti
+        (meta ^. #slotNo)
+        (natural $ meta ^. #blockHeight)
 
     expirySlotReference :: m (Maybe ApiSlotReference)
-    expirySlotReference = case meta ^. #expiry of
-        Just expirySlot -> do
-            expiryTimestamp <- ti (startTime expirySlot)
-            slotId <- ti (toSlotId expirySlot)
-            pure $ Just $ ApiSlotReference
-                { time = expiryTimestamp
-                , absoluteSlotNumber = ApiT expirySlot
-                , epochNumber = ApiT $ slotId ^. #epochNumber
-                , slotNumber = ApiT $ slotId ^. #slotNumber
-                }
-        Nothing -> pure Nothing
+    expirySlotReference = traverse (makeApiSlotReference ti) (meta ^. #expiry)
 
     toAddressAmount :: TxOut -> AddressAmount (ApiT Address, Proxy n)
     toAddressAmount (TxOut addr c) =
@@ -1889,26 +1856,51 @@ coerceCoin (AddressAmount (ApiT addr, _) (Quantity c)) =
 natural :: Quantity q Word32 -> Quantity q Natural
 natural = Quantity . fromIntegral . getQuantity
 
-mkApiBlockReference
+apiSlotId :: SlotId -> ApiSlotId
+apiSlotId slotId = ApiSlotId
+   (ApiT $ slotId ^. #epochNumber)
+   (ApiT $ slotId ^. #slotNumber)
+
+makeApiBlockReference
     :: Monad m
     => TimeInterpreter m
-    -> BlockHeader
+    -> SlotNo
+    -> Quantity "block" Natural
     -> m ApiBlockReference
-mkApiBlockReference ti tip = do
-    slotId <- ti (toSlotId $ slotNo tip)
+makeApiBlockReference ti sl height = do
+    slotId <- ti (toSlotId sl)
+    slotTime <- ti (startTime sl)
     return $ ApiBlockReference
-        { epochNumber = ApiT $ slotId ^. #epochNumber
-        , slotNumber = ApiT $ slotId ^. #slotNumber
-        , height = natural $ tip ^. #blockHeight
-        , absoluteSlotNumber = ApiT $ slotNo tip
+        { absoluteSlotNumber = ApiT sl
+        , slotId = apiSlotId slotId
+        , time = slotTime
+        , block = ApiBlockInfo { height }
         }
 
+makeApiBlockReferenceFromHeader
+    :: Monad m
+    => TimeInterpreter m
+    -> BlockHeader
+    -> m ApiBlockReference
+makeApiBlockReferenceFromHeader ti tip =
+    makeApiBlockReference ti (tip ^. #slotNo) (natural $ tip ^. #blockHeight)
+
+makeApiSlotReference
+    :: Monad m
+    => TimeInterpreter m
+    -> SlotNo
+    -> m ApiSlotReference
+makeApiSlotReference ti sl =
+    ApiSlotReference (ApiT sl)
+        <$> (fmap apiSlotId $ ti $ toSlotId sl)
+        <*> (ti $ startTime sl)
+
 getWalletTip
     :: Monad m
     => TimeInterpreter m
     -> Wallet s
     -> m ApiBlockReference
-getWalletTip ti wallet = mkApiBlockReference ti (currentTip wallet)
+getWalletTip ti = makeApiBlockReferenceFromHeader ti . currentTip
 
 {-------------------------------------------------------------------------------
                                 Api Layer
@@ -2037,7 +2029,7 @@ data ErrCreateWallet
         -- ^ Somehow, we couldn't create a worker or open a db connection
     deriving (Eq, Show)
 
-newtype ErrRejectedTip = ErrRejectedTip ApiNetworkTip
+newtype ErrRejectedTip = ErrRejectedTip ApiSlotReference
     deriving (Eq, Show)
 
 -- | Small helper to easy show things to Text

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

@@ -79,6 +79,7 @@ module Cardano.Wallet.Api.Types
     , NtpSyncingStatus (..)
     , ApiNetworkClock (..)
     , ApiSlotReference (..)
+    , ApiSlotId (..)
     , ApiBlockReference (..)
     , ApiBlockInfo (..)
     , Iso8601Time (..)
@@ -604,8 +605,8 @@ newtype ApiTxId = ApiTxId
 data ApiTransaction (n :: NetworkDiscriminant) = ApiTransaction
     { id :: !(ApiT (Hash "Tx"))
     , amount :: !(Quantity "lovelace" Natural)
-    , insertedAt :: !(Maybe ApiSlotReference)
-    , pendingSince :: !(Maybe ApiSlotReference)
+    , insertedAt :: !(Maybe ApiBlockReference)
+    , pendingSince :: !(Maybe ApiBlockReference)
     , expiresAt :: !(Maybe ApiSlotReference)
     , depth :: !(Maybe (Quantity "block" Natural))
     , direction :: !(ApiT Direction)
@@ -1295,22 +1296,35 @@ instance DecodeAddress t => FromJSON (PostTransactionFeeData t) where
 instance EncodeAddress t => ToJSON (PostTransactionFeeData t) where
     toJSON = genericToJSON defaultRecordTypeOptions
 
--- fixme: custom json (see syncProgressOptions for example)
+-- Note: These custom JSON instances are for compatibility with the existing API
+-- schema. At some point, we can switch to the generic instances.
 instance FromJSON ApiSlotReference where
-    parseJSON = genericParseJSON defaultRecordTypeOptions
+    parseJSON = withObject "SlotReference" $ \o ->
+        ApiSlotReference
+        <$> o .: "absolute_slot_number"
+        <*> parseJSON (Aeson.Object o)
+        <*> o .: "time"
 instance ToJSON ApiSlotReference where
-    toJSON = genericToJSON defaultRecordTypeOptions
+    toJSON (ApiSlotReference sln sli t) =
+        let Aeson.Object rest = toJSON sli
+        in Aeson.Object ("absolute_slot_number" .= sln <> "time" .= t <> rest)
 
 instance FromJSON ApiSlotId where
     parseJSON = genericParseJSON defaultRecordTypeOptions
 instance ToJSON ApiSlotId where
     toJSON = genericToJSON defaultRecordTypeOptions
 
--- fixme: custom json
+-- Note: These custom JSON instances are for compatibility with the existing API
+-- schema. At some point, we can switch to the generic instances.
+-- A BlockReference is just a SlotReference with the block height included.
 instance FromJSON ApiBlockReference where
-    parseJSON = genericParseJSON defaultRecordTypeOptions
+    parseJSON v = do
+        ApiSlotReference sln sli t <- parseJSON v
+        ApiBlockReference sln sli t <$> parseJSON v
 instance ToJSON ApiBlockReference where
-    toJSON = genericToJSON defaultRecordTypeOptions
+    toJSON (ApiBlockReference sln sli t (ApiBlockInfo bh)) =
+        let Aeson.Object rest = toJSON (ApiSlotReference sln sli t)
+        in Aeson.Object ("height" .= bh <> rest)
 
 instance FromJSON ApiBlockInfo where
     parseJSON = genericParseJSON defaultRecordTypeOptions

specifications/api/swagger.yaml

@@ -432,13 +432,7 @@ x-transactionInsertedAt: &transactionInsertedAt
     <strong>if:</strong> status == in_ledger
     </span><br/>
     Absolute time at which the transaction was inserted in a block.
-  type: object
-  required:
-    - block
-    - time
-  properties:
-    time: *date
-    block: *blockReference
+  <<: *blockReference
 
 x-transactionExpiresAt: &transactionExpiresAt
   description: |
@@ -454,13 +448,7 @@ x-transactionPendingSince: &transactionPendingSince
     <strong>if:</strong> status == pending
     </span><br/>
     The point in time at which a transaction became pending.
-  type: object
-  required:
-    - block
-    - time
-  properties:
-    time: *date
-    block: *blockReference
+  <<: *blockReference
 
 x-transactionDepth: &transactionDepth
   description: |