implement preliminary solution

marlowe-chain-sync/src/Language/Marlowe/Runtime/ChainSync/Api.hs

@@ -55,6 +55,14 @@ import qualified Data.Aeson as A
 import qualified Data.Aeson as Aeson
 import qualified Data.Aeson.KeyMap as KeyMap
 import Data.Aeson.Types (parseFail, toJSONKeyText)
+import Control.Monad (guard, (>=>))
+import Data.Aeson
+  (FromJSON, FromJSONKey, FromJSONKeyFunction(FromJSONKeyText), ToJSON, ToJSONKey, Value(..), object, toJSON, (.=))
+import qualified Data.Aeson as A
+import qualified Data.Aeson as Aeson
+import qualified Data.Aeson.KeyMap as KeyMap
+import Data.Aeson.Types (toJSONKeyText)
+import qualified Data.Aeson.Types as A
 import Data.Bifunctor (bimap)
 import Data.Binary (Binary(..), Get, Put, get, getWord8, put, putWord8)
 import Data.ByteString (ByteString)
@@ -174,6 +182,10 @@ instance Variations Metadata where
 instance ToJSON Metadata where
   toJSON = metadataValueToJsonNoSchema . toCardanoMetadata
 
+-- Should probably use metadataValueFromJsonNoSchema from Cardano.Api instead
+instance FromJSON Metadata where
+  parseJSON v = maybe (A.typeMismatch "Metadata" v) pure $ fromJSONEncodedMetadata v
+
 toCardanoMetadata :: Metadata -> C.TxMetadataValue
 toCardanoMetadata = \case
   MetadataMap ms -> C.TxMetaMap $ bimap toCardanoMetadata toCardanoMetadata <$> ms
@@ -374,6 +386,9 @@ instance ToJSON Base16 where
 instance ToJSONKey Base16 where
   toJSONKey = toJSONKeyText $ encodeBase16 . unBase16
 
+instance FromJSON Base16 where
+  parseJSON = Aeson.withText "Base16" (pure . fromString . T.unpack)
+
 newtype DatumHash = DatumHash { unDatumHash :: ByteString }
   deriving stock (Eq, Ord, Generic)
   deriving newtype (Binary, Variations)
@@ -451,6 +466,12 @@ instance ToJSONKey TokenName where
 instance ToJSON TokenName where
   toJSON = Aeson.String . T.pack . BS.unpack . unTokenName
 
+instance FromJSON TokenName where
+  parseJSON = Aeson.withText "TokenName" (pure . TokenName . BS.pack . T.unpack)
+
+instance FromJSONKey TokenName where
+  fromJSONKey = FromJSONKeyText (TokenName . BS.pack . T.unpack)
+
 newtype Quantity = Quantity { unQuantity :: Word64 }
   deriving stock (Show, Eq, Ord, Generic)
   deriving newtype (Num, Integral, Real, Enum, Bounded, Binary, ToJSON, Variations)
@@ -462,7 +483,7 @@ newtype Lovelace = Lovelace { unLovelace :: Word64 }
 newtype Address = Address { unAddress :: ByteString }
   deriving stock (Eq, Ord, Generic)
   deriving newtype (Binary, Variations)
-  deriving (IsString, Show, ToJSON) via Base16
+  deriving (IsString, Show, ToJSON, FromJSON) via Base16
 
 toBech32 :: Address -> Maybe Text
 toBech32 = toCardanoAddress >=> \case

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

@@ -44,7 +44,9 @@ marloweRuntimeJobClient cmd = do
 
 {-
 TODO make PR and go home
-TODO Load role tokens config file and parse it in module Language.Marlowe.Runtime.CLI.Command.Create
+DOING take an extra look at all the JSON instances to make sure it's done correctly
+DONE Load role tokens config file and parse it in module Language.Marlowe.Runtime.CLI.Command.Create
+  DONE Implement FromJSON and FromJSONKey instances where they're needed
   DONE reference role tokens config in cliEffect :: Integration ()
     DONE Create role tokens config file from RoleTokensConfig
 -}

marlowe-runtime-cli/app/Language/Marlowe/Runtime/CLI/Command/Create.hs

@@ -76,7 +76,7 @@ data CreateCommandError v
   = CreateFailed (CreateError v)
   | ContractFileDecodingError Yaml.ParseException
   | TransactionFileWriteFailed (C.FileError ())
-  | RolesConfigNotSupportedYet RolesConfig
+  | RolesConfigFileDecodingError String
   | MetadataDecodingFailed (Maybe Yaml.ParseException)
   | TagsDecodingFailed (Maybe Yaml.ParseException)
   | ExtendedContractsAreNotSupportedYet
@@ -164,7 +164,8 @@ runCreateCommand TxCommand { walletAddresses, signingMethod, tagsFile, metadataF
         let toNFT addr = (addr, Left 1)
         pure $ RoleTokensMint $ mkMint $ fmap toNFT <$> tokens
       Just (UseExistingPolicyId policyId) -> pure $ RoleTokensUsePolicy policyId
-      Just roles'@(MintConfig _) -> throwE (RolesConfigNotSupportedYet roles')
+      Just (MintConfig roleTokensConfigFilePath) ->
+        ExceptT $ liftIO $ first RolesConfigFileDecodingError <$> A.eitherDecodeFileStrict roleTokensConfigFilePath
     ContractId contractId <- run MarloweV1 minting'
     liftIO . print $ A.encode (A.object [("contractId", toJSON . renderTxOutRef $ contractId)])
   where

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

@@ -40,7 +40,7 @@ import Cardano.Api
   , serialiseToCBOR
   , serialiseToTextEnvelope
   )
-import Data.Aeson (ToJSON(..), object, (.=))
+import Data.Aeson (FromJSON, ToJSON(..), object, (.=))
 import Data.Binary (Binary, Get, get, getWord8, put)
 import Data.Binary.Put (Put, putWord8)
 import Data.ByteString (ByteString)
@@ -81,7 +81,7 @@ import Network.Protocol.Job.Types
 -- CIP-25 metadata
 newtype NFTMetadata = NFTMetadata { unNFTMetadata :: Metadata }
   deriving stock (Show, Eq, Ord, Generic)
-  deriving newtype (Binary, ToJSON)
+  deriving newtype (Binary, ToJSON, FromJSON)
 
 -- FIXME: Validate the metadata format
 mkNFTMetadata :: Metadata -> Maybe NFTMetadata
@@ -90,7 +90,7 @@ mkNFTMetadata = Just . NFTMetadata
 -- | Non empty mint request.
 newtype Mint = Mint { unMint :: Map TokenName (Address, Either Natural (Maybe NFTMetadata)) }
   deriving stock (Show, Eq, Ord, Generic)
-  deriving newtype (Binary, Semigroup, Monoid, ToJSON)
+  deriving newtype (Binary, Semigroup, Monoid, ToJSON, FromJSON)
 
 mkMint :: NonEmpty (TokenName, (Address, Either Natural (Maybe NFTMetadata))) -> Mint
 mkMint = Mint . Map.fromList . NonEmpty.toList
@@ -100,7 +100,7 @@ data RoleTokensConfig
   | RoleTokensUsePolicy PolicyId
   | RoleTokensMint Mint
   deriving stock (Show, Eq, Ord, Generic)
-  deriving anyclass (Binary, ToJSON)
+  deriving anyclass (Binary, ToJSON, FromJSON)
 
 data ContractCreated era v = ContractCreated
   { contractId :: ContractId