failing test that reproduces bug

input-output-hk · Mar 27, 2023 · 3263fe6 · 3263fe6
1 parent b0095ff
commit 3263fe6
Show file tree

Hide file tree

Showing 2 changed files with 20 additions and 6 deletions.
diff --git a/marlowe-runtime/test/Language/Marlowe/Runtime/Transaction/ApiSpec.hs b/marlowe-runtime/test/Language/Marlowe/Runtime/Transaction/ApiSpec.hs
@@ -17,7 +17,7 @@ import Data.Coerce (coerce)
 import Data.Foldable (find)
 import Data.Map (Map)
 import qualified Data.Map as Map
-import Data.Maybe (maybeToList)
+import Data.Maybe (fromJust, maybeToList)
 import qualified Data.Maybe as Maybe
 import Data.String (fromString)
 import Data.Text (Text)
@@ -94,7 +94,7 @@ cip25MetadataDetailsJSONRelationGenSoundnessProp = Gen.checkCoverage $
   Gen.forAll cip25MetadataDetailsJSONRelationGen \(details, json) -> do
     let document = Aeson.encode json
     Aeson.encode details `shouldBe` document
-    -- fmap show (Aeson.decode @[CIP25MetadataDetails] document) `shouldBe` Just (show details)
+    fmap show (Aeson.decode @[CIP25MetadataDetails] document) `shouldBe` Just (show details)
 
 cip25MetadataDetailsJSONRelationGen :: Gen (CIP25MetadataDetails, Aeson.Value)
 cip25MetadataDetailsJSONRelationGen = do
@@ -198,11 +198,19 @@ uriGen = do
 
 spec :: Spec
 spec = do
-  Hspec.fdescribe "Network.URI" do
+  Hspec.describe "Network.URI" do
     prop "uri generator is correct and of good quality" uriGenSoundnessProp
   Hspec.fdescribe "CIP25MetadataFileDetails" do
+    Hspec.focus $ it "reproduces bug" do
+      let details = CIP25MetadataDetails "" (fromJust $ Network.URI.parseURI "n:///#-") Nothing Nothing []
+          document = Aeson.encode $ Aeson.Object
+            [ ("name", "")
+            , ("image", "n:///#-")
+            , ("filed", Aeson.Array [])
+            ]
+      fmap show (Aeson.decode @[CIP25MetadataDetails] document) `shouldBe` Just (show details)
     prop "Is sound" cip25MetadataFileDetailsJSONRelationGenSoundnessProp
-  Hspec.fdescribe "CIP25MetadataDetails" do
+  Hspec.describe "CIP25MetadataDetails" do
     prop "Is sound" cip25MetadataDetailsJSONRelationGenSoundnessProp
   Hspec.describe "CIP-25 Metadata" do
     prop "accepts valid values" validityProp

diff --git a/marlowe-runtime/tx-api/Language/Marlowe/Runtime/Transaction/Api.hs b/marlowe-runtime/tx-api/Language/Marlowe/Runtime/Transaction/Api.hs
@@ -44,7 +44,7 @@ import Cardano.Api
   , serialiseToCBOR
   , serialiseToTextEnvelope
   )
-import Data.Aeson (FromJSON, ToJSON(..), object, (.=))
+import Data.Aeson (FromJSON, ToJSON(..), object, (.!=), (.:!), (.=))
 import qualified Data.Aeson as Aeson
 import qualified Data.Aeson.KeyMap as Aeson.KeyMap
 import Data.Aeson.Types ((.:))
@@ -142,7 +142,13 @@ instance Aeson.ToJSON CIP25MetadataDetails where
       _ -> [("files", toJSON files)]
 
 instance Aeson.FromJSON CIP25MetadataDetails where
-  parseJSON = undefined
+  parseJSON = Aeson.withObject "CIP25MetadataDetails" \x -> do
+    name <- x .: "name"
+    image <- uriFromJSON =<< x .: "image"
+    mediaType <- x .:! "mediaType"
+    description <- x .:! "description"
+    files <- x .:! "files" .!= []
+    pure $ CIP25MetadataDetails {..}
 
 newtype CIP25Metadata = CIP25Metadata
   { unCIP25Metadata :: Map PolicyId (Map TokenName CIP25MetadataDetails)