Initial decimals support

lib/core/src/Cardano/Wallet/Primitive/Types/TokenPolicy.hs

@@ -28,6 +28,8 @@ module Cardano.Wallet.Primitive.Types.TokenPolicy
     , AssetURL (..)
     , AssetLogo (..)
     , AssetUnit (..)
+    , AssetDecimals (..)
+    , validateMetadataDecimals
     , validateMetadataName
     , validateMetadataTicker
     , validateMetadataDescription
@@ -207,6 +209,7 @@ data AssetMetadata = AssetMetadata
     , url :: Maybe AssetURL
     , logo :: Maybe AssetLogo
     , unit :: Maybe AssetUnit
+    , decimals :: Maybe AssetDecimals
     } deriving stock (Eq, Ord, Generic)
     deriving (Show) via (Quiet AssetMetadata)
 
@@ -243,6 +246,21 @@ instance ToText AssetURL where
 instance FromText AssetURL where
     fromText = first TextDecodingError . validateMetadataURL
 
+newtype AssetDecimals = AssetDecimals
+  { unAssetDecimals :: Int
+  } deriving (Eq, Ord, Generic)
+  deriving (Show) via (Quiet AssetDecimals)
+
+instance NFData AssetDecimals
+
+instance ToText AssetDecimals where
+  toText = T.pack . show . unAssetDecimals
+
+instance FromText AssetDecimals where
+  fromText t = do
+    unvalidated <- AssetDecimals <$> fromText t
+    first TextDecodingError $ validateMetadataDecimals unvalidated
+
 validateMinLength :: Int -> Text -> Either String Text
 validateMinLength n text
     | len >= n = Right text
@@ -294,3 +312,8 @@ validateMetadataLogo logo
   where
     len = BS.length $ unAssetLogo logo
     maxLen = 65536
+
+validateMetadataDecimals :: AssetDecimals -> Either String AssetDecimals
+validateMetadataDecimals (AssetDecimals n)
+  | n >= 0 && n <= 255 = Right $ AssetDecimals n
+  | otherwise          = Left $ "Decimal value must be between [0, 255] inclusive."

lib/core/src/Cardano/Wallet/TokenMetadata.hs

@@ -86,12 +86,14 @@ import Cardano.Wallet.Primitive.Types.Hash
 import Cardano.Wallet.Primitive.Types.TokenMap
     ( AssetId (..) )
 import Cardano.Wallet.Primitive.Types.TokenPolicy
-    ( AssetLogo (..)
+    ( AssetDecimals (..)
+    , AssetLogo (..)
     , AssetMetadata (..)
     , AssetURL (..)
     , AssetUnit (..)
     , TokenName (..)
     , TokenPolicyId (..)
+    , validateMetadataDecimals
     , validateMetadataDescription
     , validateMetadataLogo
     , validateMetadataName
@@ -113,6 +115,7 @@ import Data.Aeson
     , eitherDecodeStrict'
     , encode
     , withObject
+    , withScientific
     , withText
     , (.!=)
     , (.:)
@@ -138,6 +141,8 @@ import Data.Maybe
     ( catMaybes, mapMaybe )
 import Data.Proxy
     ( Proxy (..) )
+import Data.Scientific
+    ( toBoundedInteger )
 import Data.String
     ( IsString (..) )
 import Data.Text
@@ -146,6 +151,8 @@ import Data.Text.Class
     ( ToText (..) )
 import Data.Time.Clock
     ( DiffTime )
+import Data.Word
+    ( Word64 )
 import GHC.Generics
     ( Generic )
 import GHC.TypeLits
@@ -231,6 +238,7 @@ data SubjectProperties = SubjectProperties
         , Maybe (Property "url")
         , Maybe (Property "logo")
         , Maybe (Property "unit")
+        , Maybe (Property "decimals")
         )
     } deriving (Generic, Show, Eq)
 
@@ -268,6 +276,7 @@ type instance PropertyValue "ticker" = Text
 type instance PropertyValue "url" = AssetURL
 type instance PropertyValue "unit" = AssetUnit
 type instance PropertyValue "logo" = AssetLogo
+type instance PropertyValue "decimals" = AssetDecimals
 
 class HasValidator (name :: Symbol) where
     -- TODO: requires AllowAmbiguousTypes extension
@@ -286,6 +295,8 @@ instance HasValidator "logo" where
     validatePropertyValue = validateMetadataLogo
 instance HasValidator "unit" where
     validatePropertyValue = validateMetadataUnit
+instance HasValidator "decimals" where
+    validatePropertyValue = validateMetadataDecimals
 
 -- | Will be used in future for checking integrity and authenticity of metadata.
 data Signature = Signature
@@ -503,8 +514,9 @@ metadataFromProperties (SubjectProperties _ _ properties) =
         <*> pure (getValue url)
         <*> pure (getValue logo)
         <*> pure (getValue unit)
+        <*> pure (getValue decimals)
   where
-    ( name, description, ticker, url, logo, unit ) = properties
+    ( name, description, ticker, url, logo, unit, decimals ) = properties
     getValue :: Maybe (Property a) -> Maybe (PropertyValue a)
     getValue = (>>= (either (const Nothing) Just . value))
 
@@ -536,13 +548,14 @@ instance FromJSON SubjectProperties where
         <*> o .:? "owner"
         <*> parseProperties o
       where
-        parseProperties o = (,,,,,)
+        parseProperties o = (,,,,,,)
             <$> prop @"name" o
             <*> prop @"description" o
             <*> prop @"ticker" o
             <*> prop @"url" o
             <*> prop @"logo" o
             <*> prop @"unit" o
+            <*> prop @"decimals" o
 
         prop
             :: forall name. (KnownSymbol name, FromJSON (Property name))
@@ -587,6 +600,12 @@ instance FromJSON AssetUnit where
         <$> o .: "name"
         <*> o .: "decimals"
 
+instance FromJSON AssetDecimals where
+    parseJSON = withScientific "AssetDecimals" $ \sci ->
+      case toBoundedInteger sci of
+        Nothing            -> fail "AssetDecimals must be an integer"
+        Just (n :: Word64) -> applyValidator validateMetadataDecimals (AssetDecimals $ fromIntegral n)
+
 --
 -- Helpers
 --

lib/core/src/Cardano/Wallet/TokenMetadata/MockServer.hs

@@ -36,7 +36,8 @@ import Cardano.Wallet.Primitive.Types.Hash
 import Cardano.Wallet.Primitive.Types.TokenMap
     ( AssetId (..) )
 import Cardano.Wallet.Primitive.Types.TokenPolicy
-    ( AssetLogo (..)
+    ( AssetDecimals (..)
+    , AssetLogo (..)
     , AssetURL (..)
     , AssetUnit (..)
     , TokenName (..)
@@ -171,9 +172,9 @@ queryServerStatic golden = do
         -> [SubjectProperties]
     filterResponse subs props = map filterProps . filter inSubs
       where
-        filterProps (SubjectProperties subject owner (a, b, c, d, e, f)) =
+        filterProps (SubjectProperties subject owner (a, b, c, d, e, f, g)) =
             SubjectProperties subject owner
-            (inProps a, inProps b, inProps c, inProps d, inProps e, inProps f)
+            (inProps a, inProps b, inProps c, inProps d, inProps e, inProps f, inProps g)
 
         inSubs sp = (view #subject sp) `Set.member` subs
 
@@ -202,7 +203,7 @@ assetIdFromSubject =
 instance FromJSON BatchRequest where
 
 instance ToJSON SubjectProperties where
-   toJSON (SubjectProperties s o (n,d,a,u,l,t)) = object $
+   toJSON (SubjectProperties s o (n,d,a,u,l,t,dec)) = object $
        [ "subject" .= s
        , "owner" .= o
        ] ++ optionals
@@ -212,6 +213,7 @@ instance ToJSON SubjectProperties where
        , "url" .= u
        , "logo" .= l
        , "unit" .= t
+       , "decimals" .= dec
        ]
      where
        optionals = filter ((/= Null) . snd)
@@ -247,3 +249,6 @@ instance ToJSON AssetUnit where
 
 instance ToJSON AssetURL where
     toJSON = toJSON . show . unAssetURL
+
+instance ToJSON AssetDecimals where
+  toJSON = toJSON . show . unAssetDecimals