Merge pull request #4686 from input-output-hk/ch1bo/cardano-api-chain…

…-point-json-instances

[cardano-api] Add ToJSON/FromJSON instances for ChainPoint

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

@@ -2,6 +2,7 @@
 {-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE FlexibleInstances #-}
 {-# LANGUAGE GADTs #-}
+{-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE NamedFieldPuns #-}
 {-# LANGUAGE PatternSynonyms #-}
 {-# LANGUAGE RankNTypes #-}
@@ -358,6 +359,24 @@ instance Ord ChainPoint where
   compare _ ChainPointAtGenesis = GT
   compare (ChainPoint sn _) (ChainPoint sn' _) = compare sn sn'
 
+instance ToJSON ChainPoint where
+  toJSON = \case
+    ChainPointAtGenesis -> object ["tag" .= String "ChainPointAtGenesis"]
+    ChainPoint slot blockHash ->
+      object
+        [ "tag" .= String "ChainPoint"
+        , "slot" .= toJSON slot
+        , "blockHash" .= toJSON blockHash
+        ]
+
+instance FromJSON ChainPoint where
+  parseJSON = withObject "ChainPoint" $ \o -> do
+    tag <- o .: "tag"
+    case tag :: Text of
+      "ChainPointAtGenesis" -> pure ChainPointAtGenesis
+      "ChainPoint" -> ChainPoint <$> o .: "slot" <*> o .: "blockHash"
+      _ -> fail "Expected tag to be ChainPointAtGenesis | ChainPoint"
+
 toConsensusPointInMode :: ConsensusMode mode
                        -> ChainPoint
                        -> Consensus.Point (ConsensusBlockForMode mode)