Add JSON schema checking functionality for DRep and Gov action metadata

cardano-api/cardano-api.cabal

@@ -88,8 +88,10 @@ library internal
     Cardano.Api.Experimental.Tx
     Cardano.Api.Feature
     Cardano.Api.Fees
+    Cardano.Api.GeneralParsers
     Cardano.Api.Genesis
     Cardano.Api.GenesisParameters
+    Cardano.Api.Governance.Actions.MetadataValidation
     Cardano.Api.Governance.Actions.ProposalProcedure
     Cardano.Api.Governance.Actions.VotingProcedure
     Cardano.Api.Governance.Poll
@@ -359,7 +361,9 @@ test-suite cardano-api-test
     Test.Cardano.Api.Envelope
     Test.Cardano.Api.EpochLeadership
     Test.Cardano.Api.Eras
+    Test.Cardano.Api.Experimental
     Test.Cardano.Api.Genesis
+    Test.Cardano.Api.GovAnchorValidation
     Test.Cardano.Api.IO
     Test.Cardano.Api.Json
     Test.Cardano.Api.KeysByron

cardano-api/internal/Cardano/Api/Certificate.hs

@@ -73,6 +73,7 @@ module Cardano.Api.Certificate
     -- * Internal functions
   , filterUnRegCreds
   , filterUnRegDRepCreds
+  , isDRepRegOrUpdateCert
   )
 where
 
@@ -793,3 +794,16 @@ getAnchorDataFromCertificate c =
             , Ledger.anchorDataHash = Ledger.unsafeMakeSafeHash hash
             }
         )
+
+-- | Returns `True` if the certificate is a DRep registration or update certificate,
+-- otherwise `False`. This is to see if the certificate needs to be compliant with
+-- CIP-0119.
+isDRepRegOrUpdateCert :: Certificate era -> Bool
+isDRepRegOrUpdateCert = \case
+  ShelleyRelatedCertificate _ _ -> False
+  ConwayCertificate ceo ccert ->
+    conwayEraOnwardsConstraints ceo $
+      case ccert of
+        Ledger.RegDRepTxCert{} -> True
+        Ledger.UpdateDRepTxCert{} -> True
+        _ -> False

cardano-api/internal/Cardano/Api/DRepMetadata.hs

@@ -1,4 +1,7 @@
+{-# LANGUAGE DeriveGeneric #-}
 {-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE InstanceSigs #-}
+{-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE TypeFamilies #-}
 
 -- | DRep off-chain metadata
@@ -10,10 +13,12 @@ module Cardano.Api.DRepMetadata
     -- * Data family instances
   , AsType (..)
   , Hash (..)
+  , validateDRepAnchorData
   )
 where
 
 import           Cardano.Api.Eras
+import           Cardano.Api.GeneralParsers (textWithMaxLength)
 import           Cardano.Api.Hash
 import           Cardano.Api.HasTypeProxy
 import           Cardano.Api.Keys.Byron
@@ -25,8 +30,13 @@ import qualified Cardano.Crypto.Hash.Class as Crypto
 import           Cardano.Ledger.Crypto (StandardCrypto)
 import qualified Cardano.Ledger.Keys as Shelley
 
+import           Data.Aeson (FromJSON, withObject, (.:), (.:?))
+import qualified Data.Aeson as Aeson
+import           Data.Aeson.Types (Parser)
 import           Data.ByteString (ByteString)
-import           Data.Either.Combinators (maybeToRight)
+import           Data.Either.Combinators (mapRight, maybeToRight)
+import           Data.Text (Text)
+import           GHC.Generics (Generic)
 
 -- ----------------------------------------------------------------------------
 -- DRep metadata
@@ -43,11 +53,15 @@ newtype instance Hash DRepMetadata = DRepMetadataHash (Shelley.Hash StandardCryp
 
 instance HasTypeProxy DRepMetadata where
   data AsType DRepMetadata = AsDRepMetadata
+  proxyToAsType :: Proxy DRepMetadata -> AsType DRepMetadata
   proxyToAsType _ = AsDRepMetadata
 
 instance SerialiseAsRawBytes (Hash DRepMetadata) where
+  serialiseToRawBytes :: Hash DRepMetadata -> ByteString
   serialiseToRawBytes (DRepMetadataHash h) = Crypto.hashToBytes h
 
+  deserialiseFromRawBytes
+    :: AsType (Hash DRepMetadata) -> ByteString -> Either SerialiseAsRawBytesError (Hash DRepMetadata)
   deserialiseFromRawBytes (AsHash AsDRepMetadata) bs =
     maybeToRight (SerialiseAsRawBytesError "Unable to deserialise Hash DRepMetadata") $
       DRepMetadataHash <$> Crypto.hashFromBytes bs
@@ -60,3 +74,116 @@ hashDRepMetadata bs =
   let md = DRepMetadata bs
       mdh = DRepMetadataHash (Crypto.hashWith id bs)
    in (md, mdh)
+
+-- * DRep metadata validation
+
+-- | Root document
+data CIP119Common = CIP119Common
+  { hashAlgorithm :: HashAlgorithm
+  , body :: Body
+  }
+  deriving (Show, Generic)
+
+instance FromJSON CIP119Common where
+  parseJSON :: Aeson.Value -> Parser CIP119Common
+  parseJSON = withObject "CIP119Common" $ \v ->
+    CIP119Common
+      <$> v .: "hashAlgorithm"
+      <*> v .: "body"
+
+-- Hash Algorithm (Enum)
+data HashAlgorithm = Blake2b256
+  deriving (Show, Generic)
+
+instance FromJSON HashAlgorithm where
+  parseJSON :: Aeson.Value -> Parser HashAlgorithm
+  parseJSON = Aeson.withText "HashAlgorithm" $
+    \case
+      "blake2b-256" -> return Blake2b256
+      _ -> fail "Invalid hashAlgorithm, it must be: blake2b-256"
+
+-- Body of the metadata document
+data Body = Body
+  { paymentAddress :: Maybe Text
+  , givenName :: Text
+  , image :: Maybe ImageObject
+  , objectives :: Maybe Text
+  , motivations :: Maybe Text
+  , qualifications :: Maybe Text
+  , doNotList :: Maybe DoNotList
+  , references :: Maybe [Reference]
+  }
+  deriving (Show, Generic)
+
+instance FromJSON Body where
+  parseJSON :: Aeson.Value -> Parser Body
+  parseJSON = withObject "Body" $ \v ->
+    Body
+      <$> v .:? "paymentAddress"
+      <*> (v .: "givenName" >>= textWithMaxLength "givenName" 80)
+      <*> v .:? "image"
+      <*> (v .:? "objectives" >>= traverse (textWithMaxLength "objectives" 1000))
+      <*> (v .:? "motivations" >>= traverse (textWithMaxLength "motivations" 1000))
+      <*> (v .:? "qualifications" >>= traverse (textWithMaxLength "qualifications" 1000))
+      <*> v .:? "doNotList"
+      <*> v .:? "references"
+
+-- Profile picture
+data ImageObject = ImageObject
+  { contentUrl :: Text -- Base64 encoded image or URL
+  , sha256 :: Maybe Text -- Only present for URL images
+  }
+  deriving (Show, Generic)
+
+instance FromJSON ImageObject where
+  parseJSON :: Aeson.Value -> Parser ImageObject
+  parseJSON = withObject "ImageObject" $ \v ->
+    ImageObject
+      <$> v .: "contentUrl"
+      <*> v .:? "sha256"
+
+-- DoNotList Enum
+data DoNotList = DoNotListTrue | DoNotListFalse
+  deriving (Show, Generic)
+
+instance FromJSON DoNotList where
+  parseJSON :: Aeson.Value -> Parser DoNotList
+  parseJSON = Aeson.withText "DoNotList" $
+    \case
+      "true" -> return DoNotListTrue
+      "false" -> return DoNotListFalse
+      _ -> fail "Invalid doNotList value, must be one of: true, false"
+
+-- Reference type
+data Reference = Reference
+  { refType :: ReferenceType
+  , label :: Text
+  , uri :: Text
+  }
+  deriving (Show, Generic)
+
+instance FromJSON Reference where
+  parseJSON :: Aeson.Value -> Parser Reference
+  parseJSON = withObject "Reference" $ \v ->
+    Reference
+      <$> v .: "@type"
+      <*> v .: "label"
+      <*> v .: "uri"
+
+-- ReferenceType Enum
+data ReferenceType = GovernanceMetadata | Other | Link | Identity
+  deriving (Show, Generic)
+
+instance FromJSON ReferenceType where
+  parseJSON :: Aeson.Value -> Parser ReferenceType
+  parseJSON = Aeson.withText "ReferenceType" $
+    \case
+      "GovernanceMetadata" -> return GovernanceMetadata
+      "Other" -> return Other
+      "Link" -> return Link
+      "Identity" -> return Identity
+      _ ->
+        fail "Invalid reference type, must be one of: GovernanceMetadata, Other, Link, Identity"
+
+validateDRepAnchorData :: DRepMetadata -> Either String ()
+validateDRepAnchorData (DRepMetadata bytes) = mapRight (const ()) (Aeson.eitherDecodeStrict bytes :: Either String CIP119Common)

cardano-api/internal/Cardano/Api/GeneralParsers.hs

@@ -0,0 +1,22 @@
+module Cardano.Api.GeneralParsers (textWithMaxLength) where
+
+import           Data.Aeson.Types (Parser, Value, parseJSON)
+import           Data.Text (Text)
+import qualified Data.Text as T
+
+-- | Parser for 'Text' that validates that the number of characters is
+-- under a given maximum. The 'String' parameter is meant to be the name
+-- of the field in order to be able to give context in case of error.
+textWithMaxLength :: String -> Int -> Value -> Parser Text
+textWithMaxLength fieldName maxLen value = do
+  txt <- parseJSON value
+  if T.length txt <= maxLen
+    then pure txt
+    else
+      fail $
+        "key \""
+          ++ fieldName
+          ++ "\" exceeds maximum length of "
+          ++ show maxLen
+          ++ " characters. Got length: "
+          ++ show (T.length txt)

cardano-api/internal/Cardano/Api/Governance/Actions/MetadataValidation.hs

@@ -0,0 +1,151 @@
+{-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE InstanceSigs #-}
+{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE OverloadedStrings #-}
+
+module Cardano.Api.Governance.Actions.MetadataValidation (validateGovActionAnchorData) where
+
+import           Cardano.Api.GeneralParsers (textWithMaxLength)
+
+import           Data.Aeson (eitherDecodeStrict)
+import           Data.Aeson.Types (FromJSON (..), Parser, Value, withObject, withText, (.:), (.:?))
+import           Data.ByteString (ByteString)
+import           Data.Either.Combinators (mapRight)
+import           Data.Text (Text)
+import           GHC.Generics (Generic)
+
+validateGovActionAnchorData :: ByteString -> Either String ()
+validateGovActionAnchorData bytes = mapRight (const ()) (eitherDecodeStrict bytes :: Either String CIP108Common)
+
+-- Root object: CIP-108 Common
+data CIP108Common = CIP108Common
+  { hashAlgorithm :: HashAlgorithm
+  , authors :: [Author]
+  , body :: Body
+  }
+  deriving (Show, Generic)
+
+instance FromJSON CIP108Common where
+  parseJSON :: Value -> Parser CIP108Common
+  parseJSON = withObject "CIP108Common" $ \v ->
+    CIP108Common
+      <$> v .: "hashAlgorithm"
+      <*> v .: "authors"
+      <*> v .: "body"
+
+-- Enum for HashAlgorithm
+data HashAlgorithm = Blake2b256
+  deriving (Show, Generic)
+
+instance FromJSON HashAlgorithm where
+  parseJSON :: Value -> Parser HashAlgorithm
+  parseJSON = withText "HashAlgorithm" $
+    \case
+      "blake2b-256" -> return Blake2b256
+      _ -> fail "Invalid hashAlgorithm value, must be: blake2b-256"
+
+-- Author object
+data Author = Author
+  { name :: Maybe Text
+  , witness :: Witness
+  }
+  deriving (Show, Generic)
+
+instance FromJSON Author where
+  parseJSON :: Value -> Parser Author
+  parseJSON = withObject "Author" $ \v ->
+    Author
+      <$> v .:? "name"
+      <*> v .: "witness"
+
+-- Witness object
+data Witness = Witness
+  { witnessAlgorithm :: Maybe WitnessAlgorithm
+  , publicKey :: Maybe Text
+  , signature :: Maybe Text
+  }
+  deriving (Show, Generic)
+
+instance FromJSON Witness where
+  parseJSON :: Value -> Parser Witness
+  parseJSON = withObject "Witness" $ \v ->
+    Witness
+      <$> v .:? "witnessAlgorithm"
+      <*> v .:? "publicKey"
+      <*> v .:? "signature"
+
+-- Enum for WitnessAlgorithm
+data WitnessAlgorithm = Ed25519 | CIP0008
+  deriving (Show, Generic)
+
+instance FromJSON WitnessAlgorithm where
+  parseJSON :: Value -> Parser WitnessAlgorithm
+  parseJSON = withText "WitnessAlgorithm" $
+    \case
+      "ed25519" -> return Ed25519
+      "CIP-0008" -> return CIP0008
+      _ -> fail "Invalid witnessAlgorithm value, must be: ed25519 or CIP-0008"
+
+-- Body of the metadata document
+data Body = Body
+  { title :: Text
+  , abstract :: Text
+  , motivation :: Text
+  , rationale :: Text
+  , references :: Maybe [Reference]
+  }
+  deriving (Show, Generic)
+
+instance FromJSON Body where
+  parseJSON :: Value -> Parser Body
+  parseJSON = withObject "Body" $ \v ->
+    Body
+      <$> (v .: "title" >>= textWithMaxLength "title" 80)
+      <*> (v .: "abstract" >>= textWithMaxLength "abstract" 2500)
+      <*> v .: "motivation"
+      <*> v .: "rationale"
+      <*> v .:? "references"
+
+-- Reference object
+data Reference = Reference
+  { refType :: ReferenceType
+  , label :: Text
+  , uri :: Text
+  , referenceHash :: Maybe ReferenceHash
+  }
+  deriving (Show, Generic)
+
+instance FromJSON Reference where
+  parseJSON :: Value -> Parser Reference
+  parseJSON = withObject "Reference" $ \v ->
+    Reference
+      <$> v .: "@type"
+      <*> v .: "label"
+      <*> v .: "uri"
+      <*> v .:? "referenceHash"
+
+-- Enum for ReferenceType
+data ReferenceType = GovernanceMetadata | Other
+  deriving (Show, Generic)
+
+instance FromJSON ReferenceType where
+  parseJSON :: Value -> Parser ReferenceType
+  parseJSON = withText "ReferenceType" $
+    \case
+      "GovernanceMetadata" -> return GovernanceMetadata
+      "Other" -> return Other
+      _ -> fail "Invalid reference type, must be one of: GovernanceMetadata, Other"
+
+-- ReferenceHash object
+data ReferenceHash = ReferenceHash
+  { referenceHashDigest :: Text
+  , referenceHashAlgorithm :: HashAlgorithm
+  }
+  deriving (Show, Generic)
+
+instance FromJSON ReferenceHash where
+  parseJSON :: Value -> Parser ReferenceHash
+  parseJSON = withObject "ReferenceHash" $ \v ->
+    ReferenceHash
+      <$> v .: "hashDigest"
+      <*> v .: "hashAlgorithm"