2

I've been beating my head against the wall for a while on an Aeson decoding problem. Briefly, when used in the context of the app as in line (6) below, the decoder fails, giving the error

 src/CFUpload.hs:(66,6)-(71,27): Non-exhaustive patterns in function parseJSON

I have indicated those lines below in the decoder instance FromJSON CFUploadResponse. However, when the decoder is applies in the repl to the data which I think it is receiving, it succeeds (See the discussion marked (***)).

Now for the gory details: first the code that throws the error, then the types, then the decoders and a discussion.

CODE.

    post "/image" $ do
      image <- jsonData :: ActionM CFImage.CFImage  -- (1)
      liftIO $ CFImage.downloadImage image  -- (2)
      cfImageUploadUrl <- liftIO Image.requestCFToken  -- (3)
      let filename = CFImage.getFilenameFromImage image  -- (4)   
      cfUploadedImageResponse <- liftIO $ Image.uploadTheImage cfImageUploadUrl filename  -- (5)
      let cfUploadedImageResponse' = Data.Aeson.decode $ BL.pack cfUploadedImageResponse :: Maybe CFUpload.CFUploadResponse   -- (6)
      text $ pack $ show cfUploadedImageResponse'   -- (7)

This is part of a Scotty server app. I am testing the code using Postman. Everything works fine through line (5): the server accepts the POSTed data which contains an image URL and an image file name. On line (2) it uses that data to download the image to a file in directory cf-image. On line (3) a request is made to Cloudflare for a one-time image upload URL. On line (4) the filename is extracted and is used on line (5) to POST the image to cloudflare, returning data that includes a URL pointing to the image on Cloudflare's servers. I know that this request succeeds because I have short-circuited the above code, replacing lines (6) and (7) with

text $ pack $ cfUploadedImageResponse

The response is

"{\n  \"result\": {\n    \"id\": \"673996fb-4d26-4332-6e6b-e8bf7b608500\",\n    \"filename\": \"bird2.jpg\",\n    \"uploaded\": \"2023-03-18T22:53:56.705Z\",\n    \"requireSignedURLs\": false,\n    \"variants\": [\n      \"https://imagedelivery.net/9U-0Y4sEzXlO6BXzTnQnYQ/673996fb-4d26-4332-6e6b-e8bf7b608500/public\"\n    ]\n  },\n  \"success\": true,\n  \"errors\": [],\n  \"messages\": []\n}"
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                             

Call this string testResponse. If you feed testResponse to Python's print, you get

{
  "result": {
    "id": "673996fb-4d26-4332-6e6b-e8bf7b608500",
    "filename": "bird2.jpg",
    "uploaded": "2023-03-18T22:53:56.705Z",
    "requireSignedURLs": false,
    "variants": [
         "https://imagedelivery.net/9U-0Y4sEzXlO6BXzTnQnYQ/673996fb-4d26-4332-6e6b-e8bf7b608500/public"
        ]
      },
    "success": true,
    "errors": [],
    "messages": []
}

TYPES.

This string, which we will call testResponsePretty, is, as far as I can see, correct: compare with the following types:

data CFUploadResponse = CFUploadResponse
  {
    result   :: CFUploadResult,
    success  :: Bool,
    errors   :: [String],
    messages :: [String]
  } deriving Show

data CFUploadResult = CFUploadResult {
    id                :: String,
    filename          :: String,
    uploaded          :: String,
    requireSignedURLs :: Bool,
    variants          :: [String]
  } deriving Show

DECODERS.

Here are the decoders:

instance FromJSON CFUploadResponse where
     parseJSON (Object v) =           -- (66)
        CFUploadResponse     <$>      -- (67) 
            v .: "result"    <*>      -- (68)
            v .: "success"   <*>      -- (69)
            v .: "errors"    <*>      -- (70)
            v .: "messages"           -- (71)

-- Tell Aeson how to convert a CFUploadResponse object to a JSON string.

instance FromJSON CFUploadResult where
    parseJSON = withObject "CFUploadResult" $ \o -> do
      id <- o .: Data.Text.pack  "id"
      filename <- o .: Data.Text.pack "filename"
      uploaded <- o .:  Data.Text.pack "uploaded"
      requireSignedURLs <- o .: Data.Text.pack "requireSignedURLs"
      variants <- o .: Data.Text.pack  "variants"
      return (CFUploadResult id filename uploaded requireSignedURLs variants) 
  

DISCUSSION. (***)
What is especially baffling is the following. Let testResponse be as above and let

myDecode str = Data.Aeson.eitherDecode $ BL.pack str :: Either String (Maybe CFUpload.CFUploadResponse)

Then do this:

$ stack repl

ghci> myDecode testResponse

The result is

Right (Just (CFUploadResponse {result = CFUploadResult {id = "49660d63-a43f-4011-1a7a-ff6435305d00", filename = "bird2.jpg", uploaded = "2023-03-16T23:08:22.768Z", requireSignedURLs = False, variants = ["https://imagedelivery.net/9U-0Y4sEzXlO6BXzTnQnYQ/49660d63-a43f-4011-1a7a-ff6435305d00/public"]}, success = True, errors = [], messages = []}))
jxxcarlson
  • 223
  • 3
  • 13
  • 2
    You might be able to get some more diagnostic info by adding a clause `parseJSON other = typeMismatch "CFUploadResponse" other` (or using `withObject` as you did in `CFUploadResult`). Of course you'll also want to use `decodeEither` to get access to the resulting error. – Daniel Wagner Mar 18 '23 at 23:56
  • As a stylistic note (almost certainly unrelated to your problem), to me it looks like the person who wrote the first instance had more Haskell experience, while the person who wrote the second instance knew aeson's API better. You can mix the best of both worlds; e.g. `parseJSON = withObject "CFUploadResponse" $ \o -> CFUploadResponse <$> o .: "result" <*> o .: "success" <*> ...` and `parseJSON = withObject "CFUploadResult" $ \o -> CFUploadResult <$> o .: "id" <*> o .: "filename" <*> ...`. If the latter is in a different module, you may need to turn on `OverloadedStrings`. – Daniel Wagner Mar 19 '23 at 00:02
  • `parseJSON` is partial: you haven't defined it for `Array`, `Scientific`, `Text`, `Bool`, or `Null` values of type `Value`. (*You* know that you can't create a `CFUploadResponse` from any of those values, but the compiler is telling you that you haven't informed the `FromJSON` instance of that fact by explicitly using `fail`, `mempty`, `typeMismatch`, etc.) – chepner Mar 19 '23 at 15:53
  • And you **want** the `FromJSON CFUploadResponse` to handle all the constructors of `Value` (by failing for the non-object ones), because if someone ever needs to parse something that could be a `CFUploadResponse` or something else, then that parsing logic can easily handle a `fail` (and try the other case), but a pattern match failure will just kill the whole program. Leaving the extra cases unhandled out is just as much a mistake as letting letting the web server's routing function error out on an unknown URL instead of "failing properly". – Ben Mar 19 '23 at 21:25

1 Answers1

2

When you replace lines (6) and (7) with text $ pack $ cfUploadedImageResponse, the response bytestream from the web server should be:

{
  "result":...
  ...
}

not:

"{\n  \"result\":...

That is, the response should start with an open brace, not a double quote.

I'm going to guess that your uploadTheImage function is returning the result of show response rather than the response string itself. If the actual value of cfUploadedImageResponse is a string whose first character is a double-quote, then you are asking Aeson to decode a JSON value that happens to be a single string (whose contents are some JSON, but that's irrelevant to the decoder). This will cause the pattern match in your instance:

parseJSON (Object v)

to fail, since the v :: Values is a String not an Object.

K. A. Buhr
  • 45,621
  • 3
  • 45
  • 71