TaggedObject sum encoding is broken after aeson 1.5.6

[donatello]

There seems to be at least two issues - one with TH and one with generic deriving.

First one with TH:

#!/usr/bin/env cabal
{- cabal:
build-depends: base >= 4.11
            , aeson ^>= 2.1
            , relude >= 1
-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE Strict #-}
{-# LANGUAGE TemplateHaskell #-}

import Data.Aeson
import Data.Aeson.TH
import Data.Aeson.Types
import GHC.Generics
import Relude.String.Conversion

data DataA = DataA
  { val1 :: Int,
    val2 :: Int
  }
  deriving (Eq, Show, Generic)

$(deriveJSON defaultOptions ''DataA)

data DataB = DataB
  { num1 :: Int,
    num2 :: Int
  }
  deriving (Eq, Show, Generic)

$(deriveJSON defaultOptions ''DataB)

data Event
  = EventA DataA
  | EventB DataB
  deriving (Eq, Show, Generic)

$( deriveJSON
     defaultOptions
       { sumEncoding = TaggedObject "event_type" "event_info"
       }
     ''Event
 )

main :: IO ()
main = do
  let ev = EventA $ DataA 1 2
      encoding = encode ev
      parsedEv = decode encoding :: Maybe Event
  putStrLn $ decodeUtf8 $ encode ev
  print parsedEv
  print $ parsedEv == Just ev

When run with cabal run script.hs, this prints out (ghc 8.10.7 and ghc 9.0.2):

{"event_info":"EventA","event_info":{"val1":1,"val1":2}}
Nothing
False

Same output with aeson 2.0

With aeson 1.5.6 (the expected output):

{"event_type":"EventA","event_info":{"val1":1,"val2":2}}
Just (EventA (DataA {val1 = 1, val2 = 2}))
True

Second issue with generic deriving (only showing the change in how Event's instances are derived):

data Event
  = EventA DataA
  | EventB DataB
  deriving (Eq, Show, Generic)

evOpts :: Options
evOpts =
  defaultOptions
    { sumEncoding = TaggedObject "event_type" "event_info"
    }

instance FromJSON Event where
  parseJSON = genericParseJSON evOpts

instance ToJSON Event where
  toJSON = genericToJSON evOpts
  toEncoding = genericToEncoding evOpts

The output with aeson 2.0 and 2.1 is:

{"event_type":"EventA","event_info":{"val1":1,"val1":2}}
Nothing
False

Strangely the encoding is correct, but the decoding simply fails. I tried with eitherDecode to see the error and I get:

Error in $['event_info']: When parsing the record DataA of type Main.DataA the key val2 was not present.

I could not find any workaround to get this to work.

[phadej]

I think this is broken TH of DataA instance. Probably related to #906 patch. I'll take a look.

Until then try to derive DataA and DataB instance generically.

[donatello]

When Event instance is derived with TH and the others are done generically, it does not work.

When DataA, DataB and Event instances are derived generically it works as expected! This workaround should be ok for now, but I think in my production application, the sum type is large and generic deriving would be slow/needs lots of memory during compilation.

Thank you for the workaround and for all the work you do for the haskell ecosystem @phadej !

[phadej]

I tried to reproduce it, and enabling {-# LANGUAGE Strict #-} messes things up. Now I have to figure out why.

[phadej]

If I dump splices, they look correct:

    instance ToJSON DataA where
      toJSON
        = let
          in
            \ value_af1E
              -> case value_af1E of {
                   DataA arg1_af1F arg2_af1G
                     -> aeson-2.1.1.0:Data.Aeson.Types.ToJSON.fromPairs
                          ((aeson-2.1.1.0:Data.Aeson.Types.ToJSON.pair
                              (Data.Aeson.Key.fromString "val1"))
                             (toJSON arg1_af1F)
                             <>
                               (aeson-2.1.1.0:Data.Aeson.Types.ToJSON.pair
                                  (Data.Aeson.Key.fromString "val2"))
                                 (toJSON arg2_af1G)) }
      toEncoding
        = let
            _let0_af1K
              = (aeson-2.1.1.0:Data.Aeson.Internal.ByteString.unsafePackLenLiteral
                   7)
                  "\"val1\":"#
            _let1_af1L
              = (aeson-2.1.1.0:Data.Aeson.Internal.ByteString.unsafePackLenLiteral
                   7)
                  "\"val2\":"#
          in
            \ value_af1H
              -> case value_af1H of {
                   DataA arg1_af1I arg2_af1J
                     -> aeson-2.1.1.0:Data.Aeson.Types.ToJSON.fromPairs
                          ((Data.Aeson.Encoding.Internal.unsafePairSBS _let0_af1K)
                             (toEncoding arg1_af1I)
                             <>
                               (Data.Aeson.Encoding.Internal.unsafePairSBS _let1_af1L)
                                 (toEncoding arg2_af1J)) }

And if I disable optimizations with -O0 test passes.

So I'm suspecting it's GHC to blame here.

[phadej]

@donatello could you try #968, whether it fixes your production app.

I'm not yet satisfied with a fix, as I don't understand why error happens.

[phadej]

I suspect even more strongly it's GHC, as if the field names are of different length, error doesn't happen!

[phadej]

I opened GHC issue https://gitlab.haskell.org/ghc/ghc/-/issues/22204, hopefully we'll get some light on this.

[donatello]

@donatello could you try #968, whether it fixes your production app.

I'm not yet satisfied with a fix, as I don't understand why error happens.

I can confirm that 01e73c1 of #968 does fix my production app. Thanks a lot! Please release it soon on hackage!

[phadej]

https://hackage.haskell.org/package/aeson-2.1.1.0 is on Hackage