implement text splitting for nftmetadata

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

@@ -45,18 +45,16 @@ marloweRuntimeJobClient cmd = do
 
 {-
 TODO make PR and go home
-TODO find out if zerging will work for this suite
-  TODO find out what exactly takes long time for this test
-DONE take an extra look at all the JSON instances to make sure it's done correctly
-DONE
-  DONE implement fromJSON for NFTMetadata based on CIP-25
-  DONE: implement mkNFTMetadata
-  DONE: implement mkMetadata
-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
-  TODO Reorganizes strings into lists of strings such that they are each no longer than 64 characters long
+  DONE take an extra look at all the JSON instances to make sure it's done correctly
+  DONE
+    DONE implement fromJSON for NFTMetadata based on CIP-25
+    DONE: implement mkNFTMetadata
+    DONE: implement mkMetadata
+  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
+    DOING Reorganizes strings into lists of strings such that they are each no longer than 64 characters long
 -}
 
 spec :: Spec

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

@@ -163,7 +163,6 @@ instance Aeson.FromJSON NFTMetadata where
   parseJSON = Aeson.withObject "NFTMetadata" \x ->
     NFTMetadata <$> x .: "721"
 
--- FIXME: Combine text limited to max 64 characters from lists of text
 mkNFTMetadata :: Metadata -> Maybe NFTMetadata
 mkNFTMetadata =
   fmap NFTMetadata . parsePolicies
@@ -186,9 +185,9 @@ mkNFTMetadata =
     parseNFTMetadataDetails metadata = do
       textKeyMap <- parseMetadataRecord metadata
       name <- parseMetadataText =<< Map.lookup "name" textKeyMap
-      image <- parseMetadataText =<< Map.lookup "image" textKeyMap
+      image <- parseSplittableText =<< Map.lookup "image" textKeyMap
       let mediaType = parseMetadataText =<< Map.lookup "mediaType" textKeyMap
-          description = parseMetadataText =<< Map.lookup "description" textKeyMap
+          description = parseSplittableText =<< Map.lookup "description" textKeyMap
           parseSingleFileDetails = fmap (:[]) . parseNFTMetadataFileDetails
           parseManyFileDetails = parseMetadataList parseNFTMetadataFileDetails
           parseFileDetails md = parseSingleFileDetails md <|> parseManyFileDetails md
@@ -200,16 +199,18 @@ mkNFTMetadata =
       textKeyMap <- parseMetadataRecord metadata
       name <- parseMetadataText =<< Map.lookup "name" textKeyMap
       mediaType <- parseMetadataText =<< Map.lookup "mediaType" textKeyMap
-      src <- parseMetadataText =<< Map.lookup "src" textKeyMap
+      src <- parseSplittableText =<< Map.lookup "src" textKeyMap
       Just $ NFTMetadataFileDetails {..}
 
     parseMetadataRecord :: Metadata -> Maybe (Map Text Metadata)
     parseMetadataRecord = parseMetadataMap parseMetadataText Just
 
--- FIXME: split text into lists of text limiting them to max 64 characters
-mkMetadata :: NFTMetadata -> Maybe Metadata
+    parseSplittableText :: Metadata -> Maybe Text
+    parseSplittableText md = parseMetadataText md <|> (mconcat <$> parseMetadataList parseMetadataText md)
+
+mkMetadata :: NFTMetadata -> Metadata
 mkMetadata (unNFTMetadata -> metadata) =
-  Just $ MetadataMap [(MetadataNumber 721, encodePolicies metadata)]
+  MetadataMap [(MetadataNumber 721, encodePolicies metadata)]
   where
   encodePolicies :: Map PolicyId (Map TokenName NFTMetadataDetails) -> Metadata
   encodePolicies = MetadataMap . fmap (encodePolicyId *** encodeTokens) . Map.toList
@@ -226,10 +227,10 @@ mkMetadata (unNFTMetadata -> metadata) =
   encodeNFTMetadataDetails :: NFTMetadataDetails -> Metadata
   encodeNFTMetadataDetails NFTMetadataDetails {..} = MetadataMap $
     [ (MetadataText "name", MetadataText name)
-    , (MetadataText "image", MetadataText image)
+    , (MetadataText "image", encodeText image)
     ]
     <> (maybeToList $ fmap ((MetadataText "mediaType",) . MetadataText) mediaType)
-    <> (maybeToList $ fmap ((MetadataText "description",) . MetadataText) description)
+    <> (maybeToList $ fmap ((MetadataText "description",) . encodeText) description)
     <> case files of
         [] -> []
         [fileDetails] ->
@@ -241,9 +242,17 @@ mkMetadata (unNFTMetadata -> metadata) =
   encodeNFTMetadataFileDetails NFTMetadataFileDetails {..} = MetadataMap
     [ (MetadataText "name", MetadataText name)
     , (MetadataText "mediaType", MetadataText mediaType)
-    , (MetadataText "src", MetadataText src)
+    , (MetadataText "src", encodeText src)
     ]
 
+  encodeText :: Text -> Metadata
+  encodeText =
+    let loop acc t
+          | Text.length t <= 64 = MetadataText t:acc
+          | otherwise = let (t', ts) = Text.splitAt 64 t
+                         in loop (MetadataText t':acc) ts
+    in MetadataList . loop []
+
 -- | Non empty mint request.
 newtype Mint = Mint { unMint :: Map TokenName (Address, Either Natural (Maybe NFTMetadata)) }
   deriving stock (Show, Eq, Ord, Generic)

marlowe-runtime/tx/Language/Marlowe/Runtime/Transaction/BuildConstraints.hs

@@ -167,7 +167,7 @@ buildCreateConstraintsV1 walletCtx roles metadata minAda contract = do
       RoleTokensMint (Map.toList . unMint -> minting) -> do
         let
           tokensMetadata = catMaybes $ minting <&> \case
-            (tokenName, (_, Right (Just (mkMetadata -> Just nftMetadata)))) -> do
+            (tokenName, (_, Right (Just (mkMetadata -> nftMetadata)))) -> do
               let
                 tokenName' = unTokenName tokenName
               -- From CIP-25: In version 2 the the raw bytes of the asset_name are used.