Handle new struct property (#312)

* Handle new struct property

* Update README

* Update schemas

* Require newer `data-default-class`

* Fix dictionary schema

* Fix dictionary schema again

README.md

@@ -9,8 +9,8 @@ and points, or low-level details like positions and cameras. Generating replays
 can be used to modify replays in order to force everyone into the same car or
 change the map a game was played on.
 
-Rattletrap supports every version of Rocket League up to [2.43][], which was
-released on 2024-04-16. If a replay can be played by the Rocket League client,
+Rattletrap supports every version of Rocket League up to [2.45][], which was
+released on 2024-10-22. If a replay can be played by the Rocket League client,
 it can be parsed by Rattletrap. (If not, that's a bug. Please report it!)
 
 ## Install
@@ -127,6 +127,6 @@ $ rattletrap -i input.replay |
 
 [Rattletrap]: https://github.com/tfausak/rattletrap
 [Rocket League]: https://www.rocketleague.com
-[2.43]: https://www.rocketleague.com/en/news/patch-notes-v2-43
+[2.45]: https://www.rocketleague.com/en/news/patch-notes-v2-45
 [Ball Chasing]: https://ballchasing.com
 [the latest release]: https://github.com/tfausak/rattletrap/releases/latest

cabal.project

@@ -1 +1,4 @@
 packages: .
+constraints:
+  -- https://github.com/snoyberg/http-client/issues/547
+  data-default-class >= 0.2

rattletrap.cabal

@@ -178,6 +178,7 @@ library
     Rattletrap.Type.Property.Name
     Rattletrap.Type.Property.QWord
     Rattletrap.Type.Property.Str
+    Rattletrap.Type.Property.Struct
     Rattletrap.Type.PropertyValue
     Rattletrap.Type.Quaternion
     Rattletrap.Type.RemoteId

src/lib/Rattletrap/Console/Main.hs

@@ -81,6 +81,7 @@ import qualified Rattletrap.Type.Message as Message
 import qualified Rattletrap.Type.Property as Property
 import qualified Rattletrap.Type.Property.Array as Property.Array
 import qualified Rattletrap.Type.Property.Byte as Property.Byte
+import qualified Rattletrap.Type.Property.Struct as Property.Struct
 import qualified Rattletrap.Type.PropertyValue as PropertyValue
 import qualified Rattletrap.Type.Quaternion as Quaternion
 import qualified Rattletrap.Type.RemoteId as RemoteId
@@ -223,6 +224,7 @@ schema =
                 CompressedWord.schema,
                 CompressedWordVector.schema,
                 contentSchema,
+                Dictionary.elementSchema Property.schema,
                 Dictionary.schema Property.schema,
                 F32.schema,
                 Frame.schema,
@@ -239,6 +241,7 @@ schema =
                 Property.schema,
                 Property.Array.schema Property.schema,
                 Property.Byte.schema,
+                Property.Struct.schema Property.schema,
                 PropertyValue.schema Property.schema,
                 Quaternion.schema,
                 RemoteId.schema,

src/lib/Rattletrap/Type/Dictionary.hs

@@ -1,7 +1,5 @@
 module Rattletrap.Type.Dictionary where
 
-import qualified Data.Bifunctor as Bifunctor
-import qualified Data.Map as Map
 import qualified Data.Text as Text
 import qualified Rattletrap.ByteGet as ByteGet
 import qualified Rattletrap.BytePut as BytePut
@@ -18,49 +16,31 @@ data Dictionary a = Dictionary
 
 instance (Json.FromJSON a) => Json.FromJSON (Dictionary a) where
   parseJSON = Json.withObject "Dictionary" $ \o -> do
-    keys <- Json.required o "keys"
-    lastKey_ <- Json.required o "last_key"
-    value <- Json.required o "value"
-    let build ::
-          (MonadFail m) =>
-          Map.Map Text.Text a ->
-          Int ->
-          [(Int, (Str.Str, a))] ->
-          [Text.Text] ->
-          m (RList.List (Str.Str, a))
-        build m i xs ks = case ks of
-          [] -> pure . RList.fromList . reverse $ fmap snd xs
-          k : t -> case Map.lookup k m of
-            Nothing -> fail $ "missing required key " <> show k
-            Just v -> build m (i + 1) ((i, (Str.fromText k, v)) : xs) t
-    elements_ <- build value 0 [] keys
-    pure Dictionary {elements = elements_, lastKey = lastKey_}
+    elements <- Json.required o "elements"
+    lastKey <- Json.required o "last_key"
+    pure Dictionary {elements = elements, lastKey = lastKey}
 
 instance (Json.ToJSON a) => Json.ToJSON (Dictionary a) where
   toJSON x =
     Json.object
-      [ Json.pair "keys" . fmap fst . RList.toList $ elements x,
-        Json.pair "last_key" $ lastKey x,
-        Json.pair "value"
-          . Map.fromList
-          . fmap (Bifunctor.first Str.toText)
-          . RList.toList
-          $ elements x
+      [ Json.pair "elements" . RList.toList $ elements x,
+        Json.pair "last_key" $ lastKey x
       ]
 
 schema :: Schema.Schema -> Schema.Schema
 schema s =
   Schema.named ("dictionary-" <> Text.unpack (Schema.name s)) $
     Schema.object
-      [ (Json.pair "keys" . Schema.json $ Schema.array Str.schema, True),
-        (Json.pair "last_key" $ Schema.ref Str.schema, True),
-        ( Json.pair "value" $
-            Json.object
-              [ Json.pair "type" "object",
-                Json.pair "additionalProperties" $ Schema.ref s
-              ],
-          True
-        )
+      [ (Json.pair "elements" . Schema.json . Schema.array $ elementSchema s, True),
+        (Json.pair "last_key" $ Schema.ref Str.schema, True)
+      ]
+
+elementSchema :: Schema.Schema -> Schema.Schema
+elementSchema s =
+  Schema.named ("dictionary-element-" <> Text.unpack (Schema.name s)) $
+    Schema.tuple
+      [ Schema.ref Str.schema,
+        Schema.ref s
       ]
 
 lookup :: Str.Str -> Dictionary a -> Maybe a

src/lib/Rattletrap/Type/Property.hs

@@ -5,13 +5,14 @@ import qualified Rattletrap.BytePut as BytePut
 import qualified Rattletrap.Schema as Schema
 import qualified Rattletrap.Type.PropertyValue as PropertyValue
 import qualified Rattletrap.Type.Str as Str
-import qualified Rattletrap.Type.U64 as U64
+import qualified Rattletrap.Type.U32 as U32
 import qualified Rattletrap.Utility.Json as Json
 
 data Property = Property
   { kind :: Str.Str,
     -- | Not used.
-    size :: U64.U64,
+    size :: U32.U32,
+    index :: U32.U32,
     value :: PropertyValue.PropertyValue Property
   }
   deriving (Eq, Show)
@@ -20,14 +21,16 @@ instance Json.FromJSON Property where
   parseJSON = Json.withObject "Property" $ \object -> do
     kind <- Json.required object "kind"
     size <- Json.required object "size"
+    index <- Json.required object "index"
     value <- Json.required object "value"
-    pure Property {kind, size, value}
+    pure Property {kind, size, index, value}
 
 instance Json.ToJSON Property where
   toJSON x =
     Json.object
       [ Json.pair "kind" $ kind x,
         Json.pair "size" $ size x,
+        Json.pair "index" $ index x,
         Json.pair "value" $ value x
       ]
 
@@ -36,21 +39,24 @@ schema =
   Schema.named "property" $
     Schema.object
       [ (Json.pair "kind" $ Schema.ref Str.schema, True),
-        (Json.pair "size" $ Schema.ref U64.schema, True),
+        (Json.pair "size" $ Schema.ref U32.schema, True),
+        (Json.pair "index" $ Schema.ref U32.schema, True),
         (Json.pair "value" . Schema.ref $ PropertyValue.schema schema, True)
       ]
 
 bytePut :: Property -> BytePut.BytePut
 bytePut x =
   Str.bytePut (kind x)
-    <> U64.bytePut (size x)
+    <> U32.bytePut (size x)
+    <> U32.bytePut (index x)
     <> PropertyValue.bytePut
       bytePut
       (value x)
 
 byteGet :: ByteGet.ByteGet Property
 byteGet = ByteGet.label "Property" $ do
   kind <- ByteGet.label "kind" Str.byteGet
-  size <- ByteGet.label "size" U64.byteGet
+  size <- ByteGet.label "size" U32.byteGet
+  index <- ByteGet.label "index" U32.byteGet
   value <- ByteGet.label "value" $ PropertyValue.byteGet byteGet kind
-  pure Property {kind, size, value}
+  pure Property {kind, size, index, value}

src/lib/Rattletrap/Type/Property/Byte.hs

@@ -4,12 +4,12 @@ import qualified Rattletrap.ByteGet as ByteGet
 import qualified Rattletrap.BytePut as BytePut
 import qualified Rattletrap.Schema as Schema
 import qualified Rattletrap.Type.Str as Str
+import qualified Rattletrap.Type.U8 as U8
 import qualified Rattletrap.Utility.Json as Json
-import qualified Rattletrap.Utility.Monad as Monad
 
 data Byte = Byte
   { key :: Str.Str,
-    value :: Maybe Str.Str
+    value :: Maybe (Either U8.U8 Str.Str)
   }
   deriving (Eq, Show)
 
@@ -25,17 +25,29 @@ schema :: Schema.Schema
 schema =
   Schema.named "property-byte" $
     Schema.tuple
-      [Schema.ref Str.schema, Schema.json $ Schema.maybe Str.schema]
+      [ Schema.ref Str.schema,
+        Schema.oneOf
+          [ Schema.ref Schema.null,
+            Schema.object [(Json.pair "Left" $ Schema.ref U8.schema, True)],
+            Schema.object [(Json.pair "Right" $ Schema.ref Str.schema, True)]
+          ]
+      ]
 
 bytePut :: Byte -> BytePut.BytePut
-bytePut byte = Str.bytePut (key byte) <> foldMap Str.bytePut (value byte)
+bytePut byte = Str.bytePut (key byte) <> foldMap (either U8.bytePut Str.bytePut) (value byte)
 
 byteGet :: ByteGet.ByteGet Byte
 byteGet = ByteGet.label "Byte" $ do
   key <- ByteGet.label "key" Str.byteGet
   let isSteam = key == Str.fromString "OnlinePlatform_Steam"
       isPlayStation = key == Str.fromString "OnlinePlatform_PS4"
+      isNone = key == Str.fromString "None"
   value <-
     ByteGet.label "value" $
-      Monad.whenMaybe (not $ isSteam || isPlayStation) Str.byteGet
+      if isSteam || isPlayStation
+        then pure Nothing
+        else
+          if isNone
+            then Just . Left <$> U8.byteGet
+            else Just . Right <$> Str.byteGet
   pure Byte {key, value}

src/lib/Rattletrap/Type/Property/Struct.hs

@@ -0,0 +1,46 @@
+module Rattletrap.Type.Property.Struct where
+
+import qualified Rattletrap.ByteGet as ByteGet
+import qualified Rattletrap.BytePut as BytePut
+import qualified Rattletrap.Schema as Schema
+import qualified Rattletrap.Type.Dictionary as Dictionary
+import qualified Rattletrap.Type.Str as Str
+import qualified Rattletrap.Utility.Json as Json
+
+data Struct a = Struct
+  { name :: Str.Str,
+    fields :: Dictionary.Dictionary a
+  }
+  deriving (Eq, Show)
+
+instance (Json.FromJSON a) => Json.FromJSON (Struct a) where
+  parseJSON = Json.withObject "Struct" $ \o -> do
+    name <- Json.required o "name"
+    fields <- Json.required o "fields"
+    pure Struct {name, fields}
+
+instance (Json.ToJSON a) => Json.ToJSON (Struct a) where
+  toJSON x =
+    Json.object
+      [ Json.pair "name" $ name x,
+        Json.pair "fields" $ fields x
+      ]
+
+schema :: Schema.Schema -> Schema.Schema
+schema s =
+  Schema.named "property-struct" $
+    Schema.object
+      [ (Json.pair "name" $ Schema.ref Str.schema, True),
+        (Json.pair "fields" $ Schema.ref (Dictionary.schema s), True)
+      ]
+
+bytePut :: (a -> BytePut.BytePut) -> Struct a -> BytePut.BytePut
+bytePut p x =
+  Str.bytePut (name x)
+    <> Dictionary.bytePut p (fields x)
+
+byteGet :: ByteGet.ByteGet a -> ByteGet.ByteGet (Struct a)
+byteGet g = ByteGet.label "Struct" $ do
+  name <- ByteGet.label "name" Str.byteGet
+  fields <- ByteGet.label "fields" $ Dictionary.byteGet g
+  pure Struct {name, fields}

src/lib/Rattletrap/Type/PropertyValue.hs

@@ -13,6 +13,7 @@ import qualified Rattletrap.Type.Property.Int as Property.Int
 import qualified Rattletrap.Type.Property.Name as Property.Name
 import qualified Rattletrap.Type.Property.QWord as Property.QWord
 import qualified Rattletrap.Type.Property.Str as Property.Str
+import qualified Rattletrap.Type.Property.Struct as Property.Struct
 import qualified Rattletrap.Type.Str as Str
 import qualified Rattletrap.Utility.Json as Json
 
@@ -29,6 +30,7 @@ data PropertyValue a
     Name Property.Name.Name
   | QWord Property.QWord.QWord
   | Str Property.Str.Str
+  | Struct (Property.Struct.Struct a)
   deriving (Eq, Show)
 
 instance (Json.FromJSON a) => Json.FromJSON (PropertyValue a) where
@@ -41,7 +43,8 @@ instance (Json.FromJSON a) => Json.FromJSON (PropertyValue a) where
         fmap Int $ Json.required object "int",
         fmap Name $ Json.required object "name",
         fmap QWord $ Json.required object "q_word",
-        fmap Str $ Json.required object "str"
+        fmap Str $ Json.required object "str",
+        fmap Struct $ Json.required object "struct"
       ]
 
 instance (Json.ToJSON a) => Json.ToJSON (PropertyValue a) where
@@ -54,6 +57,7 @@ instance (Json.ToJSON a) => Json.ToJSON (PropertyValue a) where
     Name y -> Json.object [Json.pair "name" y]
     QWord y -> Json.object [Json.pair "q_word" y]
     Str y -> Json.object [Json.pair "str" y]
+    Struct y -> Json.object [Json.pair "struct" y]
 
 schema :: Schema.Schema -> Schema.Schema
 schema s =
@@ -67,7 +71,8 @@ schema s =
         ("int", Schema.ref Property.Int.schema),
         ("name", Schema.ref Property.Name.schema),
         ("q_word", Schema.ref Property.QWord.schema),
-        ("str", Schema.ref Property.Str.schema)
+        ("str", Schema.ref Property.Str.schema),
+        ("struct", Schema.ref $ Property.Struct.schema s)
       ]
 
 bytePut :: (a -> BytePut.BytePut) -> PropertyValue a -> BytePut.BytePut
@@ -80,6 +85,7 @@ bytePut putProperty value = case value of
   Name x -> Property.Name.bytePut x
   QWord x -> Property.QWord.bytePut x
   Str x -> Property.Str.bytePut x
+  Struct x -> Property.Struct.bytePut putProperty x
 
 byteGet :: ByteGet.ByteGet a -> Str.Str -> ByteGet.ByteGet (PropertyValue a)
 byteGet getProperty kind =
@@ -92,4 +98,5 @@ byteGet getProperty kind =
     "NameProperty" -> fmap Name Property.Name.byteGet
     "QWordProperty" -> fmap QWord Property.QWord.byteGet
     "StrProperty" -> fmap Str Property.Str.byteGet
+    "StructProperty" -> fmap Struct $ Property.Struct.byteGet getProperty
     x -> ByteGet.throw $ UnknownProperty.UnknownProperty x

src/lib/Rattletrap/Type/Replay.hs

@@ -110,7 +110,7 @@ getNumFrames header_ =
   case Dictionary.lookup
     (Str.fromString "NumFrames")
     (Header.properties header_) of
-    Just (Property.Property _ _ (PropertyValue.Int numFrames)) ->
+    Just (Property.Property _ _ _ (PropertyValue.Int numFrames)) ->
       fromIntegral (I32.toInt32 (Property.Int.toI32 numFrames))
     _ -> 0
 
@@ -120,7 +120,7 @@ getMaxChannels header_ =
     case Dictionary.lookup
       (Str.fromString "MaxChannels")
       (Header.properties header_) of
-      Just (Property.Property _ _ (PropertyValue.Int maxChannels)) ->
+      Just (Property.Property _ _ _ (PropertyValue.Int maxChannels)) ->
         fromIntegral (I32.toInt32 (Property.Int.toI32 maxChannels))
       _ -> 1023
 

src/test/Main.hs

@@ -87,6 +87,7 @@ replays =
     ("383e", "older unknown content field"), -- https://github.com/tfausak/rattletrap/pull/123
     ("387f", "a frozen attribute"), -- https://github.com/tfausak/rattletrap/commit/93ce196
     ("3abd", "rlcs"), -- https://github.com/tfausak/rattletrap/pull/86
+    ("3bd0", "v2.45"), -- https://github.com/tfausak/rattletrap/issues/311
     ("3ea1", "a custom team name"), -- https://github.com/tfausak/rattletrap/commit/cf4d145
     ("4050", "v2.08 dodge impulse"), -- https://github.com/tfausak/rattletrap/issues/247
     ("4126", "a game mode after Neo Tokyo"), -- https://github.com/tfausak/rattletrap/commit/a1cf21e