Merge #23

23: Support for decimals r=sevanspowell a=sevanspowell

ADP-915
- Provide support for the decimals field in offchain-metadata-tools.
- Add a test to demonstrate the _**existing**_ behaviour that sequence numbers present in unknown properties are validated.

Co-authored-by: Samuel Evans-Powell <mail@sevanspowell.net>

Author: iohk-bors[bot]

metadata-lib/metadata-lib.cabal

@@ -103,6 +103,7 @@ test-suite unit-tests
                 , QuickCheck
                 , aeson
                 , aeson-pretty
+                , aeson-qq
                 , base >=4.12 && <5
                 , base64-bytestring
                 , bytestring

metadata-lib/test/Test/Cardano/Metadata/Validation.hs

@@ -9,6 +9,10 @@ module Test.Cardano.Metadata.Validation
   ) where
 
 import qualified Data.Aeson as Aeson
+import qualified Data.Aeson.Encode.Pretty as Aeson
+import Data.Aeson.QQ
+    ( aesonQQ )
+import qualified Data.ByteString.Lazy as BSL
 import Data.Foldable
     ( forM_, traverse_ )
 import Data.Int
@@ -47,6 +51,7 @@ import Cardano.Metadata.Types.Common
     , AttestedProperty (AttestedProperty)
     , File (File)
     , Subject (Subject)
+    , attestedSequenceNumber
     , attestedSignatures
     , attestedValue
     , deserialiseAttestationSignature
@@ -56,11 +61,14 @@ import Cardano.Metadata.Types.Common
     , seqSucc
     , seqZero
     , unSequenceNumber
+    , unSubject
     )
 import Cardano.Metadata.Validation.Rules
     ( ValidationError (ErrorMetadataFileBaseNameLengthBounds, ErrorMetadataFileExpectedExtension, ErrorMetadataFileNameDoesntMatchSubject, ErrorMetadataFileTooBig, ErrorMetadataPropertySequenceNumberMustBeLarger)
     , ValidationError_
+    , apply
     , baseFileNameLengthBounds
+    , defaultRules
     , isJSONFile
     , maxFileSizeBytes
     , sequenceNumber
@@ -73,6 +81,7 @@ import Cardano.Metadata.Validation.Types
     , Metadata (Metadata)
     , invalid
     , metaAttestedProperties
+    , metaSubject
     , metaVerifiableProperties
     , onMatchingAttestedProperties
     , valid
@@ -93,9 +102,25 @@ tests = testGroup "Validation tests"
       , testProperty "Validation/rules/isJSONFile" prop_rules_isJSONFile
       , testProperty "Validation/rules/baseFileNameLengthBounds" prop_rules_baseFileNameLengthBounds
       , testProperty "Validation/helpers/toAttestedPropertyDiffs" prop_helpers_toAttestedPropertyDiffs
+      , testCase "Unknown but well-formed properties have sequence numbers validated" unit_sequence_number_of_unknown_property_validated
       ]
   ]
 
+-- | From a JSON value, parse some Metadata and use the length of the
+-- pretty encoded JSON value and parsed Subject to make a well-formed
+-- File.
+asMetadataFile :: Aeson.Value -> File Metadata
+asMetadataFile json =
+  let
+    -- Prettily print the JSON to get a realistic and consistent file size
+    fileSize = BSL.length (Aeson.encodePretty json)
+    metadata = case Aeson.fromJSON json of
+      Aeson.Error err -> error err
+      Aeson.Success a -> a
+    fileName = unSubject (metaSubject metadata) <> ".json"
+  in
+    File metadata (fromIntegral fileSize) (T.unpack fileName)
+
 prop_rules_isJSONFile :: H.Property
 prop_rules_isJSONFile = property $ do
   -- All files with the ".json" extension should pass
@@ -232,6 +257,32 @@ prop_rules_subjectMatchesFileName = property $ do
   subjectMatchesFileName goodDiff
     === (valid :: Validation (NE.NonEmpty (ValidationError ())) ())
 
+unit_sequence_number_of_unknown_property_validated :: Assertion
+unit_sequence_number_of_unknown_property_validated = do
+  let
+    before = [aesonQQ|
+                  {
+                    "subject": "1234",
+                    "prop": {
+                      "value": "hello",
+                      "sequenceNumber": 0
+                    }
+                  }
+                  |]
+    after = [aesonQQ|
+                  {
+                    "subject": "1234",
+                    "prop": {
+                      "value": "goodbye",
+                      "sequenceNumber": 0
+                    }
+                  }
+                  |]
+    diff = Changed (asMetadataFile before) (asMetadataFile after)
+  
+  defaultRules `apply` diff
+   @?= (Failure (ErrorMetadataPropertySequenceNumberMustBeLarger (AttestedProperty {attestedValue = Aeson.String "hello", attestedSignatures = [], attestedSequenceNumber = seqFromNatural 0}) (AttestedProperty {attestedValue = Aeson.String "goodbye", attestedSignatures = [], attestedSequenceNumber = seqFromNatural 0}) (seqFromNatural 0) (seqFromNatural 0) NE.:| []) :: Validation (NE.NonEmpty (ValidationError ())) ())
+
 prop_rules_sequenceNumber :: H.Property
 prop_rules_sequenceNumber = property $ do
   -- Properties added or removed are always valid

shell.nix

@@ -17,12 +17,7 @@ let
   mkShell = name: project: project.shellFor rec {
     inherit name;
     packages = ps: lib.attrValues (selectProjectPackages ps);
-    buildInputs = (with metadataPackages; [
-      metadata-server
-      metadata-validator-github
-      metadata-webhook
-      token-metadata-creator
-    ]) ++ (with pkgs; [
+    buildInputs = (with pkgs; [
       haskellPackages.ghcid
       git
       hlint

token-metadata-creator/app/Config.hs

@@ -35,6 +35,7 @@ import qualified Options.Applicative as OA
 
 import qualified Data.Aeson as Aeson
 import qualified Data.Aeson.Types as Aeson
+import qualified Data.ByteString.Char8 as BC8
 import qualified Data.Text as T
 import qualified Text.Megaparsec as P
 
@@ -56,6 +57,7 @@ data AttestationField
     | AttestationFieldLogo
     | AttestationFieldUrl
     | AttestationFieldTicker
+    | AttestationFieldDecimals
     deriving (Show, Eq, Ord)
 
 data FileInfo = FileInfo
@@ -110,12 +112,14 @@ entryUpdateArgumentParser defaultSubject = EntryUpdateArguments
         , OA.flag' [AttestationFieldLogo] $ OA.long "attest-logo" <> OA.short 'L'
         , OA.flag' [AttestationFieldUrl] $ OA.long "attest-url" <> OA.short 'H'
         , OA.flag' [AttestationFieldTicker] $ OA.long "attest-ticker" <> OA.short 'T'
+        , OA.flag' [AttestationFieldDecimals] $ OA.long "attest-decimals"
         , pure
             [ AttestationFieldName
             , AttestationFieldDescription
             , AttestationFieldLogo
             , AttestationFieldUrl
             , AttestationFieldTicker
+            , AttestationFieldDecimals
             ]
        ]
 
@@ -150,6 +154,7 @@ entryUpdateArgumentParser defaultSubject = EntryUpdateArguments
         <*> pure Nothing -- logo
         <*> optional (emptyAttested <$> wellKnownOption (OA.long "url" <> OA.short 'h' <> OA.metavar "URL"))
         <*> optional (emptyAttested <$> wellKnownOption (OA.long "ticker" <> OA.short 't' <> OA.metavar "TICKER"))
+        <*> optional (emptyAttested <$> OA.option (OA.eitherReader ((Aeson.parseEither parseWellKnown =<<) . Aeson.eitherDecodeStrict . BC8.pack)) (OA.long "decimals" <>  OA.metavar "DECIMALS"))
 
 pLogSeverity :: OA.Parser Colog.Severity
 pLogSeverity = pDebug <|> pInfo <|> pWarning <|> pError <|> pure I

token-metadata-creator/app/token-metadata-creator.hs

@@ -73,7 +73,7 @@ import Cardano.Metadata.Validation.Wallet
 
 import Config
     ( Arguments (ArgumentsEntryUpdate, ArgumentsValidate)
-    , AttestationField (AttestationFieldDescription, AttestationFieldLogo, AttestationFieldName, AttestationFieldTicker, AttestationFieldUrl)
+    , AttestationField (AttestationFieldDecimals, AttestationFieldDescription, AttestationFieldLogo, AttestationFieldName, AttestationFieldTicker, AttestationFieldUrl)
     , DraftStatus (DraftStatusDraft, DraftStatusFinal)
     , EntryOperation (EntryOperationInitialize, EntryOperationRevise)
     , EntryUpdateArguments (EntryUpdateArguments)
@@ -123,6 +123,8 @@ combineRegistryEntries new old = GoguenRegistryEntry
         _goguenRegistryEntry_url new `combineAttestedEntry` _goguenRegistryEntry_url old
     , _goguenRegistryEntry_ticker =
         _goguenRegistryEntry_ticker new `combineAttestedEntry` _goguenRegistryEntry_ticker old
+    , _goguenRegistryEntry_decimals =
+        _goguenRegistryEntry_decimals new `combineAttestedEntry` _goguenRegistryEntry_decimals old
     }
   where
     combineAttestedEntry a b = case (a, b) of
@@ -153,6 +155,8 @@ attestFields (SomeSigningKey someSigningKey) props old = do
             attestField AttestationFieldUrl subj <$> _goguenRegistryEntry_url old
         , _goguenRegistryEntry_ticker =
             attestField AttestationFieldTicker subj <$> _goguenRegistryEntry_ticker old
+        , _goguenRegistryEntry_decimals =
+            attestField AttestationFieldDecimals subj <$> _goguenRegistryEntry_decimals old
         }
   where
     attestField
@@ -189,6 +193,7 @@ handleEntryUpdateArguments (EntryUpdateArguments fInfo keyfile props newEntryInf
             , _goguenRegistryEntry_logo = Nothing
             , _goguenRegistryEntry_url = Nothing
             , _goguenRegistryEntry_ticker = Nothing
+            , _goguenRegistryEntry_decimals = Nothing
             }
 
     policy <- case policyM of

token-metadata-creator/src/Cardano/Metadata/GoguenRegistry.hs

@@ -12,6 +12,7 @@ import Cardano.Prelude
 
 import Cardano.Metadata.Types
     ( Attested (..)
+    , Decimals (..)
     , Description (..)
     , Logo (..)
     , Logo (..)
@@ -53,6 +54,7 @@ data GoguenRegistryEntry f = GoguenRegistryEntry
     , _goguenRegistryEntry_logo :: f (Attested Logo)
     , _goguenRegistryEntry_url :: f (Attested Url)
     , _goguenRegistryEntry_ticker :: f (Attested Ticker)
+    , _goguenRegistryEntry_decimals :: f (Attested Decimals)
     }
 
 deriving instance
@@ -63,8 +65,20 @@ deriving instance
     , Show (f (Attested Logo))
     , Show (f (Attested Url))
     , Show (f (Attested Ticker))
+    , Show (f (Attested Decimals))
     ) => Show (GoguenRegistryEntry f)
 
+deriving instance
+    ( Eq (f Subject)
+    , Eq (f Policy)
+    , Eq (f (Attested Name))
+    , Eq (f (Attested Description))
+    , Eq (f (Attested Logo))
+    , Eq (f (Attested Url))
+    , Eq (f (Attested Ticker))
+    , Eq (f (Attested Decimals))
+    ) => Eq (GoguenRegistryEntry f)
+
 instance ToJSON (GoguenRegistryEntry Maybe) where
     toJSON r = Aeson.object $ mconcat
         [ [ "subject" .= _goguenRegistryEntry_subject r
@@ -82,6 +96,8 @@ instance ToJSON (GoguenRegistryEntry Maybe) where
                 <$> (_goguenRegistryEntry_url r)
           , (\x -> unProperty (wellKnownPropertyName (Proxy @Ticker)) .= fmap wellKnownToJSON x)
                 <$> (_goguenRegistryEntry_ticker r)
+          , (\x -> unProperty (wellKnownPropertyName (Proxy @Decimals)) .= fmap wellKnownToJSON x)
+                <$> (_goguenRegistryEntry_decimals r)
           ]
         ]
 
@@ -96,17 +112,19 @@ parseRegistryEntry = Aeson.withObject "GoguenRegistryEntry" $ \o -> do
     policyRaw <- o .:? unProperty (wellKnownPropertyName $ Proxy @Policy)
     policy <- mapM parseWellKnown policyRaw
 
-    nameField   <- o .:? unProperty (wellKnownPropertyName $ Proxy @Name)
-    descField   <- o .:? unProperty (wellKnownPropertyName $ Proxy @Description)
-    logoField   <- o .:? unProperty (wellKnownPropertyName $ Proxy @Logo)
-    urlField    <- o .:? unProperty (wellKnownPropertyName $ Proxy @Url)
-    tickerField <- o .:? unProperty (wellKnownPropertyName $ Proxy @Ticker)
+    nameField     <- o .:? unProperty (wellKnownPropertyName $ Proxy @Name)
+    descField     <- o .:? unProperty (wellKnownPropertyName $ Proxy @Description)
+    logoField     <- o .:? unProperty (wellKnownPropertyName $ Proxy @Logo)
+    urlField      <- o .:? unProperty (wellKnownPropertyName $ Proxy @Url)
+    tickerField   <- o .:? unProperty (wellKnownPropertyName $ Proxy @Ticker)
+    decimalsField <- o .:? unProperty (wellKnownPropertyName $ Proxy @Decimals)
 
     nameAnn   <- mapM parseWithAttestation nameField
     descAnn   <- mapM parseWithAttestation descField
     logoAnn   <- mapM parseWithAttestation logoField
     urlAnn    <- mapM parseWithAttestation urlField
     tickerAnn <- mapM parseWithAttestation tickerField
+    decimalsAnn <- mapM parseWithAttestation decimalsField
 
     pure $ GoguenRegistryEntry
         { _goguenRegistryEntry_subject = Subject <$> subject
@@ -116,6 +134,7 @@ parseRegistryEntry = Aeson.withObject "GoguenRegistryEntry" $ \o -> do
         , _goguenRegistryEntry_logo = logoAnn
         , _goguenRegistryEntry_url = urlAnn
         , _goguenRegistryEntry_ticker = tickerAnn
+        , _goguenRegistryEntry_decimals = decimalsAnn
         }
 
 validateEntry
@@ -151,6 +170,7 @@ validateEntry record = do
     forM_ (_goguenRegistryEntry_logo record) $ verifyLocalAttestations "logo"
     forM_ (_goguenRegistryEntry_url record) $ verifyLocalAttestations "url"
     forM_ (_goguenRegistryEntry_ticker record) $ verifyLocalAttestations "ticker"
+    forM_ (_goguenRegistryEntry_decimals record) $ verifyLocalAttestations "decimals"
   where
     verifyField :: (PartialGoguenRegistryEntry -> Maybe a) -> Either Text a
     verifyField field = maybe (Left missingFields) Right (field record)
@@ -159,7 +179,7 @@ validateEntry record = do
     missingFields = mconcat
         [ missingField "Missing field subject"
             _goguenRegistryEntry_subject
-        , missingField "Missing field policy: Use -p to speciy"
+        , missingField "Missing field policy: Use -p to specify"
             _goguenRegistryEntry_policy
         , missingField "Missing field name: Use -n to specify"
             _goguenRegistryEntry_name

token-metadata-creator/src/Cardano/Metadata/Types.hs

@@ -8,6 +8,7 @@
 {-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE RankNTypes #-}
 {-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE StandaloneDeriving #-}
 {-# LANGUAGE TypeApplications #-}
 {-# LANGUAGE ViewPatterns #-}
 
@@ -33,6 +34,7 @@ module Cardano.Metadata.Types
     , Logo (..)
     , Url(..)
     , Ticker(..)
+    , Decimals(..)
 
       -- * Attestation
     , Attested (..)
@@ -131,7 +133,7 @@ import qualified Shelley.Spec.Ledger.Keys as Shelley
 --
 
 newtype Subject = Subject { unSubject :: Text }
-    deriving stock Show
+    deriving stock (Eq, Show)
     deriving newtype (ToJSON)
 
 hashSubject :: Subject -> Hash Blake2b_256 Subject
@@ -158,10 +160,23 @@ newtype Property = Property { unProperty :: Text }
 hashProperty :: Property -> Hash Blake2b_256 Property
 hashProperty = hashWith (CBOR.toStrictByteString . CBOR.encodeString . unProperty)
 
+newtype Decimals = Decimals { unDecimals :: Int }
+  deriving (Eq, Show)
+
+instance WellKnownProperty Decimals where
+  wellKnownPropertyName _ =
+    Property "decimals"
+  wellKnownToBytes =
+    CBOR.encodeInt . unDecimals
+  wellKnownToJSON =
+    toJSON . unDecimals
+  parseWellKnown =
+    parseJSON >=> validateMetadataDecimals
+
 data Policy = Policy
     { rawPolicy :: Text
     , getPolicy :: ScriptInEra MaryEra
-    } deriving Show
+    } deriving (Eq, Show)
 
 instance WellKnownProperty Policy where
     wellKnownPropertyName _ =
@@ -372,6 +387,11 @@ validateMetadataDescription :: MonadFail f => Text -> f Description
 validateMetadataDescription = fmap Description .
     validateMaxLength 500
 
+validateMetadataDecimals :: MonadFail f => Int -> f Decimals
+validateMetadataDecimals i
+  | i >= 0 && i <= 255 = pure $ Decimals i
+  | otherwise          = fail $ "Decimal value must be in the range [0, 255] (inclusive)"
+
 validateMetadataLogo :: MonadFail f => ByteString -> f Logo
 validateMetadataLogo bytes
     | len <= maxLen =
@@ -404,7 +424,7 @@ data Attested a = Attested
     { _attested_signatures :: [AttestationSignature]
     , _attested_sequence_number :: SequenceNumber
     , _attested_property :: a
-    } deriving (Functor, Show)
+    } deriving (Eq, Functor, Show)
 
 instance ToJSON a => ToJSON (Attested a) where
     toJSON a = Aeson.object
@@ -466,7 +486,7 @@ parseWithAttestation = Aeson.withObject "property with attestation" $ \o -> do
 data AttestationSignature = AttestationSignature
     { _attestationSignature_publicKey :: VerKeyDSIGN Ed25519DSIGN
     , _attestationSignature_signature :: SigDSIGN Ed25519DSIGN
-    } deriving Show
+    } deriving (Eq, Show)
 
 instance ToJSON AttestationSignature where
     toJSON a = Aeson.object
@@ -513,10 +533,12 @@ hashSequenceNumber =
 
 data SomeSigningKey where
     SomeSigningKey
-        :: forall keyrole. (MakeAttestationSignature keyrole)
+        :: forall keyrole. (MakeAttestationSignature keyrole, Show (SigningKey keyrole))
         => SigningKey keyrole
         -> SomeSigningKey
 
+deriving instance Show (SomeSigningKey)
+
 -- | Hashes required to produce a message for attestation purposes
 data HashesForAttestation = HashesForAttestation
     { _hashesForAttestation_subject :: Hash Blake2b_256 Subject