untested toJSON instance for CIP-25 metadata

marlowe-integration-tests/test/Language/Marlowe/Runtime/CliSpec.hs

@@ -48,18 +48,6 @@ marloweRuntimeJobClient cmd = do
   (Either.fromRight (error "Some JobClient creation error!") -> ContractCreated {txBody}) <- runMarloweTxClient $ JobClient.liftCommand cmd
   pure txBody
 
-{-
-data RoleTokensConfig
-  = RoleTokensNone
-  | RoleTokensUsePolicy PolicyId
-  | RoleTokensMint Mint
-
-PolicyId ~ ByteString
-Mint ~ Map TokenName (Address, Either Natural (Maybe NFTMetadata))
-
-https://cips.cardano.org/cips/cip25/
--}
-
 {-
 TODO make PR and go home
 TODO find out if zerging will work for this suite

marlowe-runtime/marlowe-runtime.cabal

@@ -289,6 +289,7 @@ library tx-api
     , binary
     , cardano-api
     , bytestring
+    , text
     , containers
     , marlowe-chain-sync
     , marlowe-protocols

marlowe-runtime/tx-api/Language/Marlowe/Runtime/Transaction/Api.hs

@@ -4,7 +4,9 @@
 {-# LANGUAGE EmptyDataDeriving #-}
 {-# LANGUAGE FlexibleInstances #-}
 {-# LANGUAGE GADTs #-}
+{-# LANGUAGE OverloadedLists #-}
 {-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE ViewPatterns #-}
 
 module Language.Marlowe.Runtime.Transaction.Api
   ( ApplyInputsConstraintsBuildupError(..)
@@ -41,6 +43,7 @@ import Cardano.Api
   , serialiseToTextEnvelope
   )
 import Data.Aeson (FromJSON, ToJSON(..), object, (.=))
+import qualified Data.Aeson as Aeson
 import Data.Binary (Binary, Get, get, getWord8, put)
 import Data.Binary.Put (Put, putWord8)
 import Data.ByteString (ByteString)
@@ -49,6 +52,7 @@ import qualified Data.List.NonEmpty as NonEmpty
 import Data.Map (Map)
 import qualified Data.Map.Strict as Map
 import Data.Set (Set)
+import Data.Text (Text)
 import Data.Time (UTCTime)
 import Data.Type.Equality (type (:~:)(Refl))
 import Data.Void (Void, absurd)
@@ -78,6 +82,76 @@ import Language.Marlowe.Runtime.History.Api (ExtractCreationError, ExtractMarlow
 import Network.Protocol.Handshake.Types (HasSignature(..))
 import Network.Protocol.Job.Types
 
+data CIP25MetadataFileDetails = CIP25MetadataFileDetails
+  { name :: Text
+  , mediaType :: Text
+  , src :: [Text]
+  }
+  deriving stock (Show, Eq, Ord, Generic)
+
+instance Aeson.ToJSON CIP25MetadataFileDetails where
+  toJSON CIP25MetadataFileDetails {..} = Aeson.Object $
+      [ ("name", Aeson.String name)
+      , ("mediaType", Aeson.String mediaType)
+      ]
+        <> case src of
+          [x] -> [("src", Aeson.String x)]
+          xs  -> [("src", toJSON xs)]
+
+data CIP25MetadataDetails = CIP25MetadataDetails
+  { name :: Text
+  , image :: [Text]
+  , mediaType :: Maybe Text
+  , description :: [Text]
+  , files :: [CIP25MetadataFileDetails]
+  }
+  deriving stock (Show, Eq, Ord, Generic)
+
+instance Aeson.ToJSON CIP25MetadataDetails where
+  toJSON CIP25MetadataDetails {..} =
+    Aeson.Object $
+      [ ("name", Aeson.String name) ]
+        <> case image of
+            [x] -> [("image", Aeson.String x)]
+            xs  -> [("image", toJSON xs)]
+        <> case mediaType of
+            Nothing -> []
+            Just x  -> [("mediatype", Aeson.String x)]
+        <> case description of
+            []  -> []
+            [x] -> [("description", Aeson.String x)]
+            xs  -> [("description", toJSON xs)]
+        <> case files of
+            [] -> []
+            xs -> [("files", toJSON xs)]
+
+data CIP25MetadataLabel = CIP25MetadataLabel
+  { policyIds :: Map PolicyId (Map TokenName CIP25MetadataDetails)
+  , version :: Maybe Int
+  }
+  deriving stock (Show, Eq, Ord, Generic)
+
+instance Aeson.ToJSON CIP25MetadataLabel where
+  toJSON = \case
+    CIP25MetadataLabel {version = Nothing, policyIds} -> toJSON policyIds
+    CIP25MetadataLabel {version = Just 1, policyIds = toJSON -> Aeson.Object policyIds} ->
+      -- // TODO test this to make sure it's correct!
+      Aeson.Object (policyIds <> [("version", Aeson.Number 1)])
+    CIP25MetadataLabel {version = Just 2, policyIds = toJSON -> Aeson.Object policyIds} ->
+      -- // TODO test this to make sure it's correct!
+      Aeson.Object (policyIds <> [("version", Aeson.Number 2)])
+    CIP25MetadataLabel {version = Just n} -> error $ "Unknown version " <> show n
+
+-- // TODO test this to make sure it's correct!
+newtype CIP25Metadata = CIP25Metadata
+  { transactionMetadatumLabel :: CIP25MetadataLabel
+  }
+  deriving stock (Show, Eq, Ord, Generic)
+
+instance Aeson.ToJSON CIP25Metadata where
+  toJSON CIP25Metadata {..} = Aeson.Object
+    [("721", toJSON transactionMetadatumLabel)]
+
 -- CIP-25 metadata
 newtype NFTMetadata = NFTMetadata { unNFTMetadata :: Metadata }
   deriving stock (Show, Eq, Ord, Generic)