Initial commit of decimals support

Author: sevanspowell

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

@@ -11,6 +11,7 @@ module Test.Cardano.Metadata.Validation
 import qualified Data.Aeson as Aeson
 import Data.Foldable
     ( forM_, traverse_ )
+import Data.Maybe (fromJust)
 import Data.Int
     ( Int32, Int64, Int8 )
 import qualified Data.List.NonEmpty as NE
@@ -48,6 +49,7 @@ import Cardano.Metadata.Types.Common
     , File (File)
     , Subject (Subject)
     , attestedSignatures
+    , attestedSequenceNumber
     , attestedValue
     , deserialiseAttestationSignature
     , deserialiseBase16
@@ -60,6 +62,8 @@ import Cardano.Metadata.Types.Common
 import Cardano.Metadata.Validation.Rules
     ( ValidationError (ErrorMetadataFileBaseNameLengthBounds, ErrorMetadataFileExpectedExtension, ErrorMetadataFileNameDoesntMatchSubject, ErrorMetadataFileTooBig, ErrorMetadataPropertySequenceNumberMustBeLarger)
     , ValidationError_
+    , defaultRules
+    , apply
     , baseFileNameLengthBounds
     , isJSONFile
     , maxFileSizeBytes
@@ -93,6 +97,7 @@ 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
       ]
   ]
 
@@ -232,6 +237,34 @@ 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 :: Metadata
+    before = fromJust $ Aeson.decode' [r|
+                  {
+                    "subject": "1234",
+                    "prop": {
+                      "value": "hello",
+                      "sequenceNumber": 0
+                    }
+                  }
+                  |]
+    after :: Metadata
+    after = fromJust $ Aeson.decode' [r|
+                  {
+                    "subject": "1234",
+                    "prop": {
+                      "value": "goodbye",
+                      "sequenceNumber": 0
+                    }
+                  }
+                  |]
+    diff = Changed (File before undefined undefined) (File after undefined undefined)
+  
+  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 (AttestationFieldDescription, AttestationFieldLogo, AttestationFieldName, AttestationFieldTicker, AttestationFieldUrl, AttestationFieldDecimals)
     , 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

@@ -21,6 +21,7 @@ import Cardano.Metadata.Types
     , Subject (..)
     , Ticker (..)
     , Url (..)
+    , Decimals (..)
     , WellKnownProperty (..)
     , evaluatePolicy
     , hashesForAttestation
@@ -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

@@ -1,5 +1,6 @@
 {-# LANGUAGE CPP #-}
 {-# LANGUAGE DataKinds #-}
+{-# LANGUAGE StandaloneDeriving #-}
 {-# LANGUAGE DeriveTraversable #-}
 {-# LANGUAGE DerivingStrategies #-}
 {-# LANGUAGE FlexibleContexts #-}
@@ -33,6 +34,7 @@ module Cardano.Metadata.Types
     , Logo (..)
     , Url(..)
     , Ticker(..)
+    , Decimals(..)
 
       -- * Attestation
     , Attested (..)
@@ -96,6 +98,7 @@ import Control.Category
     ( id )
 import Control.Monad.Fail
     ( fail )
+import Data.Scientific (toBoundedInteger, Scientific)
 import Data.Aeson
     ( FromJSON (..), ToJSON (..), (.:), (.=) )
 import Data.Maybe
@@ -131,7 +134,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 +161,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 =
+    Aeson.withScientific "decimals" validateMetadataDecimals
+
 data Policy = Policy
     { rawPolicy :: Text
     , getPolicy :: ScriptInEra MaryEra
-    } deriving Show
+    } deriving (Eq, Show)
 
 instance WellKnownProperty Policy where
     wellKnownPropertyName _ =
@@ -372,6 +388,13 @@ validateMetadataDescription :: MonadFail f => Text -> f Description
 validateMetadataDescription = fmap Description .
     validateMaxLength 500
 
+validateMetadataDecimals :: MonadFail f => Scientific -> f Decimals
+validateMetadataDecimals s =
+  case toBoundedInteger s of
+    Nothing                     -> fail $ "Expected integral, but encountered float: " <> show s
+    Just i | i >= 0 && i <= 255 -> pure $ Decimals i
+    Just _ | otherwise          -> fail $ "Decimal value must be in the range [0, 255] (inclusive)"
+
 validateMetadataLogo :: MonadFail f => ByteString -> f Logo
 validateMetadataLogo bytes
     | len <= maxLen =
@@ -404,7 +427,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 +489,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 +536,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