diff --git a/data/classes-with-location.json b/data/classes-with-location.json --- a/data/classes-with-location.json +++ b/data/classes-with-location.json @@ -14,5 +14,17 @@ "TAGame.GameEvent_SoccarSplitscreen_TA", "TAGame.GRI_TA", "TAGame.PRI_TA", + "TAGame.SpecialPickup_BallCarSpring_TA", + "TAGame.SpecialPickup_BallFreeze_TA", + "TAGame.SpecialPickup_BallGravity_TA", + "TAGame.SpecialPickup_BallGravity_TA", + "TAGame.SpecialPickup_BallLasso_TA", + "TAGame.SpecialPickup_BallVelcro_TA", + "TAGame.SpecialPickup_Batarang_TA", + "TAGame.SpecialPickup_BoostOverride_TA", + "TAGame.SpecialPickup_GrapplingHook_TA", + "TAGame.SpecialPickup_HitForce_TA", + "TAGame.SpecialPickup_Swapper_TA", + "TAGame.SpecialPickup_Tornado_TA", "TAGame.Team_Soccar_TA" ] diff --git a/data/classes.json b/data/classes.json --- a/data/classes.json +++ b/data/classes.json @@ -14,15 +14,29 @@ "Archetypes.GameEvent.GameEvent_BasketballSplitscreen": "TAGame.GameEvent_SoccarSplitscreen_TA", "Archetypes.GameEvent.GameEvent_HockeyPrivate": "TAGame.GameEvent_SoccarPrivate_TA", "Archetypes.GameEvent.GameEvent_HockeySplitscreen": "TAGame.GameEvent_SoccarSplitscreen_TA", + "Archetypes.GameEvent.GameEvent_Items": "TAGame.GameEvent_Soccar_TA", "Archetypes.GameEvent.GameEvent_Season:CarArchetype": "TAGame.Car_TA", "Archetypes.GameEvent.GameEvent_Season": "TAGame.GameEvent_Season_TA", "Archetypes.GameEvent.GameEvent_Soccar": "TAGame.GameEvent_Soccar_TA", "Archetypes.GameEvent.GameEvent_SoccarPrivate": "TAGame.GameEvent_SoccarPrivate_TA", "Archetypes.GameEvent.GameEvent_SoccarSplitscreen": "TAGame.GameEvent_SoccarSplitscreen_TA", + "Archetypes.SpecialPickups.SpecialPickup_BallFreeze": "TAGame.SpecialPickup_BallFreeze_TA", + "Archetypes.SpecialPickups.SpecialPickup_BallGrapplingHook": "TAGame.SpecialPickup_GrapplingHook_TA", + "Archetypes.SpecialPickups.SpecialPickup_BallLasso": "TAGame.SpecialPickup_BallLasso_TA", + "Archetypes.SpecialPickups.SpecialPickup_BallSpring": "TAGame.SpecialPickup_BallCarSpring_TA", + "Archetypes.SpecialPickups.SpecialPickup_BallVelcro": "TAGame.SpecialPickup_BallVelcro_TA", + "Archetypes.SpecialPickups.SpecialPickup_Batarang": "TAGame.SpecialPickup_Batarang_TA", + "Archetypes.SpecialPickups.SpecialPickup_BoostOverride": "TAGame.SpecialPickup_BoostOverride_TA", + "Archetypes.SpecialPickups.SpecialPickup_CarSpring": "TAGame.SpecialPickup_BallCarSpring_TA", + "Archetypes.SpecialPickups.SpecialPickup_GravityWell": "TAGame.SpecialPickup_BallGravity_TA", + "Archetypes.SpecialPickups.SpecialPickup_StrongHit": "TAGame.SpecialPickup_HitForce_TA", + "Archetypes.SpecialPickups.SpecialPickup_Swapper": "TAGame.SpecialPickup_Swapper_TA", + "Archetypes.SpecialPickups.SpecialPickup_Tornado": "TAGame.SpecialPickup_Tornado_TA", "Archetypes.Teams.Team0": "TAGame.Team_Soccar_TA", "Archetypes.Teams.Team1": "TAGame.Team_Soccar_TA", "GameInfo_Basketball.GameInfo.GameInfo_Basketball:GameReplicationInfoArchetype": "TAGame.GRI_TA", "Gameinfo_Hockey.GameInfo.Gameinfo_Hockey:GameReplicationInfoArchetype": "TAGame.GRI_TA", + "GameInfo_Items.GameInfo.GameInfo_Items:GameReplicationInfoArchetype": "TAGame.GRI_TA", "GameInfo_Season.GameInfo.GameInfo_Season:GameReplicationInfoArchetype": "TAGame.GRI_TA", "GameInfo_Soccar.GameInfo.GameInfo_Soccar:GameReplicationInfoArchetype": "TAGame.GRI_TA", "TAGame.CameraSettingsActor_TA:PRI": "TAGame.CameraSettingsActor_TA", diff --git a/data/properties.json b/data/properties.json --- a/data/properties.json +++ b/data/properties.json @@ -55,6 +55,9 @@ "TAGame.CameraSettingsActor_TA:CameraYaw": "byte", "TAGame.CameraSettingsActor_TA:PRI": "flagged_int", "TAGame.CameraSettingsActor_TA:ProfileSettings": "cam_settings", + "TAGame.Car_TA:AddedBallForceMultiplier": "float", + "TAGame.Car_TA:AddedCarForceMultiplier": "float", + "TAGame.Car_TA:AttachedPickup": "flagged_int", "TAGame.Car_TA:ReplicatedDemolish": "demolish", "TAGame.Car_TA:TeamPaint": "team_paint", "TAGame.CarComponent_Boost_TA:bNoBoost": "boolean", @@ -63,15 +66,18 @@ "TAGame.CarComponent_Boost_TA:RechargeDelay": "float", "TAGame.CarComponent_Boost_TA:RechargeRate": "float", "TAGame.CarComponent_Boost_TA:ReplicatedBoostAmount": "byte", + "TAGame.CarComponent_Boost_TA:UnlimitedBoostRefCount": "int", "TAGame.CarComponent_Dodge_TA:DodgeTorque": "location", "TAGame.CarComponent_FlipCar_TA:bFlipRight": "boolean", "TAGame.CarComponent_FlipCar_TA:FlipCarTime": "float", "TAGame.CarComponent_TA:ReplicatedActive": "byte", + "TAGame.CarComponent_TA:ReplicatedActivityTime": "float", "TAGame.CarComponent_TA:Vehicle": "flagged_int", "TAGame.CrowdActor_TA:GameEvent": "flagged_int", "TAGame.CrowdActor_TA:ModifiedNoise": "float", "TAGame.CrowdActor_TA:ReplicatedCountDownNumber": "int", "TAGame.CrowdActor_TA:ReplicatedOneShotSound": "flagged_int", + "TAGame.CrowdActor_TA:ReplicatedRoundCountDownNumber": "int", "TAGame.CrowdManager_TA:GameEvent": "flagged_int", "TAGame.CrowdManager_TA:ReplicatedGlobalOneShotSound": "flagged_int", "TAGame.GameEvent_Soccar_TA:bBallHasBeenHit": "boolean", @@ -80,10 +86,12 @@ "TAGame.GameEvent_Soccar_TA:ReplicatedScoredOnTeam": "byte", "TAGame.GameEvent_Soccar_TA:RoundNum": "int", "TAGame.GameEvent_Soccar_TA:SecondsRemaining": "int", + "TAGame.GameEvent_Soccar_TA:SubRulesArchetype": "flagged_int", "TAGame.GameEvent_SoccarPrivate_TA:MatchSettings": "private_match_settings", "TAGame.GameEvent_TA:bHasLeaveMatchPenalty": "boolean", "TAGame.GameEvent_TA:BotSkill": "int", "TAGame.GameEvent_TA:GameMode": "game_mode", + "TAGame.GameEvent_TA:MatchTypeClass": "flagged_int", "TAGame.GameEvent_TA:ReplicatedGameStateTimeRemaining": "int", "TAGame.GameEvent_TA:ReplicatedStateIndex": "byte", "TAGame.GameEvent_TA:ReplicatedStateName": "int", @@ -93,6 +101,7 @@ "TAGame.PRI_TA:bIsInSplitScreen": "boolean", "TAGame.PRI_TA:bMatchMVP": "boolean", "TAGame.PRI_TA:bOnlineLoadoutSet": "boolean", + "TAGame.PRI_TA:bOnlineLoadoutsSet": "boolean", "TAGame.PRI_TA:bReady": "boolean", "TAGame.PRI_TA:bUsingBehindView": "boolean", "TAGame.PRI_TA:bUsingFreecam": "boolean", @@ -103,6 +112,8 @@ "TAGame.PRI_TA:CameraYaw": "byte", "TAGame.PRI_TA:ClientLoadout": "loadout", "TAGame.PRI_TA:ClientLoadoutOnline": "loadout_online", + "TAGame.PRI_TA:ClientLoadouts": "loadouts", + "TAGame.PRI_TA:ClientLoadoutsOnline": "loadouts_online", "TAGame.PRI_TA:MatchAssists": "int", "TAGame.PRI_TA:MatchGoals": "int", "TAGame.PRI_TA:MatchSaves": "int", @@ -115,8 +126,16 @@ "TAGame.PRI_TA:Title": "int", "TAGame.PRI_TA:TotalXP": "int", "TAGame.RBActor_TA:bFrozen": "boolean", + "TAGame.RBActor_TA:bIgnoreSyncing": "boolean", "TAGame.RBActor_TA:bReplayActor": "boolean", "TAGame.RBActor_TA:ReplicatedRBState": "rigid_body_state", + "TAGame.RBActor_TA:WeldedInfo": "welded_info", + "TAGame.SpecialPickup_BallFreeze_TA:RepOrigSpeed": "float", + "TAGame.SpecialPickup_BallVelcro_TA:AttachTime": "float", + "TAGame.SpecialPickup_BallVelcro_TA:bBroken": "boolean", + "TAGame.SpecialPickup_BallVelcro_TA:bHit": "boolean", + "TAGame.SpecialPickup_BallVelcro_TA:BreakTime": "float", + "TAGame.SpecialPickup_Targeted_TA:Targeted": "flagged_int", "TAGame.Team_Soccar_TA:GameScore": "int", "TAGame.Team_TA:CustomTeamName": "string", "TAGame.Team_TA:GameEvent": "flagged_int", diff --git a/library/Octane/Type.hs b/library/Octane/Type.hs --- a/library/Octane/Type.hs +++ b/library/Octane/Type.hs @@ -3,6 +3,7 @@ , module Octane.Type.CacheItem , module Octane.Type.CacheProperty , module Octane.Type.ClassItem + , module Octane.Type.CompressedWord , module Octane.Type.Dictionary , module Octane.Type.Float32 , module Octane.Type.Frame @@ -36,6 +37,7 @@ import Octane.Type.CacheItem import Octane.Type.CacheProperty import Octane.Type.ClassItem +import Octane.Type.CompressedWord import Octane.Type.Dictionary import Octane.Type.Float32 import Octane.Type.Frame diff --git a/library/Octane/Type/CompressedWord.hs b/library/Octane/Type/CompressedWord.hs --- a/library/Octane/Type/CompressedWord.hs +++ b/library/Octane/Type/CompressedWord.hs @@ -22,7 +22,6 @@ import qualified Data.Aeson as Aeson import qualified Data.Binary.Bits as BinaryBit import qualified Data.Binary.Bits.Get as BinaryBit -import qualified Data.Binary.Bits.Put as BinaryBit import qualified Data.Bits as Bits import qualified Data.Default.Class as Default import qualified Data.OverloadedRecords.TH as OverloadedRecords @@ -47,16 +46,30 @@ value <- getStep limit (bitSize limit) 0 0 pure (CompressedWord limit value) putBits _ compressedWord = do - let limit = fromIntegral (#limit compressedWord) - let value = fromIntegral (#value compressedWord) + let limit = compressedWord & #limit + let value = compressedWord & #value + if value > limit + then fail ("value " ++ show value ++ " > limit " ++ show limit) + else pure () let maxBits = bitSize limit - let upper = (2 ^ (maxBits - 1)) - 1 - let lower = limit - upper - let numBits = - if lower > value || value > upper - then maxBits - else maxBits - 1 - BinaryBit.putWord64be numBits value + let go position soFar = do + if position < maxBits + then do + let x = Bits.shiftL 1 position + if maxBits > 1 && position == maxBits - 1 && soFar + x > limit + then do + pure () + else do + let bit = position & Bits.testBit value + bit & Boolean.Boolean & BinaryBit.putBits 0 + let delta = + if bit + then x + else 0 + go (position + 1) (soFar + delta) + else do + pure () + go 0 0 instance DeepSeq.NFData CompressedWord @@ -76,7 +89,7 @@ bitSize :: (Integral a, Integral b) => a -> b -bitSize x = x & fromIntegral & logBase (2 :: Double) & ceiling +bitSize x = x & fromIntegral & logBase (2 :: Double) & ceiling & max 1 getStep :: Word -> Word -> Word -> Word -> BinaryBit.BitGet Word getStep limit maxBits position value = do diff --git a/library/Octane/Type/Frame.hs b/library/Octane/Type/Frame.hs --- a/library/Octane/Type/Frame.hs +++ b/library/Octane/Type/Frame.hs @@ -81,7 +81,7 @@ Aeson.toJSON getSpawned :: [Replication.Replication] -> Spawned -getSpawned xs = xs & filter (\x -> x & #state & (== State.SOpening)) & Spawned +getSpawned xs = xs & filter (\x -> x & #state & State.isOpening) & Spawned newtype Updated = Updated [Replication.Replication] @@ -99,7 +99,7 @@ getUpdated :: [Replication.Replication] -> Updated getUpdated xs = - xs & filter (\x -> x & #state & (== State.SExisting)) & + xs & filter (\x -> x & #state & State.isExisting) & filter (\x -> x & #properties & null & not) & Updated @@ -110,4 +110,4 @@ toJSON (Destroyed xs) = xs & map #actorId & map #value & Aeson.toJSON getDestroyed :: [Replication.Replication] -> Destroyed -getDestroyed xs = xs & filter (\x -> x & #state & (== State.SClosing)) & Destroyed +getDestroyed xs = xs & filter (\x -> x & #state & State.isClosing) & Destroyed diff --git a/library/Octane/Type/Initialization.hs b/library/Octane/Type/Initialization.hs --- a/library/Octane/Type/Initialization.hs +++ b/library/Octane/Type/Initialization.hs @@ -54,9 +54,7 @@ else pure Nothing pure Initialization - { initializationLocation = location - , initializationRotation = rotation - } + {initializationLocation = location, initializationRotation = rotation} -- | Puts the 'Initialization'. Note that unlike 'getInitialization', this does -- not require the class name. diff --git a/library/Octane/Type/Int32.hs b/library/Octane/Type/Int32.hs --- a/library/Octane/Type/Int32.hs +++ b/library/Octane/Type/Int32.hs @@ -34,7 +34,7 @@ -- | A 32-bit signed integer. newtype Int32 = Int32 { int32Unpack :: Int.Int32 - } deriving (Eq, Generics.Generic, Num, Ord) + } deriving (Enum, Eq, Generics.Generic, Num, Ord) $(OverloadedRecords.overloadedRecord Default.def ''Int32) diff --git a/library/Octane/Type/Property.hs b/library/Octane/Type/Property.hs --- a/library/Octane/Type/Property.hs +++ b/library/Octane/Type/Property.hs @@ -1,256 +1,40 @@ -{-# LANGUAGE DataKinds #-} {-# LANGUAGE DeriveGeneric #-} -{-# LANGUAGE FlexibleContexts #-} -{-# LANGUAGE FlexibleInstances #-} -{-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE OverloadedLabels #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE StrictData #-} -{-# LANGUAGE TemplateHaskell #-} -{-# LANGUAGE TypeFamilies #-} module Octane.Type.Property ( Property(..) - , ArrayProperty(..) - , BoolProperty(..) - , ByteProperty(..) - , FloatProperty(..) - , IntProperty(..) - , NameProperty(..) - , QWordProperty(..) - , StrProperty(..) + , module Octane.Type.Property.ArrayProperty + , module Octane.Type.Property.BoolProperty + , module Octane.Type.Property.ByteProperty + , module Octane.Type.Property.FloatProperty + , module Octane.Type.Property.IntProperty + , module Octane.Type.Property.NameProperty + , module Octane.Type.Property.QWordProperty + , module Octane.Type.Property.StrProperty ) where -import Data.Aeson ((.=)) -import Data.Function ((&)) +import Octane.Type.Property.ArrayProperty +import Octane.Type.Property.BoolProperty +import Octane.Type.Property.ByteProperty +import Octane.Type.Property.FloatProperty +import Octane.Type.Property.IntProperty +import Octane.Type.Property.NameProperty +import Octane.Type.Property.QWordProperty +import Octane.Type.Property.StrProperty import qualified Control.DeepSeq as DeepSeq import qualified Data.Aeson as Aeson import qualified Data.Binary as Binary -import qualified Data.Default.Class as Default -import qualified Data.OverloadedRecords.TH as OverloadedRecords import qualified GHC.Generics as Generics -import qualified Octane.Type.Boolean as Boolean -import qualified Octane.Type.Dictionary as Dictionary -import qualified Octane.Type.Float32 as Float32 -import qualified Octane.Type.Int32 as Int32 -import qualified Octane.Type.List as List import qualified Octane.Type.Text as Text -import qualified Octane.Type.Word64 as Word64 -data ArrayProperty = ArrayProperty - { arrayPropertySize :: Word64.Word64 - , arrayPropertyContent :: List.List (Dictionary.Dictionary Property) - } deriving (Eq, Generics.Generic, Show) - -instance Binary.Binary ArrayProperty where - get = do - size <- Binary.get - content <- Binary.get - pure (ArrayProperty size content) - put array = do - array & #size & Binary.put - array & #content & Binary.put - -instance DeepSeq.NFData ArrayProperty - -instance Aeson.ToJSON ArrayProperty where - toJSON array = - Aeson.object - [ "Type" .= ("Array" :: Text.Text) - , "Size" .= #size array - , "Value" .= #content array - ] - -data BoolProperty = BoolProperty - { boolPropertySize :: Word64.Word64 - , boolPropertyContent :: Boolean.Boolean - } deriving (Eq, Generics.Generic, Show) - -instance Binary.Binary BoolProperty where - get = do - size <- Binary.get - content <- Binary.get - pure (BoolProperty size content) - put bool = do - bool & #size & Binary.put - bool & #content & Binary.put - -instance DeepSeq.NFData BoolProperty - -instance Aeson.ToJSON BoolProperty where - toJSON bool = - Aeson.object - [ "Type" .= ("Bool" :: Text.Text) - , "Size" .= #size bool - , "Value" .= #content bool - ] - -data ByteProperty = ByteProperty - { bytePropertySize :: Word64.Word64 - , bytePropertyKey :: Text.Text - , bytePropertyValue :: Text.Text - } deriving (Eq, Generics.Generic, Show) - -instance Binary.Binary ByteProperty where - get = do - size <- Binary.get - key <- Binary.get - if key == "OnlinePlatform_Steam" - then do - pure (ByteProperty size "OnlinePlatform" key) - else do - value <- Binary.get - pure (ByteProperty size key value) - put byte = do - byte & #size & Binary.put - byte & #key & Binary.put - byte & #value & Binary.put - -instance DeepSeq.NFData ByteProperty - -instance Aeson.ToJSON ByteProperty where - toJSON byte = - Aeson.object - [ "Type" .= ("Byte" :: Text.Text) - , "Size" .= #size byte - , "Value" .= (#key byte, #value byte) - ] - -data FloatProperty = FloatProperty - { floatPropertySize :: Word64.Word64 - , floatPropertyContent :: Float32.Float32 - } deriving (Eq, Generics.Generic, Show) - -instance Binary.Binary FloatProperty where - get = do - size <- Binary.get - content <- - case #unpack size of - 4 -> Binary.get - x -> fail ("unknown FloatProperty size " ++ show x) - pure (FloatProperty size content) - put float = do - float & #size & Binary.put - float & #content & Binary.put - -instance DeepSeq.NFData FloatProperty - -instance Aeson.ToJSON FloatProperty where - toJSON float = - Aeson.object - [ "Type" .= ("Float" :: Text.Text) - , "Size" .= #size float - , "Value" .= #content float - ] - -data IntProperty = IntProperty - { intPropertySize :: Word64.Word64 - , intPropertyContent :: Int32.Int32 - } deriving (Eq, Generics.Generic, Show) - -instance Binary.Binary IntProperty where - get = do - size <- Binary.get - content <- - case #unpack size of - 4 -> Binary.get - x -> fail ("unknown IntProperty size " ++ show x) - pure (IntProperty size content) - put int = do - int & #size & Binary.put - int & #content & Binary.put - -instance DeepSeq.NFData IntProperty - -instance Aeson.ToJSON IntProperty where - toJSON int = - Aeson.object - [ "Type" .= ("Int" :: Text.Text) - , "Size" .= #size int - , "Value" .= #content int - ] - -data NameProperty = NameProperty - { namePropertySize :: Word64.Word64 - , namePropertyContent :: Text.Text - } deriving (Eq, Generics.Generic, Show) - -instance Binary.Binary NameProperty where - get = do - size <- Binary.get - content <- Binary.get - pure (NameProperty size content) - put name = do - name & #size & Binary.put - name & #content & Binary.put - -instance DeepSeq.NFData NameProperty - -instance Aeson.ToJSON NameProperty where - toJSON name = - Aeson.object - [ "Type" .= ("Name" :: Text.Text) - , "Size" .= #size name - , "Value" .= #content name - ] - -data QWordProperty = QWordProperty - { qWordPropertySize :: Word64.Word64 - , qWordPropertyContent :: Word64.Word64 - } deriving (Eq, Generics.Generic, Show) - -instance Binary.Binary QWordProperty where - get = do - size <- Binary.get - content <- - case #unpack size of - 8 -> Binary.get - x -> fail ("unknown QWordProperty size " ++ show x) - pure (QWordProperty size content) - put qWord = do - qWord & #size & Binary.put - qWord & #content & Binary.put - -instance DeepSeq.NFData QWordProperty - -instance Aeson.ToJSON QWordProperty where - toJSON qWord = - Aeson.object - [ "Type" .= ("QWord" :: Text.Text) - , "Size" .= #size qWord - , "Value" .= #content qWord - ] - -data StrProperty = StrProperty - { strPropertySize :: Word64.Word64 - , strPropertyContent :: Text.Text - } deriving (Eq, Generics.Generic, Show) - -instance Binary.Binary StrProperty where - get = do - size <- Binary.get - content <- Binary.get - pure (StrProperty size content) - put str = do - str & #size & Binary.put - str & #content & Binary.put - -instance DeepSeq.NFData StrProperty - -instance Aeson.ToJSON StrProperty where - toJSON str = - Aeson.object - [ "Type" .= ("Str" :: Text.Text) - , "Size" .= #size str - , "Value" .= #content str - ] - -- | A metadata property. All properties have a size, but only some actually -- use it. The value stored in the property can be an array, a boolean, and -- so on. data Property - = PropertyArray ArrayProperty + = PropertyArray (ArrayProperty Property) | PropertyBool BoolProperty | PropertyByte ByteProperty | PropertyFloat FloatProperty @@ -260,18 +44,6 @@ | PropertyStr StrProperty deriving (Eq, Generics.Generic, Show) -$(OverloadedRecords.overloadedRecords - Default.def - [ ''ArrayProperty - , ''BoolProperty - , ''ByteProperty - , ''FloatProperty - , ''IntProperty - , ''NameProperty - , ''QWordProperty - , ''StrProperty - ]) - -- | Stored with the size first, then the value. instance Binary.Binary Property where get = do @@ -342,14 +114,14 @@ instance Aeson.ToJSON Property where toJSON property = case property of - PropertyArray array -> Aeson.toJSON array - PropertyBool bool -> Aeson.toJSON bool - PropertyByte byte -> Aeson.toJSON byte - PropertyFloat float -> Aeson.toJSON float - PropertyInt int -> Aeson.toJSON int - PropertyName name -> Aeson.toJSON name - PropertyQWord qWord -> Aeson.toJSON qWord - PropertyStr str -> Aeson.toJSON str + PropertyArray x -> Aeson.toJSON x + PropertyBool x -> Aeson.toJSON x + PropertyByte x -> Aeson.toJSON x + PropertyFloat x -> Aeson.toJSON x + PropertyInt x -> Aeson.toJSON x + PropertyName x -> Aeson.toJSON x + PropertyQWord x -> Aeson.toJSON x + PropertyStr x -> Aeson.toJSON x arrayProperty :: Text.Text arrayProperty = "ArrayProperty" diff --git a/library/Octane/Type/Property/ArrayProperty.hs b/library/Octane/Type/Property/ArrayProperty.hs new file mode 100644 --- /dev/null +++ b/library/Octane/Type/Property/ArrayProperty.hs @@ -0,0 +1,57 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE OverloadedLabels #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE StrictData #-} +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE TypeFamilies #-} + +module Octane.Type.Property.ArrayProperty + ( ArrayProperty(..) + ) where + +import Data.Aeson ((.=)) +import Data.Function ((&)) + +import qualified Control.DeepSeq as DeepSeq +import qualified Data.Aeson as Aeson +import qualified Data.Binary as Binary +import qualified Data.Default.Class as Default +import qualified Data.OverloadedRecords.TH as OverloadedRecords +import qualified GHC.Generics as Generics +import qualified Octane.Type.Dictionary as Dictionary +import qualified Octane.Type.List as List +import qualified Octane.Type.Text as Text +import qualified Octane.Type.Word64 as Word64 + +data ArrayProperty a = ArrayProperty + { arrayPropertySize :: Word64.Word64 + , arrayPropertyContent :: List.List (Dictionary.Dictionary a) + } deriving (Eq, Generics.Generic, Show) + +$(OverloadedRecords.overloadedRecord Default.def ''ArrayProperty) + +instance (Binary.Binary a) => + Binary.Binary (ArrayProperty a) where + get = do + size <- Binary.get + content <- Binary.get + pure (ArrayProperty size content) + put array = do + array & #size & Binary.put + array & #content & Binary.put + +instance (DeepSeq.NFData a) => + DeepSeq.NFData (ArrayProperty a) + +instance (Aeson.ToJSON a) => + Aeson.ToJSON (ArrayProperty a) where + toJSON array = + Aeson.object + [ "Type" .= ("Array" :: Text.Text) + , "Size" .= #size array + , "Value" .= #content array + ] diff --git a/library/Octane/Type/Property/BoolProperty.hs b/library/Octane/Type/Property/BoolProperty.hs new file mode 100644 --- /dev/null +++ b/library/Octane/Type/Property/BoolProperty.hs @@ -0,0 +1,53 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE OverloadedLabels #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE StrictData #-} +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE TypeFamilies #-} + +module Octane.Type.Property.BoolProperty + ( BoolProperty(..) + ) where + +import Data.Aeson ((.=)) +import Data.Function ((&)) + +import qualified Control.DeepSeq as DeepSeq +import qualified Data.Aeson as Aeson +import qualified Data.Binary as Binary +import qualified Data.Default.Class as Default +import qualified Data.OverloadedRecords.TH as OverloadedRecords +import qualified GHC.Generics as Generics +import qualified Octane.Type.Boolean as Boolean +import qualified Octane.Type.Text as Text +import qualified Octane.Type.Word64 as Word64 + +data BoolProperty = BoolProperty + { boolPropertySize :: Word64.Word64 + , boolPropertyContent :: Boolean.Boolean + } deriving (Eq, Generics.Generic, Show) + +$(OverloadedRecords.overloadedRecord Default.def ''BoolProperty) + +instance Binary.Binary BoolProperty where + get = do + size <- Binary.get + content <- Binary.get + pure (BoolProperty size content) + put bool = do + bool & #size & Binary.put + bool & #content & Binary.put + +instance DeepSeq.NFData BoolProperty + +instance Aeson.ToJSON BoolProperty where + toJSON bool = + Aeson.object + [ "Type" .= ("Bool" :: Text.Text) + , "Size" .= #size bool + , "Value" .= #content bool + ] diff --git a/library/Octane/Type/Property/ByteProperty.hs b/library/Octane/Type/Property/ByteProperty.hs new file mode 100644 --- /dev/null +++ b/library/Octane/Type/Property/ByteProperty.hs @@ -0,0 +1,59 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE OverloadedLabels #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE StrictData #-} +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE TypeFamilies #-} + +module Octane.Type.Property.ByteProperty + ( ByteProperty(..) + ) where + +import Data.Aeson ((.=)) +import Data.Function ((&)) + +import qualified Control.DeepSeq as DeepSeq +import qualified Data.Aeson as Aeson +import qualified Data.Binary as Binary +import qualified Data.Default.Class as Default +import qualified Data.OverloadedRecords.TH as OverloadedRecords +import qualified GHC.Generics as Generics +import qualified Octane.Type.Text as Text +import qualified Octane.Type.Word64 as Word64 + +data ByteProperty = ByteProperty + { bytePropertySize :: Word64.Word64 + , bytePropertyKey :: Text.Text + , bytePropertyValue :: Text.Text + } deriving (Eq, Generics.Generic, Show) + +$(OverloadedRecords.overloadedRecord Default.def ''ByteProperty) + +instance Binary.Binary ByteProperty where + get = do + size <- Binary.get + key <- Binary.get + if key == "OnlinePlatform_Steam" + then do + pure (ByteProperty size "OnlinePlatform" key) + else do + value <- Binary.get + pure (ByteProperty size key value) + put byte = do + byte & #size & Binary.put + byte & #key & Binary.put + byte & #value & Binary.put + +instance DeepSeq.NFData ByteProperty + +instance Aeson.ToJSON ByteProperty where + toJSON byte = + Aeson.object + [ "Type" .= ("Byte" :: Text.Text) + , "Size" .= #size byte + , "Value" .= (#key byte, #value byte) + ] diff --git a/library/Octane/Type/Property/FloatProperty.hs b/library/Octane/Type/Property/FloatProperty.hs new file mode 100644 --- /dev/null +++ b/library/Octane/Type/Property/FloatProperty.hs @@ -0,0 +1,56 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE OverloadedLabels #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE StrictData #-} +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE TypeFamilies #-} + +module Octane.Type.Property.FloatProperty + ( FloatProperty(..) + ) where + +import Data.Aeson ((.=)) +import Data.Function ((&)) + +import qualified Control.DeepSeq as DeepSeq +import qualified Data.Aeson as Aeson +import qualified Data.Binary as Binary +import qualified Data.Default.Class as Default +import qualified Data.OverloadedRecords.TH as OverloadedRecords +import qualified GHC.Generics as Generics +import qualified Octane.Type.Float32 as Float32 +import qualified Octane.Type.Text as Text +import qualified Octane.Type.Word64 as Word64 + +data FloatProperty = FloatProperty + { floatPropertySize :: Word64.Word64 + , floatPropertyContent :: Float32.Float32 + } deriving (Eq, Generics.Generic, Show) + +$(OverloadedRecords.overloadedRecord Default.def ''FloatProperty) + +instance Binary.Binary FloatProperty where + get = do + size <- Binary.get + content <- + case #unpack size of + 4 -> Binary.get + x -> fail ("unknown FloatProperty size " ++ show x) + pure (FloatProperty size content) + put float = do + float & #size & Binary.put + float & #content & Binary.put + +instance DeepSeq.NFData FloatProperty + +instance Aeson.ToJSON FloatProperty where + toJSON float = + Aeson.object + [ "Type" .= ("Float" :: Text.Text) + , "Size" .= #size float + , "Value" .= #content float + ] diff --git a/library/Octane/Type/Property/IntProperty.hs b/library/Octane/Type/Property/IntProperty.hs new file mode 100644 --- /dev/null +++ b/library/Octane/Type/Property/IntProperty.hs @@ -0,0 +1,56 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE OverloadedLabels #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE StrictData #-} +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE TypeFamilies #-} + +module Octane.Type.Property.IntProperty + ( IntProperty(..) + ) where + +import Data.Aeson ((.=)) +import Data.Function ((&)) + +import qualified Control.DeepSeq as DeepSeq +import qualified Data.Aeson as Aeson +import qualified Data.Binary as Binary +import qualified Data.Default.Class as Default +import qualified Data.OverloadedRecords.TH as OverloadedRecords +import qualified GHC.Generics as Generics +import qualified Octane.Type.Int32 as Int32 +import qualified Octane.Type.Text as Text +import qualified Octane.Type.Word64 as Word64 + +data IntProperty = IntProperty + { intPropertySize :: Word64.Word64 + , intPropertyContent :: Int32.Int32 + } deriving (Eq, Generics.Generic, Show) + +$(OverloadedRecords.overloadedRecord Default.def ''IntProperty) + +instance Binary.Binary IntProperty where + get = do + size <- Binary.get + content <- + case #unpack size of + 4 -> Binary.get + x -> fail ("unknown IntProperty size " ++ show x) + pure (IntProperty size content) + put int = do + int & #size & Binary.put + int & #content & Binary.put + +instance DeepSeq.NFData IntProperty + +instance Aeson.ToJSON IntProperty where + toJSON int = + Aeson.object + [ "Type" .= ("Int" :: Text.Text) + , "Size" .= #size int + , "Value" .= #content int + ] diff --git a/library/Octane/Type/Property/NameProperty.hs b/library/Octane/Type/Property/NameProperty.hs new file mode 100644 --- /dev/null +++ b/library/Octane/Type/Property/NameProperty.hs @@ -0,0 +1,52 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE OverloadedLabels #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE StrictData #-} +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE TypeFamilies #-} + +module Octane.Type.Property.NameProperty + ( NameProperty(..) + ) where + +import Data.Aeson ((.=)) +import Data.Function ((&)) + +import qualified Control.DeepSeq as DeepSeq +import qualified Data.Aeson as Aeson +import qualified Data.Binary as Binary +import qualified Data.Default.Class as Default +import qualified Data.OverloadedRecords.TH as OverloadedRecords +import qualified GHC.Generics as Generics +import qualified Octane.Type.Text as Text +import qualified Octane.Type.Word64 as Word64 + +data NameProperty = NameProperty + { namePropertySize :: Word64.Word64 + , namePropertyContent :: Text.Text + } deriving (Eq, Generics.Generic, Show) + +$(OverloadedRecords.overloadedRecord Default.def ''NameProperty) + +instance Binary.Binary NameProperty where + get = do + size <- Binary.get + content <- Binary.get + pure (NameProperty size content) + put name = do + name & #size & Binary.put + name & #content & Binary.put + +instance DeepSeq.NFData NameProperty + +instance Aeson.ToJSON NameProperty where + toJSON name = + Aeson.object + [ "Type" .= ("Name" :: Text.Text) + , "Size" .= #size name + , "Value" .= #content name + ] diff --git a/library/Octane/Type/Property/QWordProperty.hs b/library/Octane/Type/Property/QWordProperty.hs new file mode 100644 --- /dev/null +++ b/library/Octane/Type/Property/QWordProperty.hs @@ -0,0 +1,55 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE OverloadedLabels #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE StrictData #-} +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE TypeFamilies #-} + +module Octane.Type.Property.QWordProperty + ( QWordProperty(..) + ) where + +import Data.Aeson ((.=)) +import Data.Function ((&)) + +import qualified Control.DeepSeq as DeepSeq +import qualified Data.Aeson as Aeson +import qualified Data.Binary as Binary +import qualified Data.Default.Class as Default +import qualified Data.OverloadedRecords.TH as OverloadedRecords +import qualified GHC.Generics as Generics +import qualified Octane.Type.Text as Text +import qualified Octane.Type.Word64 as Word64 + +data QWordProperty = QWordProperty + { qWordPropertySize :: Word64.Word64 + , qWordPropertyContent :: Word64.Word64 + } deriving (Eq, Generics.Generic, Show) + +$(OverloadedRecords.overloadedRecord Default.def ''QWordProperty) + +instance Binary.Binary QWordProperty where + get = do + size <- Binary.get + content <- + case #unpack size of + 8 -> Binary.get + x -> fail ("unknown QWordProperty size " ++ show x) + pure (QWordProperty size content) + put qWord = do + qWord & #size & Binary.put + qWord & #content & Binary.put + +instance DeepSeq.NFData QWordProperty + +instance Aeson.ToJSON QWordProperty where + toJSON qWord = + Aeson.object + [ "Type" .= ("QWord" :: Text.Text) + , "Size" .= #size qWord + , "Value" .= #content qWord + ] diff --git a/library/Octane/Type/Property/StrProperty.hs b/library/Octane/Type/Property/StrProperty.hs new file mode 100644 --- /dev/null +++ b/library/Octane/Type/Property/StrProperty.hs @@ -0,0 +1,49 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE OverloadedLabels #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE StrictData #-} +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE TypeFamilies #-} + +module Octane.Type.Property.StrProperty + ( StrProperty(..) + ) where + +import Data.Aeson ((.=)) +import Data.Function ((&)) + +import qualified Control.DeepSeq as DeepSeq +import qualified Data.Aeson as Aeson +import qualified Data.Binary as Binary +import qualified Data.Default.Class as Default +import qualified Data.OverloadedRecords.TH as OverloadedRecords +import qualified GHC.Generics as Generics +import qualified Octane.Type.Text as Text +import qualified Octane.Type.Word64 as Word64 + +data StrProperty = StrProperty + { strPropertySize :: Word64.Word64 + , strPropertyContent :: Text.Text + } deriving (Eq, Generics.Generic, Show) + +$(OverloadedRecords.overloadedRecord Default.def ''StrProperty) + +instance Binary.Binary StrProperty where + get = do + size <- Binary.get + content <- Binary.get + pure (StrProperty size content) + put str = do + str & #size & Binary.put + str & #content & Binary.put + +instance DeepSeq.NFData StrProperty + +instance Aeson.ToJSON StrProperty where + toJSON x = + Aeson.object + ["Type" .= ("Str" :: Text.Text), "Size" .= #size x, "Value" .= #content x] diff --git a/library/Octane/Type/RawReplay.hs b/library/Octane/Type/RawReplay.hs --- a/library/Octane/Type/RawReplay.hs +++ b/library/Octane/Type/RawReplay.hs @@ -65,7 +65,14 @@ checkCRC contentCRC content footer <- Binary.getRemainingLazyByteString pure - (RawReplay headerSize headerCRC header contentSize contentCRC content footer) + (RawReplay + headerSize + headerCRC + header + contentSize + contentCRC + content + footer) put replay = do Binary.put (#headerSize replay) Binary.put (#headerCRC replay) diff --git a/library/Octane/Type/RemoteId.hs b/library/Octane/Type/RemoteId.hs --- a/library/Octane/Type/RemoteId.hs +++ b/library/Octane/Type/RemoteId.hs @@ -1,135 +1,23 @@ -{-# LANGUAGE DataKinds #-} {-# LANGUAGE DeriveGeneric #-} -{-# LANGUAGE FlexibleContexts #-} -{-# LANGUAGE FlexibleInstances #-} -{-# LANGUAGE MultiParamTypeClasses #-} -{-# LANGUAGE OverloadedLabels #-} -{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE StrictData #-} -{-# LANGUAGE TemplateHaskell #-} -{-# LANGUAGE TypeFamilies #-} module Octane.Type.RemoteId ( RemoteId(..) - , SteamId(..) - , PlayStationId(..) - , SplitscreenId(..) - , XboxId(..) + , module Octane.Type.RemoteId.PlayStationId + , module Octane.Type.RemoteId.SplitscreenId + , module Octane.Type.RemoteId.SteamId + , module Octane.Type.RemoteId.XboxId ) where -import Data.Aeson ((.=)) -import Data.Function ((&)) +import Octane.Type.RemoteId.PlayStationId +import Octane.Type.RemoteId.SplitscreenId +import Octane.Type.RemoteId.SteamId +import Octane.Type.RemoteId.XboxId import qualified Control.DeepSeq as DeepSeq import qualified Data.Aeson as Aeson -import qualified Data.Binary.Bits as BinaryBit -import qualified Data.Binary.Bits.Get as BinaryBit -import qualified Data.Binary.Bits.Put as BinaryBit -import qualified Data.ByteString.Lazy as LazyBytes -import qualified Data.Default.Class as Default -import qualified Data.OverloadedRecords.TH as OverloadedRecords -import qualified Data.Text as StrictText -import qualified Data.Text.Encoding as Encoding import qualified GHC.Generics as Generics -import qualified Octane.Type.Text as Text -import qualified Octane.Type.Word64 as Word64 -import qualified Octane.Utility.Endian as Endian -import qualified Text.Printf as Printf -data PlayStationId = PlayStationId - { playStationIdName :: Text.Text - , playStationIdUnknown :: LazyBytes.ByteString - } deriving (Eq, Generics.Generic, Show) - --- | Each part is stored as exactly 16 bits. -instance BinaryBit.BinaryBit PlayStationId where - getBits _ = do - nameBytes <- BinaryBit.getByteString 16 - let name = - nameBytes & Endian.reverseBitsInStrictBytes & Encoding.decodeLatin1 & - StrictText.dropWhileEnd (== '\0') & - Text.Text - unknownBytes <- BinaryBit.getByteString 16 - let unknown = unknownBytes & Endian.reverseBitsInStrictBytes & LazyBytes.fromStrict - pure (PlayStationId name unknown) - putBits _ playStationId = do - playStationId & #name & #unpack & StrictText.justifyLeft 16 '\x00' & - StrictText.take 16 & - Text.encodeLatin1 & - Endian.reverseBitsInStrictBytes & - BinaryBit.putByteString - playStationId & #unknown & LazyBytes.toStrict & Endian.reverseBitsInStrictBytes & - BinaryBit.putByteString - -instance DeepSeq.NFData PlayStationId - -instance Aeson.ToJSON PlayStationId where - toJSON playStationId = - Aeson.object - [ "Name" .= #name playStationId - , "Unknown" .= - (playStationId & #unknown & LazyBytes.unpack & - concatMap (Printf.printf "%02x") & - ("0x" ++) & - StrictText.pack) - ] - -newtype SplitscreenId = SplitscreenId - { splitscreenIdUnpack :: Maybe Int - } deriving (Eq, Generics.Generic, Show) - --- | Stored as a bare byte string. -instance BinaryBit.BinaryBit SplitscreenId where - getBits _ = do - bytes <- BinaryBit.getByteString 3 - case bytes of - "\x00\x00\x00" -> do - pure (SplitscreenId (Just 0)) - _ -> do - fail ("Unexpected SplitscreenId value " ++ show bytes) - putBits _ _splitscreenId = do - BinaryBit.putByteString "\x00\x00\x00" - -instance DeepSeq.NFData SplitscreenId - --- | Encoded as an optional number. -instance Aeson.ToJSON SplitscreenId where - toJSON splitscreenId = splitscreenId & #unpack & Aeson.toJSON - -newtype SteamId = SteamId - { steamIdUnpack :: Word64.Word64 - } deriving (Eq, Generics.Generic, Show) - --- | Stored as a plain 'Word64.Word64'. -instance BinaryBit.BinaryBit SteamId where - getBits _ = do - steamId <- BinaryBit.getBits 0 - pure (SteamId steamId) - putBits _ steamId = steamId & #unpack & BinaryBit.putBits 0 - -instance DeepSeq.NFData SteamId - --- | Encoded directly as a number. -instance Aeson.ToJSON SteamId where - toJSON steamId = steamId & #unpack & Aeson.toJSON - -newtype XboxId = XboxId - { xboxIdUnpack :: Word64.Word64 - } deriving (Eq, Generics.Generic, Show) - --- | Stored as a plain 'Word64.Word64'. -instance BinaryBit.BinaryBit XboxId where - getBits _ = do - xboxId <- BinaryBit.getBits 0 - pure (XboxId xboxId) - putBits _ xboxId = xboxId & #unpack & BinaryBit.putBits 0 - -instance DeepSeq.NFData XboxId - --- | Encoded directly as a number. -instance Aeson.ToJSON XboxId where - toJSON xboxId = xboxId & #unpack & Aeson.toJSON - -- | A player's canonical remote ID. This is the best way to uniquely identify -- players data RemoteId @@ -139,25 +27,12 @@ | RemoteXboxId XboxId deriving (Eq, Generics.Generic, Show) -$(OverloadedRecords.overloadedRecords - Default.def - [''PlayStationId, ''SplitscreenId, ''SteamId, ''XboxId]) - instance DeepSeq.NFData RemoteId --- | Encodes the remote ID as an object with "Type" and "Value" keys. instance Aeson.ToJSON RemoteId where toJSON remoteId = case remoteId of - RemotePlayStationId x -> - Aeson.object - ["Type" .= ("PlayStation" :: Text.Text), "Value" .= Aeson.toJSON x] - RemoteSplitscreenId x -> - Aeson.object - ["Type" .= ("Splitscreen" :: Text.Text), "Value" .= Aeson.toJSON x] - RemoteSteamId x -> - Aeson.object - ["Type" .= ("Steam" :: Text.Text), "Value" .= Aeson.toJSON x] - RemoteXboxId x -> - Aeson.object - ["Type" .= ("Xbox" :: Text.Text), "Value" .= Aeson.toJSON x] + RemotePlayStationId x -> Aeson.toJSON x + RemoteSplitscreenId x -> Aeson.toJSON x + RemoteSteamId x -> Aeson.toJSON x + RemoteXboxId x -> Aeson.toJSON x diff --git a/library/Octane/Type/RemoteId/PlayStationId.hs b/library/Octane/Type/RemoteId/PlayStationId.hs new file mode 100644 --- /dev/null +++ b/library/Octane/Type/RemoteId/PlayStationId.hs @@ -0,0 +1,78 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE OverloadedLabels #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE StrictData #-} +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE TypeFamilies #-} + +module Octane.Type.RemoteId.PlayStationId + ( PlayStationId(..) + ) where + +import Data.Aeson ((.=)) +import Data.Function ((&)) + +import qualified Control.DeepSeq as DeepSeq +import qualified Data.Aeson as Aeson +import qualified Data.Binary.Bits as BinaryBit +import qualified Data.Binary.Bits.Get as BinaryBit +import qualified Data.Binary.Bits.Put as BinaryBit +import qualified Data.ByteString.Lazy as LazyBytes +import qualified Data.Default.Class as Default +import qualified Data.OverloadedRecords.TH as OverloadedRecords +import qualified Data.Text as StrictText +import qualified Data.Text.Encoding as Encoding +import qualified GHC.Generics as Generics +import qualified Octane.Type.Text as Text +import qualified Octane.Utility.Endian as Endian +import qualified Text.Printf as Printf + +data PlayStationId = PlayStationId + { playStationIdName :: Text.Text + , playStationIdUnknown :: LazyBytes.ByteString + } deriving (Eq, Generics.Generic, Show) + +$(OverloadedRecords.overloadedRecord Default.def ''PlayStationId) + +-- | Each part is stored as exactly 16 bits. +instance BinaryBit.BinaryBit PlayStationId where + getBits _ = do + nameBytes <- BinaryBit.getByteString 16 + let name = + nameBytes & Endian.reverseBitsInStrictBytes & Encoding.decodeLatin1 & + StrictText.dropWhileEnd (== '\0') & + Text.Text + unknownBytes <- BinaryBit.getByteString 16 + let unknown = + unknownBytes & Endian.reverseBitsInStrictBytes & LazyBytes.fromStrict + pure (PlayStationId name unknown) + putBits _ playStationId = do + playStationId & #name & #unpack & StrictText.justifyLeft 16 '\x00' & + StrictText.take 16 & + Text.encodeLatin1 & + Endian.reverseBitsInStrictBytes & + BinaryBit.putByteString + playStationId & #unknown & LazyBytes.toStrict & + Endian.reverseBitsInStrictBytes & + BinaryBit.putByteString + +instance DeepSeq.NFData PlayStationId + +instance Aeson.ToJSON PlayStationId where + toJSON playStationId = + Aeson.object + [ "Type" .= ("PlayStation" :: StrictText.Text) + , "Value" .= + Aeson.object + [ "Name" .= #name playStationId + , "Unknown" .= + (playStationId & #unknown & LazyBytes.unpack & + concatMap (Printf.printf "%02x") & + ("0x" ++) & + StrictText.pack) + ] + ] diff --git a/library/Octane/Type/RemoteId/SplitscreenId.hs b/library/Octane/Type/RemoteId/SplitscreenId.hs new file mode 100644 --- /dev/null +++ b/library/Octane/Type/RemoteId/SplitscreenId.hs @@ -0,0 +1,52 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE OverloadedLabels #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE TypeFamilies #-} + +module Octane.Type.RemoteId.SplitscreenId + ( SplitscreenId(..) + ) where + +import Data.Aeson ((.=)) + +import qualified Control.DeepSeq as DeepSeq +import qualified Data.Aeson as Aeson +import qualified Data.Binary.Bits as BinaryBit +import qualified Data.Binary.Bits.Get as BinaryBit +import qualified Data.Binary.Bits.Put as BinaryBit +import qualified Data.Default.Class as Default +import qualified Data.OverloadedRecords.TH as OverloadedRecords +import qualified Data.Text as StrictText +import qualified GHC.Generics as Generics + +newtype SplitscreenId = SplitscreenId + { splitscreenIdUnpack :: Maybe Int + } deriving (Eq, Generics.Generic, Show) + +$(OverloadedRecords.overloadedRecord Default.def ''SplitscreenId) + +-- | Stored as a bare byte string. +instance BinaryBit.BinaryBit SplitscreenId where + getBits _ = do + bytes <- BinaryBit.getByteString 3 + case bytes of + "\x00\x00\x00" -> do + pure (SplitscreenId (Just 0)) + _ -> do + fail ("Unexpected SplitscreenId value " ++ show bytes) + putBits _ _splitscreenId = do + BinaryBit.putByteString "\x00\x00\x00" + +instance DeepSeq.NFData SplitscreenId + +instance Aeson.ToJSON SplitscreenId where + toJSON splitscreenId = + Aeson.object + [ "Type" .= ("Splitscreen" :: StrictText.Text) + , "Value" .= #unpack splitscreenId + ] diff --git a/library/Octane/Type/RemoteId/SteamId.hs b/library/Octane/Type/RemoteId/SteamId.hs new file mode 100644 --- /dev/null +++ b/library/Octane/Type/RemoteId/SteamId.hs @@ -0,0 +1,45 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE OverloadedLabels #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE TypeFamilies #-} + +module Octane.Type.RemoteId.SteamId + ( SteamId(..) + ) where + +import Data.Aeson ((.=)) +import Data.Function ((&)) + +import qualified Control.DeepSeq as DeepSeq +import qualified Data.Aeson as Aeson +import qualified Data.Binary.Bits as BinaryBit +import qualified Data.Default.Class as Default +import qualified Data.OverloadedRecords.TH as OverloadedRecords +import qualified Data.Text as StrictText +import qualified GHC.Generics as Generics +import qualified Octane.Type.Word64 as Word64 + +newtype SteamId = SteamId + { steamIdUnpack :: Word64.Word64 + } deriving (Eq, Generics.Generic, Show) + +$(OverloadedRecords.overloadedRecord Default.def ''SteamId) + +-- | Stored as a plain 'Word64.Word64'. +instance BinaryBit.BinaryBit SteamId where + getBits _ = do + steamId <- BinaryBit.getBits 0 + pure (SteamId steamId) + putBits _ steamId = steamId & #unpack & BinaryBit.putBits 0 + +instance DeepSeq.NFData SteamId + +instance Aeson.ToJSON SteamId where + toJSON steamId = + Aeson.object + ["Type" .= ("Steam" :: StrictText.Text), "Value" .= #unpack steamId] diff --git a/library/Octane/Type/RemoteId/XboxId.hs b/library/Octane/Type/RemoteId/XboxId.hs new file mode 100644 --- /dev/null +++ b/library/Octane/Type/RemoteId/XboxId.hs @@ -0,0 +1,45 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE OverloadedLabels #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE TypeFamilies #-} + +module Octane.Type.RemoteId.XboxId + ( XboxId(..) + ) where + +import Data.Aeson ((.=)) +import Data.Function ((&)) + +import qualified Control.DeepSeq as DeepSeq +import qualified Data.Aeson as Aeson +import qualified Data.Binary.Bits as BinaryBit +import qualified Data.Default.Class as Default +import qualified Data.OverloadedRecords.TH as OverloadedRecords +import qualified Data.Text as StrictText +import qualified GHC.Generics as Generics +import qualified Octane.Type.Word64 as Word64 + +newtype XboxId = XboxId + { xboxIdUnpack :: Word64.Word64 + } deriving (Eq, Generics.Generic, Show) + +$(OverloadedRecords.overloadedRecord Default.def ''XboxId) + +-- | Stored as a plain 'Word64.Word64'. +instance BinaryBit.BinaryBit XboxId where + getBits _ = do + xboxId <- BinaryBit.getBits 0 + pure (XboxId xboxId) + putBits _ xboxId = xboxId & #unpack & BinaryBit.putBits 0 + +instance DeepSeq.NFData XboxId + +instance Aeson.ToJSON XboxId where + toJSON xboxId = + Aeson.object + ["Type" .= ("Xbox" :: StrictText.Text), "Value" .= #unpack xboxId] diff --git a/library/Octane/Type/Replay.hs b/library/Octane/Type/Replay.hs --- a/library/Octane/Type/Replay.hs +++ b/library/Octane/Type/Replay.hs @@ -24,9 +24,13 @@ import qualified Data.Default.Class as Default import qualified Data.Map.Strict as Map import qualified Data.OverloadedRecords.TH as OverloadedRecords +import qualified Data.Set as Set import qualified Data.Text as StrictText import qualified Data.Version as Version import qualified GHC.Generics as Generics +import qualified Octane.Type.CacheItem as CacheItem +import qualified Octane.Type.CacheProperty as CacheProperty +import qualified Octane.Type.ClassItem as ClassItem import qualified Octane.Type.Dictionary as Dictionary import qualified Octane.Type.Frame as Frame import qualified Octane.Type.KeyFrame as KeyFrame @@ -123,26 +127,28 @@ pure Replay { replayVersion = - [#version1 optimizedReplay, #version2 optimizedReplay] & map Word32.fromWord32 & - Version.makeVersion - , replayMetadata = optimizedReplay & #properties & #unpack & Map.mapKeys #unpack + [#version1 optimizedReplay, #version2 optimizedReplay] & + map Word32.fromWord32 & + Version.makeVersion + , replayMetadata = + optimizedReplay & #properties & #unpack & Map.mapKeys #unpack , replayLevels = optimizedReplay & #levels & #unpack & map #unpack , replayMessages = - optimizedReplay & #messages & #unpack & - map - (\message -> do - let key = message & #frame & #unpack & show & StrictText.pack - let value = message & #content & #unpack - (key, value)) & - Map.fromList + optimizedReplay & #messages & #unpack & + map + (\message -> do + let key = message & #frame & #unpack & show & StrictText.pack + let value = message & #content & #unpack + (key, value)) & + Map.fromList , replayTickMarks = - optimizedReplay & #marks & #unpack & - map - (\mark -> do - let key = mark & #frame & #unpack & show & StrictText.pack - let value = mark & #label & #unpack - (key, value)) & - Map.fromList + optimizedReplay & #marks & #unpack & + map + (\mark -> do + let key = mark & #frame & #unpack & show & StrictText.pack + let value = mark & #label & #unpack + (key, value)) & + Map.fromList , replayPackages = optimizedReplay & #packages & #unpack & map #unpack , replayFrames = optimizedReplay & #frames } @@ -157,52 +163,102 @@ replay & #version & Version.versionBranch & map Word32.toWord32 -- Key frames aren't important for replays. Mark the first frame as a key -- frame and the rest as regular frames. - let frames_ = + let frames = replay & #frames & zip [0 :: Int ..] & + map (\(index, frame) -> frame {Frame.frameIsKeyFrame = index == 0}) + let objectNames = frames & concatMap #replications & map #objectName + let classNames = frames & concatMap #replications & map #className + let propertyNames = + frames & concatMap #replications & map #properties & concatMap Map.keys + let objects = + [objectNames, classNames, propertyNames] & concat & Set.fromList & + Set.toAscList & + map Text.Text & + List.List + let objectsToPosition = objects & #unpack & flip zip [0 ..] & Map.fromList + classes <- + frames & concatMap #replications & map #className & Set.fromList & + Set.toAscList & + map Text.Text & + mapM + (\className -> + case Map.lookup className objectsToPosition of + Nothing -> + fail + ("class " ++ show className ++ " not found in list of objects") + Just position -> pure (ClassItem.ClassItem className position)) & + fmap List.List + let numClasses = classes & #unpack & length & fromIntegral + classesToProperties <- + frames & concatMap #replications & + concatMap + (\replication -> + zip + (replication & #className & repeat) + (replication & #properties & Map.keys & map Text.Text)) & + zip [numClasses ..] & + mapM + (\(streamId, (className, propertyName)) -> do + case Map.lookup propertyName objectsToPosition of + Nothing -> + fail + ("property " ++ + show propertyName ++ " not found in list of objects") + Just propertyId -> + pure (className, [CacheProperty.CacheProperty propertyId streamId])) & + fmap (Map.fromListWith (++)) + let cache = + classes & #unpack & zip [0 ..] & map - (\(index, frame) -> - frame - { Frame.frameIsKeyFrame = index == 0 - }) + (\(index, classItem) -> do + let classId = #streamId classItem + let parentCacheId = index + let cacheId = index + let properties = + classesToProperties & + Map.findWithDefault [] (classItem & #name & #unpack) & + List.List + CacheItem.CacheItem classId parentCacheId cacheId properties) & + List.List pure OptimizedReplay.OptimizedReplay { OptimizedReplay.optimizedReplayVersion1 = version1 , OptimizedReplay.optimizedReplayVersion2 = version2 , OptimizedReplay.optimizedReplayLabel = "TAGame.Replay_Soccar_TA" , OptimizedReplay.optimizedReplayProperties = - replay & #metadata & Map.mapKeys Text.Text & Dictionary.Dictionary + replay & #metadata & Map.mapKeys Text.Text & Dictionary.Dictionary , OptimizedReplay.optimizedReplayLevels = - replay & #levels & map Text.Text & List.List + replay & #levels & map Text.Text & List.List , OptimizedReplay.optimizedReplayKeyFrames = - frames_ & filter #isKeyFrame & - map - (\frame -> - KeyFrame.KeyFrame - (#time frame) - (frame & #number & Word32.toWord32) - 0) & - List.List - , OptimizedReplay.optimizedReplayFrames = frames_ + frames & filter #isKeyFrame & + map + (\frame -> + KeyFrame.KeyFrame + (#time frame) + (frame & #number & Word32.toWord32) + 0) & + List.List + , OptimizedReplay.optimizedReplayFrames = frames , OptimizedReplay.optimizedReplayMessages = - replay & #messages & Map.toList & - map - (\(key, value) -> do - let frame = key & StrictText.unpack & read & Word32.Word32 - let content = value & Text.Text - Message.Message frame "" content) & - List.List + replay & #messages & Map.toList & + map + (\(key, value) -> do + let frame = key & StrictText.unpack & read & Word32.Word32 + let content = value & Text.Text + Message.Message frame "" content) & + List.List , OptimizedReplay.optimizedReplayMarks = - replay & #tickMarks & Map.toList & - map - (\(key, value) -> do - let label = value & Text.Text - let frame = key & StrictText.unpack & read & Word32.Word32 - Mark.Mark label frame) & - List.List + replay & #tickMarks & Map.toList & + map + (\(key, value) -> do + let label = value & Text.Text + let frame = key & StrictText.unpack & read & Word32.Word32 + Mark.Mark label frame) & + List.List , OptimizedReplay.optimizedReplayPackages = - replay & #packages & map Text.Text & List.List - , OptimizedReplay.optimizedReplayObjects = List.List [] -- TODO + replay & #packages & map Text.Text & List.List + , OptimizedReplay.optimizedReplayObjects = objects , OptimizedReplay.optimizedReplayNames = List.List [] -- TODO - , OptimizedReplay.optimizedReplayClasses = List.List [] -- TODO - , OptimizedReplay.optimizedReplayCache = List.List [] -- TODO + , OptimizedReplay.optimizedReplayClasses = classes + , OptimizedReplay.optimizedReplayCache = cache } diff --git a/library/Octane/Type/State.hs b/library/Octane/Type/State.hs --- a/library/Octane/Type/State.hs +++ b/library/Octane/Type/State.hs @@ -2,6 +2,9 @@ module Octane.Type.State ( State(..) + , isOpening + , isExisting + , isClosing ) where import qualified Control.DeepSeq as DeepSeq @@ -9,12 +12,21 @@ -- | The state of an actor in a replication. data State - = SOpening + = Opening -- ^ This is a new actor that we have not seen before. - | SExisting + | Existing -- ^ We have seen this actor before. - | SClosing + | Closing -- ^ This actor is going away. deriving (Eq, Generics.Generic, Show) instance DeepSeq.NFData State + +isOpening :: State -> Bool +isOpening state = state == Opening + +isExisting :: State -> Bool +isExisting state = state == Existing + +isClosing :: State -> Bool +isClosing state = state == Closing diff --git a/library/Octane/Type/Text.hs b/library/Octane/Type/Text.hs --- a/library/Octane/Type/Text.hs +++ b/library/Octane/Type/Text.hs @@ -49,7 +49,11 @@ -- | Both length-prefixed and null-terminated. The bits in each byte are -- reversed. instance BinaryBit.BinaryBit Text where - getBits _ = getText (BinaryBit.getBits 32) BinaryBit.getByteString Endian.reverseBitsInStrictBytes + getBits _ = + getText + (BinaryBit.getBits 32) + BinaryBit.getByteString + Endian.reverseBitsInStrictBytes putBits _ text = putText (BinaryBit.putBits 32) diff --git a/library/Octane/Type/Value.hs b/library/Octane/Type/Value.hs --- a/library/Octane/Type/Value.hs +++ b/library/Octane/Type/Value.hs @@ -1,248 +1,67 @@ -{-# LANGUAGE DataKinds #-} {-# LANGUAGE DeriveGeneric #-} -{-# LANGUAGE FlexibleContexts #-} -{-# LANGUAGE FlexibleInstances #-} -{-# LANGUAGE MultiParamTypeClasses #-} -{-# LANGUAGE OverloadedLabels #-} -{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE StrictData #-} -{-# LANGUAGE TemplateHaskell #-} -{-# LANGUAGE TypeFamilies #-} module Octane.Type.Value ( Value(..) - , BooleanValue(..) - , ByteValue(..) - , CamSettingsValue(..) - , DemolishValue(..) - , EnumValue(..) - , ExplosionValue(..) - , FlaggedIntValue(..) - , FloatValue(..) - , GameModeValue(..) - , IntValue(..) - , LoadoutValue(..) - , LoadoutOnlineValue(..) - , LocationValue(..) - , MusicStingerValue(..) - , PickupValue(..) - , PrivateMatchSettingsValue(..) - , QWordValue(..) - , RelativeRotationValue(..) - , ReservationValue(..) - , RigidBodyStateValue(..) - , StringValue(..) - , TeamPaintValue(..) - , UniqueIdValue(..) + , module Octane.Type.Value.BooleanValue + , module Octane.Type.Value.ByteValue + , module Octane.Type.Value.CamSettingsValue + , module Octane.Type.Value.DemolishValue + , module Octane.Type.Value.EnumValue + , module Octane.Type.Value.ExplosionValue + , module Octane.Type.Value.FlaggedIntValue + , module Octane.Type.Value.FloatValue + , module Octane.Type.Value.GameModeValue + , module Octane.Type.Value.IntValue + , module Octane.Type.Value.LoadoutOnlineValue + , module Octane.Type.Value.LoadoutsOnlineValue + , module Octane.Type.Value.LoadoutsValue + , module Octane.Type.Value.LoadoutValue + , module Octane.Type.Value.LocationValue + , module Octane.Type.Value.MusicStingerValue + , module Octane.Type.Value.PickupValue + , module Octane.Type.Value.PrivateMatchSettingsValue + , module Octane.Type.Value.QWordValue + , module Octane.Type.Value.RelativeRotationValue + , module Octane.Type.Value.ReservationValue + , module Octane.Type.Value.RigidBodyStateValue + , module Octane.Type.Value.StringValue + , module Octane.Type.Value.TeamPaintValue + , module Octane.Type.Value.UniqueIdValue + , module Octane.Type.Value.WeldedInfoValue ) where -import Data.Aeson ((.=)) +import Octane.Type.Value.BooleanValue +import Octane.Type.Value.ByteValue +import Octane.Type.Value.CamSettingsValue +import Octane.Type.Value.DemolishValue +import Octane.Type.Value.EnumValue +import Octane.Type.Value.ExplosionValue +import Octane.Type.Value.FlaggedIntValue +import Octane.Type.Value.FloatValue +import Octane.Type.Value.GameModeValue +import Octane.Type.Value.IntValue +import Octane.Type.Value.LoadoutOnlineValue +import Octane.Type.Value.LoadoutsOnlineValue +import Octane.Type.Value.LoadoutsValue +import Octane.Type.Value.LoadoutValue +import Octane.Type.Value.LocationValue +import Octane.Type.Value.MusicStingerValue +import Octane.Type.Value.PickupValue +import Octane.Type.Value.PrivateMatchSettingsValue +import Octane.Type.Value.QWordValue +import Octane.Type.Value.RelativeRotationValue +import Octane.Type.Value.ReservationValue +import Octane.Type.Value.RigidBodyStateValue +import Octane.Type.Value.StringValue +import Octane.Type.Value.TeamPaintValue +import Octane.Type.Value.UniqueIdValue +import Octane.Type.Value.WeldedInfoValue import qualified Control.DeepSeq as DeepSeq import qualified Data.Aeson as Aeson -import qualified Data.Bimap as Bimap -import qualified Data.Default.Class as Default -import qualified Data.OverloadedRecords.TH as OverloadedRecords -import qualified Data.Text as StrictText import qualified GHC.Generics as Generics -import qualified Octane.Data as Data -import qualified Octane.Type.Boolean as Boolean -import qualified Octane.Type.CompressedWord as CompressedWord -import qualified Octane.Type.Float32 as Float32 -import qualified Octane.Type.Int32 as Int32 -import qualified Octane.Type.RemoteId as RemoteId -import qualified Octane.Type.Text as Text -import qualified Octane.Type.Vector as Vector -import qualified Octane.Type.Word16 as Word16 -import qualified Octane.Type.Word32 as Word32 -import qualified Octane.Type.Word64 as Word64 -import qualified Octane.Type.Word8 as Word8 -newtype BooleanValue = BooleanValue - { booleanValueUnpack :: Boolean.Boolean - } deriving (Eq, Generics.Generic, Show) - -instance DeepSeq.NFData BooleanValue - -newtype ByteValue = ByteValue - { byteValueUnpack :: Word8.Word8 - } deriving (Eq, Generics.Generic, Show) - -instance DeepSeq.NFData ByteValue - -data CamSettingsValue = CamSettingsValue - { camSettingsValueFov :: Float32.Float32 - , camSettingsValueHeight :: Float32.Float32 - , camSettingsValueAngle :: Float32.Float32 - , camSettingsValueDistance :: Float32.Float32 - , camSettingsValueStiffness :: Float32.Float32 - , camSettingsValueSwivelSpeed :: Float32.Float32 - } deriving (Eq, Generics.Generic, Show) - -instance DeepSeq.NFData CamSettingsValue - -data DemolishValue = DemolishValue - { demolishValueAttackerFlag :: Boolean.Boolean - , demolishValueAttackerActorId :: Word32.Word32 - , demolishValueVictimFlag :: Boolean.Boolean - , demolishValueVictimActorId :: Word32.Word32 - , demolishValueAttackerVelocity :: Vector.Vector Int - , demolishValueVictimVelocity :: Vector.Vector Int - } deriving (Eq, Generics.Generic, Show) - -instance DeepSeq.NFData DemolishValue - -data EnumValue = EnumValue - { enumValueValue :: Word16.Word16 - , enumValueFlag :: Boolean.Boolean - } deriving (Eq, Generics.Generic, Show) - -instance DeepSeq.NFData EnumValue - -data ExplosionValue = ExplosionValue - { explosionValueActorless :: Boolean.Boolean - , explosionValueActorId :: Maybe Int32.Int32 - , explosionValuePosition :: Vector.Vector Int - } deriving (Eq, Generics.Generic, Show) - -instance DeepSeq.NFData ExplosionValue - -data FlaggedIntValue = FlaggedIntValue - { flaggedIntValueFlag :: Boolean.Boolean - , flaggedIntValueInt :: Int32.Int32 - } deriving (Eq, Generics.Generic, Show) - -instance DeepSeq.NFData FlaggedIntValue - -newtype FloatValue = FloatValue - { floatValueUnpack :: Float32.Float32 - } deriving (Eq, Generics.Generic, Show) - -instance DeepSeq.NFData FloatValue - -newtype GameModeValue = GameModeValue - { gameModeValueUnpack :: Word8.Word8 - } deriving (Eq, Generics.Generic, Show) - -instance DeepSeq.NFData GameModeValue - -newtype IntValue = IntValue - { intValueUnpack :: Int32.Int32 - } deriving (Eq, Generics.Generic, Show) - -instance DeepSeq.NFData IntValue - -data LoadoutValue = LoadoutValue - { loadoutValueVersion :: Word8.Word8 - , loadoutValueBody :: Word32.Word32 - , loadoutValueDecal :: Word32.Word32 - , loadoutValueWheels :: Word32.Word32 - , loadoutValueRocketTrail :: Word32.Word32 - , loadoutValueAntenna :: Word32.Word32 - , loadoutValueTopper :: Word32.Word32 - , loadoutValueUnknown1 :: Word32.Word32 - , loadoutValueUnknown2 :: Maybe Word32.Word32 - } deriving (Eq, Generics.Generic, Show) - -instance DeepSeq.NFData LoadoutValue - -newtype LoadoutOnlineValue = LoadoutOnlineValue - { loadoutOnlineValueUnpack :: [[(Word32.Word32, CompressedWord.CompressedWord)]] - } deriving (Eq, Generics.Generic, Show) - -instance DeepSeq.NFData LoadoutOnlineValue - -newtype LocationValue = LocationValue - { locationValueUnpack :: Vector.Vector Int - } deriving (Eq, Generics.Generic, Show) - -instance DeepSeq.NFData LocationValue - -data MusicStingerValue = MusicStingerValue - { musicStingerValueFlag :: Boolean.Boolean - , musicStingerValueCue :: Word32.Word32 - , musicStingerValueTrigger :: Word8.Word8 - } deriving (Eq, Generics.Generic, Show) - -instance DeepSeq.NFData MusicStingerValue - -data PickupValue = PickupValue - { pickupValueHasInstigator :: Boolean.Boolean - , pickupValueInstigatorId :: Maybe Word32.Word32 - , pickupValuePickedUp :: Boolean.Boolean - } deriving (Eq, Generics.Generic, Show) - -instance DeepSeq.NFData PickupValue - -data PrivateMatchSettingsValue = PrivateMatchSettingsValue - { privateMatchSettingsValueMutators :: Text.Text - , privateMatchSettingsValueJoinableBy :: Word32.Word32 - , privateMatchSettingsValueMaxPlayers :: Word32.Word32 - , privateMatchSettingsValueGameName :: Text.Text - , privateMatchSettingsValuePassword :: Text.Text - , privateMatchSettingsValueFlag :: Boolean.Boolean - } deriving (Eq, Generics.Generic, Show) - -instance DeepSeq.NFData PrivateMatchSettingsValue - -newtype QWordValue = QWordValue - { qWordValueUnpack :: Word64.Word64 - } deriving (Eq, Generics.Generic, Show) - -instance DeepSeq.NFData QWordValue - -newtype RelativeRotationValue = RelativeRotationValue - { relativeRotationValueUnpack :: Vector.Vector Float - } deriving (Eq, Generics.Generic, Show) - -instance DeepSeq.NFData RelativeRotationValue - -data ReservationValue = ReservationValue - { reservationValueNumber :: CompressedWord.CompressedWord - , reservationValueSystemId :: Word8.Word8 - , reservationValueRemoteId :: RemoteId.RemoteId - , reservationValueLocalId :: Maybe Word8.Word8 - , reservationValuePlayerName :: Maybe Text.Text - , reservationValueUnknown1 :: Boolean.Boolean - , reservationValueUnknown2 :: Boolean.Boolean - } deriving (Eq, Generics.Generic, Show) - -instance DeepSeq.NFData ReservationValue - -data RigidBodyStateValue = RigidBodyStateValue - { rigidBodyStateValueSleeping :: Boolean.Boolean - , rigidBodyStateValuePosition :: Vector.Vector Int - , rigidBodyStateValueRotation :: Vector.Vector Float - , rigidBodyStateValueLinearVelocity :: Maybe (Vector.Vector Int) - , rigidBodyStateValueAngularVelocity :: Maybe (Vector.Vector Int) - } deriving (Eq, Generics.Generic, Show) - -instance DeepSeq.NFData RigidBodyStateValue - -newtype StringValue = StringValue - { stringValueUnpack :: Text.Text - } deriving (Eq, Generics.Generic, Show) - -instance DeepSeq.NFData StringValue - -data TeamPaintValue = TeamPaintValue - { teamPaintValueTeam :: Word8.Word8 - , teamPaintValuePrimaryColor :: Word8.Word8 - , teamPaintValueAccentColor :: Word8.Word8 - , teamPaintValuePrimaryFinish :: Word32.Word32 - , teamPaintValueAccentFinish :: Word32.Word32 - } deriving (Eq, Generics.Generic, Show) - -instance DeepSeq.NFData TeamPaintValue - -data UniqueIdValue = UniqueIdValue - { uniqueIdValueSystemId :: Word8.Word8 - , uniqueIdValueRemoteId :: RemoteId.RemoteId - , uniqueIdValueLocalId :: Maybe Word8.Word8 - } deriving (Eq, Generics.Generic, Show) - -instance DeepSeq.NFData UniqueIdValue - -- | A replicated property's value. data Value = ValueBoolean BooleanValue @@ -257,6 +76,8 @@ | ValueInt IntValue | ValueLoadout LoadoutValue | ValueLoadoutOnline LoadoutOnlineValue + | ValueLoadouts LoadoutsValue + | ValueLoadoutsOnline LoadoutsOnlineValue | ValueLocation LocationValue | ValueMusicStinger MusicStingerValue | ValuePickup PickupValue @@ -268,189 +89,37 @@ | ValueString StringValue | ValueTeamPaint TeamPaintValue | ValueUniqueId UniqueIdValue + | ValueWeldedInfo WeldedInfoValue deriving (Eq, Generics.Generic, Show) -$(OverloadedRecords.overloadedRecords - Default.def - [ ''BooleanValue - , ''ByteValue - , ''CamSettingsValue - , ''DemolishValue - , ''EnumValue - , ''ExplosionValue - , ''FlaggedIntValue - , ''FloatValue - , ''GameModeValue - , ''IntValue - , ''LoadoutValue - , ''LoadoutOnlineValue - , ''LocationValue - , ''MusicStingerValue - , ''PickupValue - , ''PrivateMatchSettingsValue - , ''QWordValue - , ''RelativeRotationValue - , ''ReservationValue - , ''RigidBodyStateValue - , ''StringValue - , ''TeamPaintValue - , ''UniqueIdValue - ]) - instance DeepSeq.NFData Value instance Aeson.ToJSON Value where toJSON value = - Aeson.object ["Type" .= typeName value, "Value" .= jsonValue value] - -typeName :: Value -> StrictText.Text -typeName value = - case value of - ValueBoolean _ -> "Boolean" - ValueByte _ -> "Byte" - ValueCamSettings _ -> "CameraSettings" - ValueDemolish _ -> "Demolition" - ValueEnum _ -> "Enum" - ValueExplosion _ -> "Explosion" - ValueFlaggedInt _ -> "FlaggedInt" - ValueFloat _ -> "Float" - ValueGameMode _ -> "GameMode" - ValueInt _ -> "Int" - ValueLoadout _ -> "Loadout" - ValueLoadoutOnline _ -> "OnlineLoadout" - ValueLocation _ -> "Position" - ValueMusicStinger _ -> "MusicStinger" - ValuePickup _ -> "Pickup" - ValuePrivateMatchSettings _ -> "PrivateMatchSettings" - ValueQWord _ -> "QWord" - ValueRelativeRotation _ -> "RelativeRotation" - ValueReservation _ -> "Reservation" - ValueRigidBodyState _ -> "RigidBodyState" - ValueString _ -> "String" - ValueTeamPaint _ -> "Paint" - ValueUniqueId _ -> "UniqueId" - -jsonValue :: Value -> Aeson.Value -jsonValue value = - case value of - ValueBoolean x -> Aeson.toJSON (#unpack x) - ValueByte x -> Aeson.toJSON (#unpack x) - ValueCamSettings x -> - Aeson.object - [ "FOV" .= #fov x - , "Height" .= #height x - , "Angle" .= #angle x - , "Distance" .= #distance x - , "Stiffness" .= #stiffness x - , "SwivelSpeed" .= #swivelSpeed x - ] - ValueDemolish x -> - Aeson.object - [ "AttackerFlag" .= #attackerFlag x - , "AttackerActorId" .= #attackerActorId x - , "VictimFlag" .= #victimFlag x - , "VictimActorId" .= #victimActorId x - , "AttackerVelocity" .= #attackerVelocity x - , "VictimVelocity" .= #victimVelocity x - ] - ValueEnum x -> Aeson.object ["Value" .= #value x, "Flag" .= #flag x] - ValueExplosion x -> - Aeson.object - [ "Actorless" .= #actorless x - , "ActorId" .= #actorId x - , "Position" .= #position x - ] - ValueFlaggedInt x -> Aeson.object ["Flag" .= #flag x, "Int" .= #int x] - ValueFloat x -> Aeson.toJSON (#unpack x) - ValueGameMode x -> - Aeson.object ["Id" .= #unpack x, "Name" .= getGameMode (#unpack x)] - ValueInt x -> Aeson.toJSON (#unpack x) - ValueLoadout x -> - Aeson.object - [ "Version" .= #version x - , "Body" .= - Aeson.object ["Id" .= #body x, "Name" .= getProduct (#body x)] - , "Decal" .= - Aeson.object ["Id" .= #decal x, "Name" .= getProduct (#decal x)] - , "Wheels" .= - Aeson.object ["Id" .= #wheels x, "Name" .= getProduct (#wheels x)] - , "RocketTrail" .= - Aeson.object - ["Id" .= #rocketTrail x, "Name" .= getProduct (#rocketTrail x)] - , "Antenna" .= - Aeson.object ["Id" .= #antenna x, "Name" .= getProduct (#antenna x)] - , "Topper" .= - Aeson.object ["Id" .= #topper x, "Name" .= getProduct (#topper x)] - , "Unknown1" .= #unknown1 x - , "Unknown2" .= #unknown2 x - ] - ValueLoadoutOnline x -> Aeson.toJSON (#unpack x) - ValueLocation x -> Aeson.toJSON (#unpack x) - ValueMusicStinger x -> - Aeson.object ["Flag" .= #flag x, "Cue" .= #cue x, "Trigger" .= #trigger x] - ValuePickup x -> - Aeson.object - [ "HasInstigator" .= #hasInstigator x - , "InstigatorId" .= #instigatorId x - , "PickedUp" .= #pickedUp x - ] - ValuePrivateMatchSettings x -> - Aeson.object - [ "Mutators" .= #mutators x - , "JoinableBy" .= #joinableBy x - , "MaxPlayers" .= #maxPlayers x - , "Name" .= #gameName x - , "Password" .= #password x - , "Unknown" .= #flag x - ] - ValueQWord x -> Aeson.toJSON (#unpack x) - ValueRelativeRotation x -> Aeson.toJSON (#unpack x) - ValueReservation x -> - Aeson.object - [ "Number" .= #number x - , "SystemId" .= #systemId x - , "RemoteId" .= #remoteId x - , "LocalId" .= #localId x - , "Name" .= #playerName x - , "Unknown1" .= #unknown1 x - , "Unknown2" .= #unknown2 x - ] - ValueRigidBodyState x -> - Aeson.object - [ "Sleeping" .= #sleeping x - , "Position" .= #position x - , "Rotation" .= #rotation x - , "LinearVelocity" .= #linearVelocity x - , "AngularVelocity" .= #angularVelocity x - ] - ValueString x -> Aeson.toJSON (#unpack x) - ValueTeamPaint x -> - Aeson.object - [ "Team" .= #team x - , "PrimaryColor" .= #primaryColor x - , "AccentColor" .= #accentColor x - , "PrimaryFinish" .= - Aeson.object - ["Id" .= #primaryFinish x, "Name" .= getProduct (#primaryFinish x)] - , "AccentFinish" .= - Aeson.object - ["Id" .= #accentFinish x, "Name" .= getProduct (#accentFinish x)] - ] - ValueUniqueId x -> - Aeson.object - [ "System" .= - case #systemId x of - 0 -> "Local" - 1 -> "Steam" - 2 -> "PlayStation" - 4 -> "Xbox" - y -> "Unknown system " ++ show y - , "Remote" .= #remoteId x - , "Local" .= #localId x - ] - -getGameMode :: Word8.Word8 -> Maybe StrictText.Text -getGameMode x = Bimap.lookup (Word8.fromWord8 x) Data.gameModes - -getProduct :: Word32.Word32 -> Maybe StrictText.Text -getProduct x = Bimap.lookup (Word32.fromWord32 x) Data.products + case value of + ValueBoolean x -> Aeson.toJSON x + ValueByte x -> Aeson.toJSON x + ValueCamSettings x -> Aeson.toJSON x + ValueDemolish x -> Aeson.toJSON x + ValueEnum x -> Aeson.toJSON x + ValueExplosion x -> Aeson.toJSON x + ValueFlaggedInt x -> Aeson.toJSON x + ValueFloat x -> Aeson.toJSON x + ValueGameMode x -> Aeson.toJSON x + ValueInt x -> Aeson.toJSON x + ValueLoadout x -> Aeson.toJSON x + ValueLoadoutOnline x -> Aeson.toJSON x + ValueLoadouts x -> Aeson.toJSON x + ValueLoadoutsOnline x -> Aeson.toJSON x + ValueLocation x -> Aeson.toJSON x + ValueMusicStinger x -> Aeson.toJSON x + ValuePickup x -> Aeson.toJSON x + ValuePrivateMatchSettings x -> Aeson.toJSON x + ValueQWord x -> Aeson.toJSON x + ValueRelativeRotation x -> Aeson.toJSON x + ValueReservation x -> Aeson.toJSON x + ValueRigidBodyState x -> Aeson.toJSON x + ValueString x -> Aeson.toJSON x + ValueTeamPaint x -> Aeson.toJSON x + ValueUniqueId x -> Aeson.toJSON x + ValueWeldedInfo x -> Aeson.toJSON x diff --git a/library/Octane/Type/Value/BooleanValue.hs b/library/Octane/Type/Value/BooleanValue.hs new file mode 100644 --- /dev/null +++ b/library/Octane/Type/Value/BooleanValue.hs @@ -0,0 +1,36 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE OverloadedLabels #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE TypeFamilies #-} + +module Octane.Type.Value.BooleanValue + ( BooleanValue(..) + ) where + +import Data.Aeson ((.=)) + +import qualified Control.DeepSeq as DeepSeq +import qualified Data.Aeson as Aeson +import qualified Data.Default.Class as Default +import qualified Data.OverloadedRecords.TH as OverloadedRecords +import qualified Data.Text as StrictText +import qualified GHC.Generics as Generics +import qualified Octane.Type.Boolean as Boolean + +newtype BooleanValue = BooleanValue + { booleanValueUnpack :: Boolean.Boolean + } deriving (Eq, Generics.Generic, Show) + +$(OverloadedRecords.overloadedRecord Default.def ''BooleanValue) + +instance DeepSeq.NFData BooleanValue + +instance Aeson.ToJSON BooleanValue where + toJSON x = + Aeson.object + ["Type" .= ("Boolean" :: StrictText.Text), "Value" .= #unpack x] diff --git a/library/Octane/Type/Value/ByteValue.hs b/library/Octane/Type/Value/ByteValue.hs new file mode 100644 --- /dev/null +++ b/library/Octane/Type/Value/ByteValue.hs @@ -0,0 +1,35 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE OverloadedLabels #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE TypeFamilies #-} + +module Octane.Type.Value.ByteValue + ( ByteValue(..) + ) where + +import Data.Aeson ((.=)) + +import qualified Control.DeepSeq as DeepSeq +import qualified Data.Aeson as Aeson +import qualified Data.Default.Class as Default +import qualified Data.OverloadedRecords.TH as OverloadedRecords +import qualified Data.Text as StrictText +import qualified GHC.Generics as Generics +import qualified Octane.Type.Word8 as Word8 + +newtype ByteValue = ByteValue + { byteValueUnpack :: Word8.Word8 + } deriving (Eq, Generics.Generic, Show) + +$(OverloadedRecords.overloadedRecord Default.def ''ByteValue) + +instance DeepSeq.NFData ByteValue + +instance Aeson.ToJSON ByteValue where + toJSON x = + Aeson.object ["Type" .= ("Byte" :: StrictText.Text), "Value" .= #unpack x] diff --git a/library/Octane/Type/Value/CamSettingsValue.hs b/library/Octane/Type/Value/CamSettingsValue.hs new file mode 100644 --- /dev/null +++ b/library/Octane/Type/Value/CamSettingsValue.hs @@ -0,0 +1,52 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE OverloadedLabels #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE StrictData #-} +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE TypeFamilies #-} + +module Octane.Type.Value.CamSettingsValue + ( CamSettingsValue(..) + ) where + +import Data.Aeson ((.=)) + +import qualified Control.DeepSeq as DeepSeq +import qualified Data.Aeson as Aeson +import qualified Data.Default.Class as Default +import qualified Data.OverloadedRecords.TH as OverloadedRecords +import qualified Data.Text as StrictText +import qualified GHC.Generics as Generics +import qualified Octane.Type.Float32 as Float32 + +data CamSettingsValue = CamSettingsValue + { camSettingsValueFov :: Float32.Float32 + , camSettingsValueHeight :: Float32.Float32 + , camSettingsValueAngle :: Float32.Float32 + , camSettingsValueDistance :: Float32.Float32 + , camSettingsValueStiffness :: Float32.Float32 + , camSettingsValueSwivelSpeed :: Float32.Float32 + } deriving (Eq, Generics.Generic, Show) + +$(OverloadedRecords.overloadedRecord Default.def ''CamSettingsValue) + +instance DeepSeq.NFData CamSettingsValue + +instance Aeson.ToJSON CamSettingsValue where + toJSON x = + Aeson.object + [ "Type" .= ("CameraSettings" :: StrictText.Text) + , "Value" .= + Aeson.object + [ "FOV" .= #fov x + , "Height" .= #height x + , "Angle" .= #angle x + , "Distance" .= #distance x + , "Stiffness" .= #stiffness x + , "SwivelSpeed" .= #swivelSpeed x + ] + ] diff --git a/library/Octane/Type/Value/DemolishValue.hs b/library/Octane/Type/Value/DemolishValue.hs new file mode 100644 --- /dev/null +++ b/library/Octane/Type/Value/DemolishValue.hs @@ -0,0 +1,54 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE OverloadedLabels #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE StrictData #-} +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE TypeFamilies #-} + +module Octane.Type.Value.DemolishValue + ( DemolishValue(..) + ) where + +import Data.Aeson ((.=)) + +import qualified Control.DeepSeq as DeepSeq +import qualified Data.Aeson as Aeson +import qualified Data.Default.Class as Default +import qualified Data.OverloadedRecords.TH as OverloadedRecords +import qualified Data.Text as StrictText +import qualified GHC.Generics as Generics +import qualified Octane.Type.Boolean as Boolean +import qualified Octane.Type.Vector as Vector +import qualified Octane.Type.Word32 as Word32 + +data DemolishValue = DemolishValue + { demolishValueAttackerFlag :: Boolean.Boolean + , demolishValueAttackerActorId :: Word32.Word32 + , demolishValueVictimFlag :: Boolean.Boolean + , demolishValueVictimActorId :: Word32.Word32 + , demolishValueAttackerVelocity :: Vector.Vector Int + , demolishValueVictimVelocity :: Vector.Vector Int + } deriving (Eq, Generics.Generic, Show) + +$(OverloadedRecords.overloadedRecord Default.def ''DemolishValue) + +instance DeepSeq.NFData DemolishValue + +instance Aeson.ToJSON DemolishValue where + toJSON x = + Aeson.object + [ "Type" .= ("Demolition" :: StrictText.Text) + , "Value" .= + Aeson.object + [ "AttackerFlag" .= #attackerFlag x + , "AttackerActorId" .= #attackerActorId x + , "VictimFlag" .= #victimFlag x + , "VictimActorId" .= #victimActorId x + , "AttackerVelocity" .= #attackerVelocity x + , "VictimVelocity" .= #victimVelocity x + ] + ] diff --git a/library/Octane/Type/Value/EnumValue.hs b/library/Octane/Type/Value/EnumValue.hs new file mode 100644 --- /dev/null +++ b/library/Octane/Type/Value/EnumValue.hs @@ -0,0 +1,41 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE OverloadedLabels #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE StrictData #-} +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE TypeFamilies #-} + +module Octane.Type.Value.EnumValue + ( EnumValue(..) + ) where + +import Data.Aeson ((.=)) + +import qualified Control.DeepSeq as DeepSeq +import qualified Data.Aeson as Aeson +import qualified Data.Default.Class as Default +import qualified Data.OverloadedRecords.TH as OverloadedRecords +import qualified Data.Text as StrictText +import qualified GHC.Generics as Generics +import qualified Octane.Type.Boolean as Boolean +import qualified Octane.Type.Word16 as Word16 + +data EnumValue = EnumValue + { enumValueValue :: Word16.Word16 + , enumValueFlag :: Boolean.Boolean + } deriving (Eq, Generics.Generic, Show) + +$(OverloadedRecords.overloadedRecord Default.def ''EnumValue) + +instance DeepSeq.NFData EnumValue + +instance Aeson.ToJSON EnumValue where + toJSON x = + Aeson.object + [ "Type" .= ("Enum" :: StrictText.Text) + , "Value" .= Aeson.object ["Value" .= #value x, "Flag" .= #flag x] + ] diff --git a/library/Octane/Type/Value/ExplosionValue.hs b/library/Octane/Type/Value/ExplosionValue.hs new file mode 100644 --- /dev/null +++ b/library/Octane/Type/Value/ExplosionValue.hs @@ -0,0 +1,48 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE OverloadedLabels #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE StrictData #-} +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE TypeFamilies #-} + +module Octane.Type.Value.ExplosionValue + ( ExplosionValue(..) + ) where + +import Data.Aeson ((.=)) + +import qualified Control.DeepSeq as DeepSeq +import qualified Data.Aeson as Aeson +import qualified Data.Default.Class as Default +import qualified Data.OverloadedRecords.TH as OverloadedRecords +import qualified Data.Text as StrictText +import qualified GHC.Generics as Generics +import qualified Octane.Type.Boolean as Boolean +import qualified Octane.Type.Int32 as Int32 +import qualified Octane.Type.Vector as Vector + +data ExplosionValue = ExplosionValue + { explosionValueActorless :: Boolean.Boolean + , explosionValueActorId :: Maybe Int32.Int32 + , explosionValuePosition :: Vector.Vector Int + } deriving (Eq, Generics.Generic, Show) + +$(OverloadedRecords.overloadedRecord Default.def ''ExplosionValue) + +instance DeepSeq.NFData ExplosionValue + +instance Aeson.ToJSON ExplosionValue where + toJSON x = + Aeson.object + [ "Type" .= ("Explosion" :: StrictText.Text) + , "Value" .= + Aeson.object + [ "Actorless" .= #actorless x + , "ActorId" .= #actorId x + , "Position" .= #position x + ] + ] diff --git a/library/Octane/Type/Value/FlaggedIntValue.hs b/library/Octane/Type/Value/FlaggedIntValue.hs new file mode 100644 --- /dev/null +++ b/library/Octane/Type/Value/FlaggedIntValue.hs @@ -0,0 +1,41 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE OverloadedLabels #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE StrictData #-} +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE TypeFamilies #-} + +module Octane.Type.Value.FlaggedIntValue + ( FlaggedIntValue(..) + ) where + +import Data.Aeson ((.=)) + +import qualified Control.DeepSeq as DeepSeq +import qualified Data.Aeson as Aeson +import qualified Data.Default.Class as Default +import qualified Data.OverloadedRecords.TH as OverloadedRecords +import qualified Data.Text as StrictText +import qualified GHC.Generics as Generics +import qualified Octane.Type.Boolean as Boolean +import qualified Octane.Type.Int32 as Int32 + +data FlaggedIntValue = FlaggedIntValue + { flaggedIntValueFlag :: Boolean.Boolean + , flaggedIntValueInt :: Int32.Int32 + } deriving (Eq, Generics.Generic, Show) + +$(OverloadedRecords.overloadedRecord Default.def ''FlaggedIntValue) + +instance DeepSeq.NFData FlaggedIntValue + +instance Aeson.ToJSON FlaggedIntValue where + toJSON x = + Aeson.object + [ "Type" .= ("FlaggedInt" :: StrictText.Text) + , "Value" .= Aeson.object ["Flag" .= #flag x, "Int" .= #int x] + ] diff --git a/library/Octane/Type/Value/FloatValue.hs b/library/Octane/Type/Value/FloatValue.hs new file mode 100644 --- /dev/null +++ b/library/Octane/Type/Value/FloatValue.hs @@ -0,0 +1,35 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE OverloadedLabels #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE TypeFamilies #-} + +module Octane.Type.Value.FloatValue + ( FloatValue(..) + ) where + +import Data.Aeson ((.=)) + +import qualified Control.DeepSeq as DeepSeq +import qualified Data.Aeson as Aeson +import qualified Data.Default.Class as Default +import qualified Data.OverloadedRecords.TH as OverloadedRecords +import qualified Data.Text as StrictText +import qualified GHC.Generics as Generics +import qualified Octane.Type.Float32 as Float32 + +newtype FloatValue = FloatValue + { floatValueUnpack :: Float32.Float32 + } deriving (Eq, Generics.Generic, Show) + +$(OverloadedRecords.overloadedRecord Default.def ''FloatValue) + +instance DeepSeq.NFData FloatValue + +instance Aeson.ToJSON FloatValue where + toJSON x = + Aeson.object ["Type" .= ("Float" :: StrictText.Text), "Value" .= #unpack x] diff --git a/library/Octane/Type/Value/GameModeValue.hs b/library/Octane/Type/Value/GameModeValue.hs new file mode 100644 --- /dev/null +++ b/library/Octane/Type/Value/GameModeValue.hs @@ -0,0 +1,44 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE OverloadedLabels #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE TypeFamilies #-} + +module Octane.Type.Value.GameModeValue + ( GameModeValue(..) + ) where + +import Data.Aeson ((.=)) + +import qualified Control.DeepSeq as DeepSeq +import qualified Data.Aeson as Aeson +import qualified Data.Bimap as Bimap +import qualified Data.Default.Class as Default +import qualified Data.OverloadedRecords.TH as OverloadedRecords +import qualified Data.Text as StrictText +import qualified GHC.Generics as Generics +import qualified Octane.Data as Data +import qualified Octane.Type.Word8 as Word8 + +getGameMode :: Word8.Word8 -> Maybe StrictText.Text +getGameMode x = Bimap.lookup (Word8.fromWord8 x) Data.gameModes + +newtype GameModeValue = GameModeValue + { gameModeValueUnpack :: Word8.Word8 + } deriving (Eq, Generics.Generic, Show) + +$(OverloadedRecords.overloadedRecord Default.def ''GameModeValue) + +instance DeepSeq.NFData GameModeValue + +instance Aeson.ToJSON GameModeValue where + toJSON x = + Aeson.object + [ "Type" .= ("GameMode" :: StrictText.Text) + , "Value" .= + Aeson.object ["Id" .= #unpack x, "Name" .= getGameMode (#unpack x)] + ] diff --git a/library/Octane/Type/Value/IntValue.hs b/library/Octane/Type/Value/IntValue.hs new file mode 100644 --- /dev/null +++ b/library/Octane/Type/Value/IntValue.hs @@ -0,0 +1,35 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE OverloadedLabels #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE TypeFamilies #-} + +module Octane.Type.Value.IntValue + ( IntValue(..) + ) where + +import Data.Aeson ((.=)) + +import qualified Control.DeepSeq as DeepSeq +import qualified Data.Aeson as Aeson +import qualified Data.Default.Class as Default +import qualified Data.OverloadedRecords.TH as OverloadedRecords +import qualified Data.Text as StrictText +import qualified GHC.Generics as Generics +import qualified Octane.Type.Int32 as Int32 + +newtype IntValue = IntValue + { intValueUnpack :: Int32.Int32 + } deriving (Eq, Generics.Generic, Show) + +$(OverloadedRecords.overloadedRecord Default.def ''IntValue) + +instance DeepSeq.NFData IntValue + +instance Aeson.ToJSON IntValue where + toJSON x = + Aeson.object ["Type" .= ("Int" :: StrictText.Text), "Value" .= #unpack x] diff --git a/library/Octane/Type/Value/LoadoutOnlineValue.hs b/library/Octane/Type/Value/LoadoutOnlineValue.hs new file mode 100644 --- /dev/null +++ b/library/Octane/Type/Value/LoadoutOnlineValue.hs @@ -0,0 +1,37 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE OverloadedLabels #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE TypeFamilies #-} + +module Octane.Type.Value.LoadoutOnlineValue + ( LoadoutOnlineValue(..) + ) where + +import Data.Aeson ((.=)) + +import qualified Control.DeepSeq as DeepSeq +import qualified Data.Aeson as Aeson +import qualified Data.Default.Class as Default +import qualified Data.OverloadedRecords.TH as OverloadedRecords +import qualified Data.Text as StrictText +import qualified GHC.Generics as Generics +import qualified Octane.Type.CompressedWord as CompressedWord +import qualified Octane.Type.Word32 as Word32 + +newtype LoadoutOnlineValue = LoadoutOnlineValue + { loadoutOnlineValueUnpack :: [[(Word32.Word32, CompressedWord.CompressedWord)]] + } deriving (Eq, Generics.Generic, Show) + +$(OverloadedRecords.overloadedRecord Default.def ''LoadoutOnlineValue) + +instance DeepSeq.NFData LoadoutOnlineValue + +instance Aeson.ToJSON LoadoutOnlineValue where + toJSON x = + Aeson.object + ["Type" .= ("OnlineLoadout" :: StrictText.Text), "Value" .= #unpack x] diff --git a/library/Octane/Type/Value/LoadoutValue.hs b/library/Octane/Type/Value/LoadoutValue.hs new file mode 100644 --- /dev/null +++ b/library/Octane/Type/Value/LoadoutValue.hs @@ -0,0 +1,71 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE OverloadedLabels #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE StrictData #-} +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE TypeFamilies #-} + +module Octane.Type.Value.LoadoutValue + ( LoadoutValue(..) + ) where + +import Data.Aeson ((.=)) + +import qualified Control.DeepSeq as DeepSeq +import qualified Data.Aeson as Aeson +import qualified Data.Bimap as Bimap +import qualified Data.Default.Class as Default +import qualified Data.OverloadedRecords.TH as OverloadedRecords +import qualified Data.Text as StrictText +import qualified GHC.Generics as Generics +import qualified Octane.Data as Data +import qualified Octane.Type.Word32 as Word32 +import qualified Octane.Type.Word8 as Word8 + +getProduct :: Word32.Word32 -> Maybe StrictText.Text +getProduct x = Bimap.lookup (Word32.fromWord32 x) Data.products + +data LoadoutValue = LoadoutValue + { loadoutValueVersion :: Word8.Word8 + , loadoutValueBody :: Word32.Word32 + , loadoutValueDecal :: Word32.Word32 + , loadoutValueWheels :: Word32.Word32 + , loadoutValueRocketTrail :: Word32.Word32 + , loadoutValueAntenna :: Word32.Word32 + , loadoutValueTopper :: Word32.Word32 + , loadoutValueUnknown1 :: Word32.Word32 + , loadoutValueUnknown2 :: Maybe Word32.Word32 + } deriving (Eq, Generics.Generic, Show) + +$(OverloadedRecords.overloadedRecord Default.def ''LoadoutValue) + +instance DeepSeq.NFData LoadoutValue + +instance Aeson.ToJSON LoadoutValue where + toJSON x = + Aeson.object + [ "Type" .= ("Loadout" :: StrictText.Text) + , "Value" .= + Aeson.object + [ "Version" .= #version x + , "Body" .= + Aeson.object ["Id" .= #body x, "Name" .= getProduct (#body x)] + , "Decal" .= + Aeson.object ["Id" .= #decal x, "Name" .= getProduct (#decal x)] + , "Wheels" .= + Aeson.object ["Id" .= #wheels x, "Name" .= getProduct (#wheels x)] + , "RocketTrail" .= + Aeson.object + ["Id" .= #rocketTrail x, "Name" .= getProduct (#rocketTrail x)] + , "Antenna" .= + Aeson.object ["Id" .= #antenna x, "Name" .= getProduct (#antenna x)] + , "Topper" .= + Aeson.object ["Id" .= #topper x, "Name" .= getProduct (#topper x)] + , "Unknown1" .= #unknown1 x + , "Unknown2" .= #unknown2 x + ] + ] diff --git a/library/Octane/Type/Value/LoadoutsOnlineValue.hs b/library/Octane/Type/Value/LoadoutsOnlineValue.hs new file mode 100644 --- /dev/null +++ b/library/Octane/Type/Value/LoadoutsOnlineValue.hs @@ -0,0 +1,50 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE OverloadedLabels #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE StrictData #-} +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE TypeFamilies #-} + +module Octane.Type.Value.LoadoutsOnlineValue + ( LoadoutsOnlineValue(..) + ) where + +import Data.Aeson ((.=)) + +import qualified Control.DeepSeq as DeepSeq +import qualified Data.Aeson as Aeson +import qualified Data.Default.Class as Default +import qualified Data.OverloadedRecords.TH as OverloadedRecords +import qualified Data.Text as StrictText +import qualified GHC.Generics as Generics +import qualified Octane.Type.Boolean as Boolean +import qualified Octane.Type.Value.LoadoutOnlineValue + as LoadoutOnlineValue + +data LoadoutsOnlineValue = LoadoutsOnlineValue + { loadoutsOnlineValueLoadout1 :: LoadoutOnlineValue.LoadoutOnlineValue + , loadoutsOnlineValueLoadout2 :: LoadoutOnlineValue.LoadoutOnlineValue + , loadoutsOnlineValueUnknown1 :: Boolean.Boolean + , loadoutsOnlineValueUnknown2 :: Boolean.Boolean + } deriving (Eq, Generics.Generic, Show) + +$(OverloadedRecords.overloadedRecord Default.def ''LoadoutsOnlineValue) + +instance DeepSeq.NFData LoadoutsOnlineValue + +instance Aeson.ToJSON LoadoutsOnlineValue where + toJSON x = + Aeson.object + [ "Type" .= ("LoadoutsOnline" :: StrictText.Text) + , "Value" .= + Aeson.object + [ "Loadout1" .= #loadout1 x + , "Loadout2" .= #loadout2 x + , "Unknown1" .= #unknown1 x + , "Unknown2" .= #unknown2 x + ] + ] diff --git a/library/Octane/Type/Value/LoadoutsValue.hs b/library/Octane/Type/Value/LoadoutsValue.hs new file mode 100644 --- /dev/null +++ b/library/Octane/Type/Value/LoadoutsValue.hs @@ -0,0 +1,41 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE OverloadedLabels #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE StrictData #-} +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE TypeFamilies #-} + +module Octane.Type.Value.LoadoutsValue + ( LoadoutsValue(..) + ) where + +import Data.Aeson ((.=)) + +import qualified Control.DeepSeq as DeepSeq +import qualified Data.Aeson as Aeson +import qualified Data.Default.Class as Default +import qualified Data.OverloadedRecords.TH as OverloadedRecords +import qualified Data.Text as StrictText +import qualified GHC.Generics as Generics +import qualified Octane.Type.Value.LoadoutValue as LoadoutValue + +data LoadoutsValue = LoadoutsValue + { loadoutsValueLoadout1 :: LoadoutValue.LoadoutValue + , loadoutsValueLoadout2 :: LoadoutValue.LoadoutValue + } deriving (Eq, Generics.Generic, Show) + +$(OverloadedRecords.overloadedRecord Default.def ''LoadoutsValue) + +instance DeepSeq.NFData LoadoutsValue + +instance Aeson.ToJSON LoadoutsValue where + toJSON x = + Aeson.object + [ "Type" .= ("Loadouts" :: StrictText.Text) + , "Value" .= + Aeson.object ["Loadout1" .= #loadout1 x, "Loadout2" .= #loadout2 x] + ] diff --git a/library/Octane/Type/Value/LocationValue.hs b/library/Octane/Type/Value/LocationValue.hs new file mode 100644 --- /dev/null +++ b/library/Octane/Type/Value/LocationValue.hs @@ -0,0 +1,36 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE OverloadedLabels #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE TypeFamilies #-} + +module Octane.Type.Value.LocationValue + ( LocationValue(..) + ) where + +import Data.Aeson ((.=)) + +import qualified Control.DeepSeq as DeepSeq +import qualified Data.Aeson as Aeson +import qualified Data.Default.Class as Default +import qualified Data.OverloadedRecords.TH as OverloadedRecords +import qualified Data.Text as StrictText +import qualified GHC.Generics as Generics +import qualified Octane.Type.Vector as Vector + +newtype LocationValue = LocationValue + { locationValueUnpack :: Vector.Vector Int + } deriving (Eq, Generics.Generic, Show) + +$(OverloadedRecords.overloadedRecord Default.def ''LocationValue) + +instance DeepSeq.NFData LocationValue + +instance Aeson.ToJSON LocationValue where + toJSON x = + Aeson.object + ["Type" .= ("Position" :: StrictText.Text), "Value" .= #unpack x] diff --git a/library/Octane/Type/Value/MusicStingerValue.hs b/library/Octane/Type/Value/MusicStingerValue.hs new file mode 100644 --- /dev/null +++ b/library/Octane/Type/Value/MusicStingerValue.hs @@ -0,0 +1,45 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE OverloadedLabels #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE StrictData #-} +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE TypeFamilies #-} + +module Octane.Type.Value.MusicStingerValue + ( MusicStingerValue(..) + ) where + +import Data.Aeson ((.=)) + +import qualified Control.DeepSeq as DeepSeq +import qualified Data.Aeson as Aeson +import qualified Data.Default.Class as Default +import qualified Data.OverloadedRecords.TH as OverloadedRecords +import qualified Data.Text as StrictText +import qualified GHC.Generics as Generics +import qualified Octane.Type.Boolean as Boolean +import qualified Octane.Type.Word32 as Word32 +import qualified Octane.Type.Word8 as Word8 + +data MusicStingerValue = MusicStingerValue + { musicStingerValueFlag :: Boolean.Boolean + , musicStingerValueCue :: Word32.Word32 + , musicStingerValueTrigger :: Word8.Word8 + } deriving (Eq, Generics.Generic, Show) + +$(OverloadedRecords.overloadedRecord Default.def ''MusicStingerValue) + +instance DeepSeq.NFData MusicStingerValue + +instance Aeson.ToJSON MusicStingerValue where + toJSON x = + Aeson.object + [ "Type" .= ("MusicStinger" :: StrictText.Text) + , "Value" .= + Aeson.object + ["Flag" .= #flag x, "Cue" .= #cue x, "Trigger" .= #trigger x] + ] diff --git a/library/Octane/Type/Value/PickupValue.hs b/library/Octane/Type/Value/PickupValue.hs new file mode 100644 --- /dev/null +++ b/library/Octane/Type/Value/PickupValue.hs @@ -0,0 +1,47 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE OverloadedLabels #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE StrictData #-} +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE TypeFamilies #-} + +module Octane.Type.Value.PickupValue + ( PickupValue(..) + ) where + +import Data.Aeson ((.=)) + +import qualified Control.DeepSeq as DeepSeq +import qualified Data.Aeson as Aeson +import qualified Data.Default.Class as Default +import qualified Data.OverloadedRecords.TH as OverloadedRecords +import qualified Data.Text as StrictText +import qualified GHC.Generics as Generics +import qualified Octane.Type.Boolean as Boolean +import qualified Octane.Type.Word32 as Word32 + +data PickupValue = PickupValue + { pickupValueHasInstigator :: Boolean.Boolean + , pickupValueInstigatorId :: Maybe Word32.Word32 + , pickupValuePickedUp :: Boolean.Boolean + } deriving (Eq, Generics.Generic, Show) + +$(OverloadedRecords.overloadedRecord Default.def ''PickupValue) + +instance DeepSeq.NFData PickupValue + +instance Aeson.ToJSON PickupValue where + toJSON x = + Aeson.object + [ "Type" .= ("Pickup" :: StrictText.Text) + , "Value" .= + Aeson.object + [ "HasInstigator" .= #hasInstigator x + , "InstigatorId" .= #instigatorId x + , "PickedUp" .= #pickedUp x + ] + ] diff --git a/library/Octane/Type/Value/PrivateMatchSettingsValue.hs b/library/Octane/Type/Value/PrivateMatchSettingsValue.hs new file mode 100644 --- /dev/null +++ b/library/Octane/Type/Value/PrivateMatchSettingsValue.hs @@ -0,0 +1,54 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE OverloadedLabels #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE StrictData #-} +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE TypeFamilies #-} + +module Octane.Type.Value.PrivateMatchSettingsValue + ( PrivateMatchSettingsValue(..) + ) where + +import Data.Aeson ((.=)) + +import qualified Control.DeepSeq as DeepSeq +import qualified Data.Aeson as Aeson +import qualified Data.Default.Class as Default +import qualified Data.OverloadedRecords.TH as OverloadedRecords +import qualified Data.Text as StrictText +import qualified GHC.Generics as Generics +import qualified Octane.Type.Boolean as Boolean +import qualified Octane.Type.Text as Text +import qualified Octane.Type.Word32 as Word32 + +data PrivateMatchSettingsValue = PrivateMatchSettingsValue + { privateMatchSettingsValueMutators :: Text.Text + , privateMatchSettingsValueJoinableBy :: Word32.Word32 + , privateMatchSettingsValueMaxPlayers :: Word32.Word32 + , privateMatchSettingsValueGameName :: Text.Text + , privateMatchSettingsValuePassword :: Text.Text + , privateMatchSettingsValueFlag :: Boolean.Boolean + } deriving (Eq, Generics.Generic, Show) + +$(OverloadedRecords.overloadedRecord Default.def ''PrivateMatchSettingsValue) + +instance DeepSeq.NFData PrivateMatchSettingsValue + +instance Aeson.ToJSON PrivateMatchSettingsValue where + toJSON x = + Aeson.object + [ "Type" .= ("PrivateMatchSettings" :: StrictText.Text) + , "Value" .= + Aeson.object + [ "Mutators" .= #mutators x + , "JoinableBy" .= #joinableBy x + , "MaxPlayers" .= #maxPlayers x + , "Name" .= #gameName x + , "Password" .= #password x + , "Unknown" .= #flag x + ] + ] diff --git a/library/Octane/Type/Value/QWordValue.hs b/library/Octane/Type/Value/QWordValue.hs new file mode 100644 --- /dev/null +++ b/library/Octane/Type/Value/QWordValue.hs @@ -0,0 +1,35 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE OverloadedLabels #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE TypeFamilies #-} + +module Octane.Type.Value.QWordValue + ( QWordValue(..) + ) where + +import Data.Aeson ((.=)) + +import qualified Control.DeepSeq as DeepSeq +import qualified Data.Aeson as Aeson +import qualified Data.Default.Class as Default +import qualified Data.OverloadedRecords.TH as OverloadedRecords +import qualified Data.Text as StrictText +import qualified GHC.Generics as Generics +import qualified Octane.Type.Word64 as Word64 + +newtype QWordValue = QWordValue + { qWordValueUnpack :: Word64.Word64 + } deriving (Eq, Generics.Generic, Show) + +$(OverloadedRecords.overloadedRecord Default.def ''QWordValue) + +instance DeepSeq.NFData QWordValue + +instance Aeson.ToJSON QWordValue where + toJSON x = + Aeson.object ["Type" .= ("QWord" :: StrictText.Text), "Value" .= #unpack x] diff --git a/library/Octane/Type/Value/RelativeRotationValue.hs b/library/Octane/Type/Value/RelativeRotationValue.hs new file mode 100644 --- /dev/null +++ b/library/Octane/Type/Value/RelativeRotationValue.hs @@ -0,0 +1,36 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE OverloadedLabels #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE TypeFamilies #-} + +module Octane.Type.Value.RelativeRotationValue + ( RelativeRotationValue(..) + ) where + +import Data.Aeson ((.=)) + +import qualified Control.DeepSeq as DeepSeq +import qualified Data.Aeson as Aeson +import qualified Data.Default.Class as Default +import qualified Data.OverloadedRecords.TH as OverloadedRecords +import qualified Data.Text as StrictText +import qualified GHC.Generics as Generics +import qualified Octane.Type.Vector as Vector + +newtype RelativeRotationValue = RelativeRotationValue + { relativeRotationValueUnpack :: Vector.Vector Float + } deriving (Eq, Generics.Generic, Show) + +$(OverloadedRecords.overloadedRecord Default.def ''RelativeRotationValue) + +instance DeepSeq.NFData RelativeRotationValue + +instance Aeson.ToJSON RelativeRotationValue where + toJSON x = + Aeson.object + ["Type" .= ("RelativeRotation" :: StrictText.Text), "Value" .= #unpack x] diff --git a/library/Octane/Type/Value/ReservationValue.hs b/library/Octane/Type/Value/ReservationValue.hs new file mode 100644 --- /dev/null +++ b/library/Octane/Type/Value/ReservationValue.hs @@ -0,0 +1,58 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE OverloadedLabels #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE StrictData #-} +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE TypeFamilies #-} + +module Octane.Type.Value.ReservationValue + ( ReservationValue(..) + ) where + +import Data.Aeson ((.=)) + +import qualified Control.DeepSeq as DeepSeq +import qualified Data.Aeson as Aeson +import qualified Data.Default.Class as Default +import qualified Data.OverloadedRecords.TH as OverloadedRecords +import qualified Data.Text as StrictText +import qualified GHC.Generics as Generics +import qualified Octane.Type.Boolean as Boolean +import qualified Octane.Type.CompressedWord as CompressedWord +import qualified Octane.Type.RemoteId as RemoteId +import qualified Octane.Type.Text as Text +import qualified Octane.Type.Word8 as Word8 + +data ReservationValue = ReservationValue + { reservationValueNumber :: CompressedWord.CompressedWord + , reservationValueSystemId :: Word8.Word8 + , reservationValueRemoteId :: RemoteId.RemoteId + , reservationValueLocalId :: Maybe Word8.Word8 + , reservationValuePlayerName :: Maybe Text.Text + , reservationValueUnknown1 :: Boolean.Boolean + , reservationValueUnknown2 :: Boolean.Boolean + } deriving (Eq, Generics.Generic, Show) + +$(OverloadedRecords.overloadedRecord Default.def ''ReservationValue) + +instance DeepSeq.NFData ReservationValue + +instance Aeson.ToJSON ReservationValue where + toJSON x = + Aeson.object + [ "Type" .= ("Reservation" :: StrictText.Text) + , "Value" .= + Aeson.object + [ "Number" .= #number x + , "SystemId" .= #systemId x + , "RemoteId" .= #remoteId x + , "LocalId" .= #localId x + , "Name" .= #playerName x + , "Unknown1" .= #unknown1 x + , "Unknown2" .= #unknown2 x + ] + ] diff --git a/library/Octane/Type/Value/RigidBodyStateValue.hs b/library/Octane/Type/Value/RigidBodyStateValue.hs new file mode 100644 --- /dev/null +++ b/library/Octane/Type/Value/RigidBodyStateValue.hs @@ -0,0 +1,51 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE OverloadedLabels #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE StrictData #-} +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE TypeFamilies #-} + +module Octane.Type.Value.RigidBodyStateValue + ( RigidBodyStateValue(..) + ) where + +import Data.Aeson ((.=)) + +import qualified Control.DeepSeq as DeepSeq +import qualified Data.Aeson as Aeson +import qualified Data.Default.Class as Default +import qualified Data.OverloadedRecords.TH as OverloadedRecords +import qualified Data.Text as StrictText +import qualified GHC.Generics as Generics +import qualified Octane.Type.Boolean as Boolean +import qualified Octane.Type.Vector as Vector + +data RigidBodyStateValue = RigidBodyStateValue + { rigidBodyStateValueSleeping :: Boolean.Boolean + , rigidBodyStateValuePosition :: Vector.Vector Int + , rigidBodyStateValueRotation :: Vector.Vector Float + , rigidBodyStateValueLinearVelocity :: Maybe (Vector.Vector Int) + , rigidBodyStateValueAngularVelocity :: Maybe (Vector.Vector Int) + } deriving (Eq, Generics.Generic, Show) + +$(OverloadedRecords.overloadedRecord Default.def ''RigidBodyStateValue) + +instance DeepSeq.NFData RigidBodyStateValue + +instance Aeson.ToJSON RigidBodyStateValue where + toJSON x = + Aeson.object + [ "Type" .= ("RigidBodyState" :: StrictText.Text) + , "Value" .= + Aeson.object + [ "Sleeping" .= #sleeping x + , "Position" .= #position x + , "Rotation" .= #rotation x + , "LinearVelocity" .= #linearVelocity x + , "AngularVelocity" .= #angularVelocity x + ] + ] diff --git a/library/Octane/Type/Value/StringValue.hs b/library/Octane/Type/Value/StringValue.hs new file mode 100644 --- /dev/null +++ b/library/Octane/Type/Value/StringValue.hs @@ -0,0 +1,35 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE OverloadedLabels #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE TypeFamilies #-} + +module Octane.Type.Value.StringValue + ( StringValue(..) + ) where + +import Data.Aeson ((.=)) + +import qualified Control.DeepSeq as DeepSeq +import qualified Data.Aeson as Aeson +import qualified Data.Default.Class as Default +import qualified Data.OverloadedRecords.TH as OverloadedRecords +import qualified Data.Text as StrictText +import qualified GHC.Generics as Generics +import qualified Octane.Type.Text as Text + +newtype StringValue = StringValue + { stringValueUnpack :: Text.Text + } deriving (Eq, Generics.Generic, Show) + +$(OverloadedRecords.overloadedRecord Default.def ''StringValue) + +instance DeepSeq.NFData StringValue + +instance Aeson.ToJSON StringValue where + toJSON x = + Aeson.object ["Type" .= ("String" :: StrictText.Text), "Value" .= #unpack x] diff --git a/library/Octane/Type/Value/TeamPaintValue.hs b/library/Octane/Type/Value/TeamPaintValue.hs new file mode 100644 --- /dev/null +++ b/library/Octane/Type/Value/TeamPaintValue.hs @@ -0,0 +1,62 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE OverloadedLabels #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE StrictData #-} +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE TypeFamilies #-} + +module Octane.Type.Value.TeamPaintValue + ( TeamPaintValue(..) + ) where + +import Data.Aeson ((.=)) + +import qualified Control.DeepSeq as DeepSeq +import qualified Data.Aeson as Aeson +import qualified Data.Bimap as Bimap +import qualified Data.Default.Class as Default +import qualified Data.OverloadedRecords.TH as OverloadedRecords +import qualified Data.Text as StrictText +import qualified GHC.Generics as Generics +import qualified Octane.Data as Data +import qualified Octane.Type.Word32 as Word32 +import qualified Octane.Type.Word8 as Word8 + +getProduct :: Word32.Word32 -> Maybe StrictText.Text +getProduct x = Bimap.lookup (Word32.fromWord32 x) Data.products + +data TeamPaintValue = TeamPaintValue + { teamPaintValueTeam :: Word8.Word8 + , teamPaintValuePrimaryColor :: Word8.Word8 + , teamPaintValueAccentColor :: Word8.Word8 + , teamPaintValuePrimaryFinish :: Word32.Word32 + , teamPaintValueAccentFinish :: Word32.Word32 + } deriving (Eq, Generics.Generic, Show) + +$(OverloadedRecords.overloadedRecord Default.def ''TeamPaintValue) + +instance DeepSeq.NFData TeamPaintValue + +instance Aeson.ToJSON TeamPaintValue where + toJSON x = + Aeson.object + [ "Type" .= ("Paint" :: StrictText.Text) + , "Value" .= + Aeson.object + [ "Team" .= #team x + , "PrimaryColor" .= #primaryColor x + , "AccentColor" .= #accentColor x + , "PrimaryFinish" .= + Aeson.object + [ "Id" .= #primaryFinish x + , "Name" .= getProduct (#primaryFinish x) + ] + , "AccentFinish" .= + Aeson.object + ["Id" .= #accentFinish x, "Name" .= getProduct (#accentFinish x)] + ] + ] diff --git a/library/Octane/Type/Value/UniqueIdValue.hs b/library/Octane/Type/Value/UniqueIdValue.hs new file mode 100644 --- /dev/null +++ b/library/Octane/Type/Value/UniqueIdValue.hs @@ -0,0 +1,53 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE OverloadedLabels #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE StrictData #-} +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE TypeFamilies #-} + +module Octane.Type.Value.UniqueIdValue + ( UniqueIdValue(..) + ) where + +import Data.Aeson ((.=)) + +import qualified Control.DeepSeq as DeepSeq +import qualified Data.Aeson as Aeson +import qualified Data.Default.Class as Default +import qualified Data.OverloadedRecords.TH as OverloadedRecords +import qualified Data.Text as StrictText +import qualified GHC.Generics as Generics +import qualified Octane.Type.RemoteId as RemoteId +import qualified Octane.Type.Word8 as Word8 + +data UniqueIdValue = UniqueIdValue + { uniqueIdValueSystemId :: Word8.Word8 + , uniqueIdValueRemoteId :: RemoteId.RemoteId + , uniqueIdValueLocalId :: Maybe Word8.Word8 + } deriving (Eq, Generics.Generic, Show) + +$(OverloadedRecords.overloadedRecord Default.def ''UniqueIdValue) + +instance DeepSeq.NFData UniqueIdValue + +instance Aeson.ToJSON UniqueIdValue where + toJSON x = + Aeson.object + [ "Type" .= ("UniqueId" :: StrictText.Text) + , "Value" .= + Aeson.object + [ "System" .= + case #systemId x of + 0 -> "Local" + 1 -> "Steam" + 2 -> "PlayStation" + 4 -> "Xbox" + y -> "Unknown system " ++ show y + , "Remote" .= #remoteId x + , "Local" .= #localId x + ] + ] diff --git a/library/Octane/Type/Value/WeldedInfoValue.hs b/library/Octane/Type/Value/WeldedInfoValue.hs new file mode 100644 --- /dev/null +++ b/library/Octane/Type/Value/WeldedInfoValue.hs @@ -0,0 +1,54 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE OverloadedLabels #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE StrictData #-} +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE TypeFamilies #-} + +module Octane.Type.Value.WeldedInfoValue + ( WeldedInfoValue(..) + ) where + +import Data.Aeson ((.=)) + +import qualified Control.DeepSeq as DeepSeq +import qualified Data.Aeson as Aeson +import qualified Data.Default.Class as Default +import qualified Data.OverloadedRecords.TH as OverloadedRecords +import qualified Data.Text as StrictText +import qualified GHC.Generics as Generics +import qualified Octane.Type.Boolean as Boolean +import qualified Octane.Type.Float32 as Float32 +import qualified Octane.Type.Int32 as Int32 +import qualified Octane.Type.Int8 as Int8 +import qualified Octane.Type.Vector as Vector + +data WeldedInfoValue = WeldedInfoValue + { weldedInfoValueActive :: Boolean.Boolean + , weldedInfoValueActorId :: Int32.Int32 + , weldedInfoValueOffset :: Vector.Vector Int + , weldedInfoValueMass :: Float32.Float32 + , weldedInfoValueRotation :: Vector.Vector Int8.Int8 + } deriving (Eq, Generics.Generic, Show) + +$(OverloadedRecords.overloadedRecord Default.def ''WeldedInfoValue) + +instance DeepSeq.NFData WeldedInfoValue + +instance Aeson.ToJSON WeldedInfoValue where + toJSON x = + Aeson.object + [ "Type" .= ("WeldedInfo" :: StrictText.Text) + , "Value" .= + Aeson.object + [ "Active" .= #active x + , "ActorId" .= #actorId x + , "Offset" .= #offset x + , "Mass" .= #mass x + , "Rotation" .= #rotation x + ] + ] diff --git a/library/Octane/Type/Vector.hs b/library/Octane/Type/Vector.hs --- a/library/Octane/Type/Vector.hs +++ b/library/Octane/Type/Vector.hs @@ -14,17 +14,21 @@ , getFloatVector , getInt8Vector , getIntVector + , putFloatVector , putInt8Vector , putIntVector ) where +import Data.Function ((&)) + import qualified Control.DeepSeq as DeepSeq import qualified Data.Aeson as Aeson -import qualified Data.Bits as Bits import qualified Data.Binary.Bits as BinaryBit import qualified Data.Binary.Bits.Get as BinaryBit import qualified Data.Binary.Bits.Put as BinaryBit +import qualified Data.Bits as Bits import qualified Data.Default.Class as Default +import qualified Data.Foldable as Foldable import qualified Data.OverloadedRecords.TH as OverloadedRecords import qualified GHC.Generics as Generics import qualified Octane.Type.Boolean as Boolean @@ -73,14 +77,12 @@ let serIntMax = Bits.shiftL 1 numBits delta <- fmap CompressedWord.fromCompressedWord (BinaryBit.getBits serIntMax) let unscaledValue = (delta :: Int) - bias - if maxValue > maxBitValue - then do - let invScale = fromIntegral maxValue / fromIntegral maxBitValue - pure (fromIntegral unscaledValue * invScale) - else do - let scale = fromIntegral maxBitValue / fromIntegral maxValue - let invScale = 1.0 / scale - pure (fromIntegral unscaledValue * invScale) + let invScale = + if maxValue > maxBitValue + then fromIntegral maxValue / fromIntegral maxBitValue + else 1.0 / (fromIntegral maxBitValue / fromIntegral maxValue) + let value = fromIntegral unscaledValue * invScale + pure value -- | Gets a 'Vector' full of 'Int8's. getInt8Vector :: BinaryBit.BitGet (Vector Int8.Int8) @@ -114,12 +116,54 @@ dz <- fmap CompressedWord.fromCompressedWord (BinaryBit.getBits maxValue) pure (Vector (dx - bias) (dy - bias) (dz - bias)) +-- | Puts a 'Vector' full of 'Float's. +putFloatVector :: Vector Float -> BinaryBit.BitPut () +putFloatVector vector = do + let maxValue = 1 + let numBits = 16 + [#x, #y, #z] & map (\field -> field vector) & + mapM_ (\value -> putFloat maxValue numBits value) + +putFloat :: Int -> Int -> Float -> BinaryBit.BitPut () +putFloat maxValue numBits value = do + let serIntMax = Bits.shiftL 1 numBits + let bias = Bits.shiftL 1 (numBits - 1) + let maxBitValue = (Bits.shiftL 1 (numBits - 1)) - 1 + let invScale = + if maxValue > maxBitValue + then fromIntegral maxValue / fromIntegral maxBitValue + else 1.0 / (fromIntegral maxBitValue / fromIntegral maxValue) + if abs value > fromIntegral maxValue * (invScale + 1) + then fail ("value " ++ show value ++ " > max value " ++ show maxValue) + else do + let unscaledValue = value / invScale + let delta = ceiling (unscaledValue + fromIntegral (bias :: Int)) + BinaryBit.putBits 0 (CompressedWord.CompressedWord serIntMax delta) + -- | Puts a 'Vector' full of 'Int8's. putInt8Vector :: Vector Int8.Int8 -> BinaryBit.BitPut () -putInt8Vector _ = do - pure () -- TODO +putInt8Vector vector = do + Foldable.for_ + [#x, #y, #z] + (\field -> do + case field vector of + 0 -> BinaryBit.putBits 0 (Boolean.Boolean False) + value -> do + BinaryBit.putBits 0 (Boolean.Boolean True) + BinaryBit.putBits 0 value) -- | Puts a 'Vector' full of 'Int's. putIntVector :: Vector Int -> BinaryBit.BitPut () -putIntVector _ = do - pure () -- TODO +putIntVector vector = do + let maxNumBits = 19 + let numBits = 18 -- TODO + BinaryBit.putBits 0 (CompressedWord.CompressedWord maxNumBits numBits) + let bias = Bits.shiftL 1 (fromIntegral numBits + 1) + let maxBits = numBits + 2 + let maxValue = 2 ^ maxBits + let dx = vector & #x & (+ bias) & fromIntegral + let dy = vector & #y & (+ bias) & fromIntegral + let dz = vector & #z & (+ bias) & fromIntegral + BinaryBit.putBits 0 (CompressedWord.CompressedWord maxValue dx) + BinaryBit.putBits 0 (CompressedWord.CompressedWord maxValue dy) + BinaryBit.putBits 0 (CompressedWord.CompressedWord maxValue dz) diff --git a/library/Octane/Type/Word32.hs b/library/Octane/Type/Word32.hs --- a/library/Octane/Type/Word32.hs +++ b/library/Octane/Type/Word32.hs @@ -35,7 +35,7 @@ -- | A 32-bit unsigned integer. newtype Word32 = Word32 { word32Unpack :: Word.Word32 - } deriving (Eq, Generics.Generic, Num, Ord) + } deriving (Enum, Eq, Generics.Generic, Num, Ord) $(OverloadedRecords.overloadedRecord Default.def ''Word32) diff --git a/library/Octane/Utility/CRC.hs b/library/Octane/Utility/CRC.hs --- a/library/Octane/Utility/CRC.hs +++ b/library/Octane/Utility/CRC.hs @@ -16,7 +16,10 @@ let crc = LazyBytes.foldl update initial bytes Bits.complement crc -crc32Update :: Vector.Vector Word.Word32 -> Word.Word32 -> Word.Word8 -> Word.Word32 +crc32Update :: Vector.Vector Word.Word32 + -> Word.Word32 + -> Word.Word8 + -> Word.Word32 crc32Update table crc byte = do let toWord8 = fromIntegral :: (Integral a) => diff --git a/library/Octane/Utility/ClassPropertyMap.hs b/library/Octane/Utility/ClassPropertyMap.hs --- a/library/Octane/Utility/ClassPropertyMap.hs +++ b/library/Octane/Utility/ClassPropertyMap.hs @@ -32,23 +32,23 @@ in replay & getClassIds & map (\classId -> - let ownProperties = - case IntMap.lookup classId basicClassPropertyMap of - Nothing -> IntMap.empty - Just x -> x - parentProperties = - case IntMap.lookup classId classMap of - Nothing -> IntMap.empty - Just parentClassIds -> - parentClassIds & - map - (\parentClassId -> - case IntMap.lookup parentClassId basicClassPropertyMap of - Nothing -> IntMap.empty - Just x -> x) & - IntMap.unions - properties = IntMap.union ownProperties parentProperties - in (classId, properties)) & + let ownProperties = + case IntMap.lookup classId basicClassPropertyMap of + Nothing -> IntMap.empty + Just x -> x + parentProperties = + case IntMap.lookup classId classMap of + Nothing -> IntMap.empty + Just parentClassIds -> + parentClassIds & + map + (\parentClassId -> + case IntMap.lookup parentClassId basicClassPropertyMap of + Nothing -> IntMap.empty + Just x -> x) & + IntMap.unions + properties = IntMap.union ownProperties parentProperties + in (classId, properties)) & IntMap.fromList -- | The class cache is a list of 3-tuples where the first element is a class @@ -58,9 +58,9 @@ replay & #cache & #unpack & map (\x -> - ( x & #classId & Word32.fromWord32 - , x & #cacheId & Word32.fromWord32 - , x & #parentCacheId & Word32.fromWord32)) + ( x & #classId & Word32.fromWord32 + , x & #cacheId & Word32.fromWord32 + , x & #parentCacheId & Word32.fromWord32)) -- | The class IDs in a replay. Comes from the class cache. getClassIds :: Replay.ReplayWithoutFrames -> [Int] @@ -86,11 +86,11 @@ replay & getClassCache & reverse & List.tails & Maybe.mapMaybe (\xs -> - case xs of - [] -> Nothing - (classId, _, parentCacheId):ys -> do - parentClassId <- getParentClassId parentCacheId ys - pure (classId, parentClassId)) & + case xs of + [] -> Nothing + (classId, _, parentCacheId):ys -> do + parentClassId <- getParentClassId parentCacheId ys + pure (classId, parentClassId)) & IntMap.fromList -- | Given a naive mapping from class ID to its parent class ID, pure all of @@ -99,7 +99,8 @@ getParentClassIds classId basicClassMap = case IntMap.lookup classId basicClassMap of Nothing -> [] - Just parentClassId -> parentClassId : getParentClassIds parentClassId basicClassMap + Just parentClassId -> + parentClassId : getParentClassIds parentClassId basicClassMap -- | The class map is a mapping from a class ID to all of its parent class IDs. getClassMap :: Replay.ReplayWithoutFrames -> IntMap.IntMap [Int] @@ -124,18 +125,18 @@ in replay & #cache & #unpack & map (\x -> - let classId = x & #classId & Word32.fromWord32 - properties = - x & #properties & #unpack & - Maybe.mapMaybe - (\y -> - let streamId = y & #streamId & Word32.fromWord32 - propertyId = y & #objectId & Word32.fromWord32 - in case IntMap.lookup propertyId propertyMap of - Nothing -> Nothing - Just name -> Just (streamId, name)) & - IntMap.fromList - in (classId, properties)) & + let classId = x & #classId & Word32.fromWord32 + properties = + x & #properties & #unpack & + Maybe.mapMaybe + (\y -> + let streamId = y & #streamId & Word32.fromWord32 + propertyId = y & #objectId & Word32.fromWord32 + in case IntMap.lookup propertyId propertyMap of + Nothing -> Nothing + Just name -> Just (streamId, name)) & + IntMap.fromList + in (classId, properties)) & IntMap.fromList -- | The actor map is a mapping from class names to their IDs. @@ -144,9 +145,9 @@ replay & #classes & #unpack & map (\x -> - let className = x & #name & #unpack - classId = x & #streamId & Word32.fromWord32 - in (className, classId)) & + let className = x & #name & #unpack + classId = x & #streamId & Word32.fromWord32 + in (className, classId)) & Map.fromList -- | Gets the class ID and name for a given property ID. diff --git a/library/Octane/Utility/Embed.hs b/library/Octane/Utility/Embed.hs --- a/library/Octane/Utility/Embed.hs +++ b/library/Octane/Utility/Embed.hs @@ -23,7 +23,8 @@ :: (Aeson.FromJSON (Map.Map b a), Ord a, Ord b) => StrictBytes.ByteString -> Bimap.Bimap a b decodeBimap bytes = - bytes & Aeson.decodeStrict & Maybe.fromMaybe Map.empty & Map.toList & Bimap.fromList & + bytes & Aeson.decodeStrict & Maybe.fromMaybe Map.empty & Map.toList & + Bimap.fromList & Bimap.twist -- | Decodes some bytes into a map. The bytes are assumed to be a JSON object diff --git a/library/Octane/Utility/Generator.hs b/library/Octane/Utility/Generator.hs --- a/library/Octane/Utility/Generator.hs +++ b/library/Octane/Utility/Generator.hs @@ -1,4 +1,10 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE OverloadedLabels #-} +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE TypeFamilies #-} module Octane.Utility.Generator ( generateStream @@ -6,20 +12,43 @@ import Data.Function ((&)) +import qualified Control.Monad as Monad import qualified Data.Binary.Bits as BinaryBit import qualified Data.Binary.Bits.Put as BinaryBit import qualified Data.Binary.Put as Binary +import qualified Data.Default.Class as Default +import qualified Data.Map.Strict as Map +import qualified Data.OverloadedRecords.TH as OverloadedRecords +import qualified Data.Text as StrictText +import qualified Data.Tuple as Tuple import qualified Octane.Type.Boolean as Boolean import qualified Octane.Type.CacheItem as CacheItem import qualified Octane.Type.ClassItem as ClassItem +import qualified Octane.Type.CompressedWord as CompressedWord import qualified Octane.Type.Frame as Frame import qualified Octane.Type.Initialization as Initialization +import qualified Octane.Type.Int32 as Int32 import qualified Octane.Type.List as List +import qualified Octane.Type.RemoteId as RemoteId import qualified Octane.Type.Replication as Replication import qualified Octane.Type.State as State import qualified Octane.Type.Stream as Stream import qualified Octane.Type.Text as Text +import qualified Octane.Type.Value as Value +import qualified Octane.Type.Vector as Vector +import qualified Octane.Type.Word16 as Word16 +import qualified Octane.Type.Word32 as Word32 +import qualified Octane.Type.Word8 as Word8 +data Context = Context + { contextObjectMap :: Map.Map StrictText.Text Int32.Int32 + -- ^ { object name => object id } + , contextClassPropertyMap :: Map.Map StrictText.Text (Map.Map StrictText.Text CompressedWord.CompressedWord) + -- ^ { class name => { property name => property id } } + } + +$(OverloadedRecords.overloadedRecord Default.def ''Context) + -- | Generates a network stream. generateStream :: [Frame.Frame] @@ -28,60 +57,359 @@ -> List.List ClassItem.ClassItem -> List.List CacheItem.CacheItem -> Stream.Stream -generateStream frames _objects _names _classes _cache = do - let bitPut = putFrames frames +generateStream frames objects _names _classes cache = do + let context = makeContext objects cache + let bitPut = putFrames context frames let bytePut = BinaryBit.runBitPut bitPut let bytes = Binary.runPut bytePut Stream.Stream bytes -putFrames :: [Frame.Frame] -> BinaryBit.BitPut () -putFrames frames = do +makeContext :: List.List Text.Text -> List.List CacheItem.CacheItem -> Context +makeContext objects cache = do + let objectMap = + objects & #unpack & map #unpack & zip [0 ..] & map Tuple.swap & + Map.fromList + let classPropertyMap = + cache & #unpack & + map + (\cacheItem -> do + let className = + case objectMap & Map.assocs & map Tuple.swap & Map.fromList & + Map.lookup + (cacheItem & #classId & Word32.fromWord32 & + (\x -> x :: Int) & + Int32.toInt32) of + Nothing -> + error ("could not find class id for " ++ show className) + Just name -> name + let maxPropertyId = + cacheItem & #properties & #unpack & map #streamId & + map Word32.fromWord32 & + (0 :) & + maximum + let properties = + cacheItem & #properties & #unpack & + map + (\cacheProperty -> do + let propertyName = + case objectMap & Map.assocs & map Tuple.swap & + Map.fromList & + Map.lookup + (cacheProperty & #objectId & + Word32.fromWord32 & + (\x -> x :: Int) & + Int32.toInt32) of + Nothing -> + error + ("coult not find property name for " ++ + show cacheProperty) + Just name -> name + let propertyId = + cacheProperty & #streamId & Word32.fromWord32 & + CompressedWord.CompressedWord maxPropertyId + (propertyName, propertyId)) & + Map.fromList + (className, properties)) & + Map.fromList + Context objectMap classPropertyMap + +putFrames :: Context -> [Frame.Frame] -> BinaryBit.BitPut () +putFrames context frames = do case frames of [] -> pure () frame:rest -> do - putFrame frame - putFrames rest + putFrame context frame + putFrames context rest -putFrame :: Frame.Frame -> BinaryBit.BitPut () -putFrame frame = do +putFrame :: Context -> Frame.Frame -> BinaryBit.BitPut () +putFrame context frame = do frame & #time & BinaryBit.putBits 32 frame & #delta & BinaryBit.putBits 32 - frame & #replications & putReplications + frame & #replications & putReplications context -putReplications :: [Replication.Replication] -> BinaryBit.BitPut () -putReplications replications = do +putReplications :: Context -> [Replication.Replication] -> BinaryBit.BitPut () +putReplications context replications = do case replications of [] -> do False & Boolean.Boolean & BinaryBit.putBits 1 replication:rest -> do True & Boolean.Boolean & BinaryBit.putBits 1 - putReplication replication - putReplications rest + putReplication context replication + putReplications context rest -putReplication :: Replication.Replication -> BinaryBit.BitPut () -putReplication replication = do +putReplication :: Context -> Replication.Replication -> BinaryBit.BitPut () +putReplication context replication = do replication & #actorId & BinaryBit.putBits 0 case #state replication of - State.SOpening -> putNewReplication replication - State.SExisting -> putExistingReplication replication - State.SClosing -> putClosedReplication replication + State.Opening -> putNewReplication context replication + State.Existing -> putExistingReplication context replication + State.Closing -> putClosedReplication -putNewReplication :: Replication.Replication -> BinaryBit.BitPut () -putNewReplication replication = do +putNewReplication :: Context -> Replication.Replication -> BinaryBit.BitPut () +putNewReplication context replication = do True & Boolean.Boolean & BinaryBit.putBits 1 -- open True & Boolean.Boolean & BinaryBit.putBits 1 -- new False & Boolean.Boolean & BinaryBit.putBits 1 -- unknown - pure () -- TODO: convert object name into ID and put it + let objectName = #objectName replication + case Map.lookup objectName (#objectMap context) of + Nothing -> fail ("could not find object id for name " ++ show objectName) + Just objectId -> BinaryBit.putBits 0 objectId case #initialization replication of Nothing -> pure () Just x -> Initialization.putInitialization x -putExistingReplication :: Replication.Replication -> BinaryBit.BitPut () -putExistingReplication _replication = do +putExistingReplication :: Context + -> Replication.Replication + -> BinaryBit.BitPut () +putExistingReplication context replication = do True & Boolean.Boolean & BinaryBit.putBits 1 -- open False & Boolean.Boolean & BinaryBit.putBits 1 -- existing - pure () -- TODO: put props + let className = #className replication + let properties = replication & #properties & Map.toAscList + mapM_ (putProperty context className) properties -putClosedReplication :: Replication.Replication -> BinaryBit.BitPut () -putClosedReplication _replication = do +putClosedReplication :: BinaryBit.BitPut () +putClosedReplication = do False & Boolean.Boolean & BinaryBit.putBits 1 -- closed + +putProperty + :: Context + -> StrictText.Text + -> (StrictText.Text, Value.Value) + -> BinaryBit.BitPut () +putProperty context className (propertyName, value) = do + True & Boolean.Boolean & BinaryBit.putBits 1 -- has property + case Map.lookup className (#classPropertyMap context) of + Nothing -> fail ("could not find properties for class " ++ show className) + Just properties -> + case Map.lookup propertyName properties of + Nothing -> + fail + ("could not find property id for name " ++ + show propertyName ++ " in class " ++ show className) + Just propertyId -> BinaryBit.putBits 0 propertyId + putValue value + +putValue :: Value.Value -> BinaryBit.BitPut () +putValue value = + case value of + Value.ValueBoolean x -> putBooleanValue x + Value.ValueByte x -> putByteValue x + Value.ValueCamSettings x -> putCamSettingsValue x + Value.ValueDemolish x -> putDemolishValue x + Value.ValueEnum x -> putEnumValue x + Value.ValueExplosion x -> putExplosionValue x + Value.ValueFlaggedInt x -> putFlaggedIntValue x + Value.ValueFloat x -> putFloatValue x + Value.ValueGameMode x -> putGameModeValue x + Value.ValueInt x -> putIntValue x + Value.ValueLoadout x -> putLoadoutValue x + Value.ValueLoadoutOnline x -> putLoadoutOnlineValue x + Value.ValueLoadouts x -> putLoadoutsValue x + Value.ValueLoadoutsOnline x -> putLoadoutsOnlineValue x + Value.ValueLocation x -> putLocationValue x + Value.ValueMusicStinger x -> putMusicStingerValue x + Value.ValuePickup x -> putPickupValue x + Value.ValuePrivateMatchSettings x -> putPrivateMatchSettingsValue x + Value.ValueQWord x -> putQWordValue x + Value.ValueRelativeRotation x -> putRelativeRotationValue x + Value.ValueReservation x -> putReservationValue x + Value.ValueRigidBodyState x -> putRigidBodyStateValue x + Value.ValueString x -> putStringValue x + Value.ValueTeamPaint x -> putTeamPaintValue x + Value.ValueUniqueId x -> putUniqueIdValue x + Value.ValueWeldedInfo x -> putWeldedInfoValue x + +putBooleanValue :: Value.BooleanValue -> BinaryBit.BitPut () +putBooleanValue value = do + value & #unpack & BinaryBit.putBits 0 + +putByteValue :: Value.ByteValue -> BinaryBit.BitPut () +putByteValue value = do + value & #unpack & BinaryBit.putBits 0 + +putCamSettingsValue :: Value.CamSettingsValue -> BinaryBit.BitPut () +putCamSettingsValue value = do + value & #fov & BinaryBit.putBits 0 + value & #height & BinaryBit.putBits 0 + value & #angle & BinaryBit.putBits 0 + value & #distance & BinaryBit.putBits 0 + value & #stiffness & BinaryBit.putBits 0 + value & #swivelSpeed & BinaryBit.putBits 0 + +putDemolishValue :: Value.DemolishValue -> BinaryBit.BitPut () +putDemolishValue value = do + value & #attackerFlag & BinaryBit.putBits 0 + value & #attackerActorId & BinaryBit.putBits 0 + value & #victimFlag & BinaryBit.putBits 0 + value & #victimActorId & BinaryBit.putBits 0 + value & #attackerVelocity & Vector.putIntVector + value & #victimVelocity & Vector.putIntVector + +putEnumValue :: Value.EnumValue -> BinaryBit.BitPut () +putEnumValue value = do + value & #value & Word16.fromWord16 & BinaryBit.putWord16be 10 + value & #flag & BinaryBit.putBits 0 + +putExplosionValue :: Value.ExplosionValue -> BinaryBit.BitPut () +putExplosionValue value = do + value & #actorless & BinaryBit.putBits 0 + value & #actorId & maybePutBits 0 + value & #position & Vector.putIntVector + +putFlaggedIntValue :: Value.FlaggedIntValue -> BinaryBit.BitPut () +putFlaggedIntValue value = do + value & #flag & BinaryBit.putBits 0 + value & #int & BinaryBit.putBits 0 + +putFloatValue :: Value.FloatValue -> BinaryBit.BitPut () +putFloatValue value = do + value & #unpack & BinaryBit.putBits 0 + +putGameModeValue :: Value.GameModeValue -> BinaryBit.BitPut () +putGameModeValue value + -- The parser only reads 2 bits for older replays. This generator only makes + -- replays that work with the latest version, so it always writes 8 bits. + = do + value & #unpack & BinaryBit.putBits 0 + +putIntValue :: Value.IntValue -> BinaryBit.BitPut () +putIntValue value = do + value & #unpack & BinaryBit.putBits 0 + +putLoadoutValue :: Value.LoadoutValue -> BinaryBit.BitPut () +putLoadoutValue value = do + value & #version & BinaryBit.putBits 0 + value & #body & BinaryBit.putBits 0 + value & #decal & BinaryBit.putBits 0 + value & #wheels & BinaryBit.putBits 0 + value & #rocketTrail & BinaryBit.putBits 0 + value & #antenna & BinaryBit.putBits 0 + value & #topper & BinaryBit.putBits 0 + value & #unknown1 & BinaryBit.putBits 0 + value & #unknown2 & maybePutBits 0 + +putLoadoutsValue :: Value.LoadoutsValue -> BinaryBit.BitPut () +putLoadoutsValue value = do + value & #loadout1 & putLoadoutValue + value & #loadout2 & putLoadoutValue + +putLoadoutOnlineValue :: Value.LoadoutOnlineValue -> BinaryBit.BitPut () +putLoadoutOnlineValue value = do + value & #unpack & length & Word8.toWord8 & BinaryBit.putBits 0 + Monad.forM_ + (#unpack value) + (\tuples -> do + tuples & length & Word8.toWord8 & BinaryBit.putBits 0 + Monad.forM_ + tuples + (\(k, v) -> do + BinaryBit.putBits 0 k + BinaryBit.putBits 0 v)) + +putLoadoutsOnlineValue :: Value.LoadoutsOnlineValue -> BinaryBit.BitPut () +putLoadoutsOnlineValue value = do + value & #loadout1 & putLoadoutOnlineValue + value & #loadout2 & putLoadoutOnlineValue + value & #unknown1 & BinaryBit.putBits 0 + value & #unknown2 & BinaryBit.putBits 0 + +putLocationValue :: Value.LocationValue -> BinaryBit.BitPut () +putLocationValue value = do + value & #unpack & Vector.putIntVector + +putMusicStingerValue :: Value.MusicStingerValue -> BinaryBit.BitPut () +putMusicStingerValue value = do + value & #flag & BinaryBit.putBits 0 + value & #cue & BinaryBit.putBits 0 + value & #trigger & BinaryBit.putBits 0 + +putPickupValue :: Value.PickupValue -> BinaryBit.BitPut () +putPickupValue value = do + value & #hasInstigator & BinaryBit.putBits 0 + value & #instigatorId & maybePutBits 0 + value & #pickedUp & BinaryBit.putBits 0 + +putPrivateMatchSettingsValue :: Value.PrivateMatchSettingsValue + -> BinaryBit.BitPut () +putPrivateMatchSettingsValue value = do + value & #mutators & BinaryBit.putBits 0 + value & #joinableBy & BinaryBit.putBits 0 + value & #maxPlayers & BinaryBit.putBits 0 + value & #gameName & BinaryBit.putBits 0 + value & #password & BinaryBit.putBits 0 + value & #flag & BinaryBit.putBits 0 + +putQWordValue :: Value.QWordValue -> BinaryBit.BitPut () +putQWordValue value = do + value & #unpack & BinaryBit.putBits 0 + +putRelativeRotationValue :: Value.RelativeRotationValue -> BinaryBit.BitPut () +putRelativeRotationValue value = do + value & #unpack & Vector.putFloatVector + +putReservationValue :: Value.ReservationValue -> BinaryBit.BitPut () +putReservationValue value = do + value & #number & BinaryBit.putBits 0 + Value.UniqueIdValue (#systemId value) (#remoteId value) (#localId value) & + putUniqueIdValue + value & #playerName & maybePutBits 0 + value & #unknown1 & BinaryBit.putBits 0 + value & #unknown2 & BinaryBit.putBits 0 + -- The parser only reads 6 bits for newer replays. This generator only makes + -- replays that work with the latest version, so it always writes 6 bits. + BinaryBit.putWord8 6 0 + +putRigidBodyStateValue :: Value.RigidBodyStateValue -> BinaryBit.BitPut () +putRigidBodyStateValue value = do + value & #sleeping & BinaryBit.putBits 0 + value & #position & Vector.putIntVector + value & #rotation & Vector.putFloatVector + case #linearVelocity value of + Nothing -> pure () + Just linearVelocity -> Vector.putIntVector linearVelocity + case #angularVelocity value of + Nothing -> pure () + Just angularVelocity -> Vector.putIntVector angularVelocity + +putStringValue :: Value.StringValue -> BinaryBit.BitPut () +putStringValue value = do + value & #unpack & BinaryBit.putBits 0 + +putTeamPaintValue :: Value.TeamPaintValue -> BinaryBit.BitPut () +putTeamPaintValue value = do + value & #team & BinaryBit.putBits 0 + value & #primaryColor & BinaryBit.putBits 0 + value & #accentColor & BinaryBit.putBits 0 + value & #primaryFinish & BinaryBit.putBits 0 + value & #accentFinish & BinaryBit.putBits 0 + +putUniqueIdValue :: Value.UniqueIdValue -> BinaryBit.BitPut () +putUniqueIdValue value = do + value & #systemId & BinaryBit.putBits 0 + value & #remoteId & putRemoteId + value & #localId & maybePutBits 0 + +putWeldedInfoValue :: Value.WeldedInfoValue -> BinaryBit.BitPut () +putWeldedInfoValue value = do + value & #active & BinaryBit.putBits 0 + value & #actorId & BinaryBit.putBits 0 + value & #offset & Vector.putIntVector + value & #mass & BinaryBit.putBits 0 + value & #rotation & Vector.putInt8Vector + +maybePutBits + :: (BinaryBit.BinaryBit a) + => Int -> Maybe a -> BinaryBit.BitPut () +maybePutBits n mx = + case mx of + Nothing -> pure () + Just x -> BinaryBit.putBits n x + +putRemoteId :: RemoteId.RemoteId -> BinaryBit.BitPut () +putRemoteId remoteId = + case remoteId of + RemoteId.RemoteSplitscreenId x -> BinaryBit.putBits 0 x + RemoteId.RemoteSteamId x -> BinaryBit.putBits 0 x + RemoteId.RemotePlayStationId x -> BinaryBit.putBits 0 x + RemoteId.RemoteXboxId x -> BinaryBit.putBits 0 x diff --git a/library/Octane/Utility/Optimizer.hs b/library/Octane/Utility/Optimizer.hs --- a/library/Octane/Utility/Optimizer.hs +++ b/library/Octane/Utility/Optimizer.hs @@ -23,9 +23,9 @@ frames & Foldable.foldl' (\(state, fs) f -> - let newState = updateState f state - minimalFrame = getDelta state f - in (newState, minimalFrame : fs)) + let newState = updateState f state + minimalFrame = getDelta state f + in (newState, minimalFrame : fs)) (initialState, []) & snd & reverse @@ -40,7 +40,7 @@ updateState frame state1 = let spawned = frame & #replications & - filter (\replication -> replication & #state & (== State.SOpening)) & + filter (\replication -> replication & #state & State.isOpening) & map #actorId & map CompressedWord.fromCompressedWord state2 = @@ -48,14 +48,14 @@ foldr (IntMap.alter (\maybeValue -> - Just - (case maybeValue of - Nothing -> (True, Map.empty) - Just (_, properties) -> (True, properties)))) + Just + (case maybeValue of + Nothing -> (True, Map.empty) + Just (_, properties) -> (True, properties)))) state1 destroyed = frame & #replications & - filter (\replication -> replication & #state & (== State.SClosing)) & + filter (\replication -> replication & #state & State.isClosing) & map #actorId & map CompressedWord.fromCompressedWord state3 = @@ -63,26 +63,26 @@ foldr (IntMap.alter (\maybeValue -> - Just - (case maybeValue of - Nothing -> (False, Map.empty) - Just (_, properties) -> (False, properties)))) + Just + (case maybeValue of + Nothing -> (False, Map.empty) + Just (_, properties) -> (False, properties)))) state2 updated = frame & #replications & - filter (\replication -> replication & #state & (== State.SExisting)) + filter (\replication -> replication & #state & State.isExisting) state4 = updated & foldr (\replication -> - IntMap.alter - (\maybeValue -> - Just - (case maybeValue of - Nothing -> (True, #properties replication) - Just (alive, properties) -> - (alive, Map.union (#properties replication) properties))) - (replication & #actorId & CompressedWord.fromCompressedWord)) + IntMap.alter + (\maybeValue -> + Just + (case maybeValue of + Nothing -> (True, #properties replication) + Just (alive, properties) -> + (alive, Map.union (#properties replication) properties))) + (replication & #actorId & CompressedWord.fromCompressedWord)) state3 in state4 @@ -92,37 +92,35 @@ frame & #replications & reject (\replication -> - let isOpening = #state replication == State.SOpening - actorId = #actorId replication - currentState = - IntMap.lookup (CompressedWord.fromCompressedWord actorId) state - isAlive = fmap fst currentState - wasAlreadyAlive = isAlive == Just True - in isOpening && wasAlreadyAlive) & + let isOpening = replication & #state & State.isOpening + actorId = #actorId replication + currentState = + IntMap.lookup + (CompressedWord.fromCompressedWord actorId) + state + isAlive = fmap fst currentState + wasAlreadyAlive = isAlive == Just True + in isOpening && wasAlreadyAlive) & map (\replication -> - if #state replication == State.SExisting - then let actorId = #actorId replication - currentState = - IntMap.findWithDefault - (True, Map.empty) - (CompressedWord.fromCompressedWord actorId) - state - currentProperties = snd currentState - newProperties = #properties replication - changes = - newProperties & - Map.filterWithKey - (\name newValue -> - let oldValue = Map.lookup name currentProperties - in Just newValue /= oldValue) - in replication - { Replication.replicationProperties = changes - } - else replication) - in frame - { Frame.frameReplications = newReplications - } + if replication & #state & State.isExisting + then let actorId = #actorId replication + currentState = + IntMap.findWithDefault + (True, Map.empty) + (CompressedWord.fromCompressedWord actorId) + state + currentProperties = snd currentState + newProperties = #properties replication + changes = + newProperties & + Map.filterWithKey + (\name newValue -> + let oldValue = Map.lookup name currentProperties + in Just newValue /= oldValue) + in replication {Replication.replicationProperties = changes} + else replication) + in frame {Frame.frameReplications = newReplications} reject :: (a -> Bool) -> [a] -> [a] reject p xs = filter (\x -> not (p x)) xs diff --git a/library/Octane/Utility/Parser.hs b/library/Octane/Utility/Parser.hs --- a/library/Octane/Utility/Parser.hs +++ b/library/Octane/Utility/Parser.hs @@ -5,6 +5,7 @@ {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE OverloadedLabels #-} +{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE StrictData #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TypeFamilies #-} @@ -27,6 +28,7 @@ import qualified Data.Set as Set import qualified Data.Text as StrictText import qualified Data.Version as Version +import qualified Debug.Trace as Trace import qualified GHC.Generics as Generics import qualified Octane.Data as Data import qualified Octane.Type.Boolean as Boolean @@ -48,8 +50,19 @@ import qualified Octane.Type.Word64 as Word64 import qualified Octane.Type.Word8 as Word8 import qualified Octane.Utility.ClassPropertyMap as CPM +import qualified System.Environment as Environment +import qualified System.IO.Unsafe as Unsafe import qualified Text.Printf as Printf +debug :: Bool +debug = + Unsafe.unsafePerformIO (Environment.lookupEnv "OCTANE_DEBUG") == Just "1" + +trace + :: (Applicative m) + => String -> m () +trace message = Monad.when debug (Trace.traceM message) + -- Data types -- { class stream id => { property stream id => name } } type ClassPropertyMap = IntMap.IntMap (IntMap.IntMap StrictText.Text) @@ -104,21 +117,25 @@ -- | Parses the network stream and returns a list of frames. parseStream :: Replay.ReplayWithoutFrames -> [Frame.Frame] -parseStream replay = +parseStream replay = do + let get = replay & getStream & BinaryBit.runBitGet + let stream = replay & #stream & #unpack + Binary.runGet get stream + +getStream :: Replay.ReplayWithoutFrames -> BinaryBit.BitGet [Frame.Frame] +getStream replay = do let numFrames = - replay & #properties & #unpack & - Map.lookup ("NumFrames" & StrictText.pack & Text.Text) & + replay & #properties & #unpack & Map.lookup "NumFrames" & (\property -> - case property of - Just (Property.PropertyInt int) -> int & #content & Int32.fromInt32 - _ -> 0) - get = replay & extractContext & getFrames 0 numFrames & BinaryBit.runBitGet - stream = replay & #stream & #unpack - (_context, frames) = Binary.runGet get stream - in frames + case property of + Just (Property.PropertyInt int) -> int & #content & Int32.fromInt32 + _ -> 0) + trace (Printf.printf "Getting %d frame(s)" numFrames) + replay & extractContext & getFrames 0 numFrames & fmap snd getFrames :: Word -> Int -> Context -> BinaryBit.BitGet (Context, [Frame.Frame]) getFrames number numFrames context = do + trace (Printf.printf "Getting frame %d of %d" number numFrames) if fromIntegral number >= numFrames then pure (context, []) else do @@ -130,7 +147,8 @@ case maybeFrame of Nothing -> pure (context, []) Just (newContext, frame) -> do - (newerContext, frames) <- getFrames (number + 1) numFrames newContext + (newerContext, frames) <- + getFrames (number + 1) numFrames newContext pure (newerContext, (frame : frames)) getMaybeFrame :: Context @@ -139,6 +157,12 @@ getMaybeFrame context number = do time <- getFloat32 delta <- getFloat32 + trace + (Printf.printf + "Getting frame %d at time %.2f with delta %.2f" + number + (#unpack time) + (#unpack delta)) if time == 0 && delta == 0 then pure Nothing else if time < 0.001 || delta < 0.001 @@ -156,6 +180,7 @@ -> Float32.Float32 -> BinaryBit.BitGet (Context, Frame.Frame) getFrame context number time delta = do + trace (Printf.printf "Getting replications for frame %d" number) (newContext, replications) <- getReplications context let frame = Frame.Frame @@ -189,6 +214,7 @@ getReplication :: Context -> BinaryBit.BitGet (Context, Replication.Replication) getReplication context = do actorId <- BinaryBit.getBits maxActorId + trace (Printf.printf "Getting replication for actor %d" (#value actorId)) isOpen <- getBool let go = if #unpack isOpen @@ -229,22 +255,26 @@ Data.classes (#classMap context) (Int32.fromInt32 objectId) + trace + (Printf.printf + "Got new replication for object %d %s class %d %s" + (#unpack objectId) + (show objectName) + classId + (show className)) classInit <- Initialization.getInitialization className let thing = Thing unknownFlag objectId objectName classId className classInit let things = #things context let newThings = IntMap.insert (CompressedWord.fromCompressedWord actorId) thing things - let newContext = - context - { contextThings = newThings - } + let newContext = context {contextThings = newThings} pure ( newContext , Replication.Replication actorId objectName className - State.SOpening + State.Opening (Just classInit) Map.empty) @@ -259,6 +289,13 @@ Nothing -> fail ("could not find thing for existing actor " ++ show actorId) Just x -> pure x + trace + (Printf.printf + "Getting existing replication properties for object %d %s class %d %s" + (thing & #objectId & #unpack) + (thing & #objectName & show) + (thing & #classId) + (thing & #className & show)) props <- getProps context thing pure ( context @@ -266,7 +303,7 @@ actorId (#objectName thing) (#className thing) - State.SExisting + State.Existing Nothing props) @@ -280,20 +317,24 @@ IntMap.lookup (CompressedWord.fromCompressedWord actorId) of Nothing -> fail ("could not find thing for closed actor " ++ show actorId) Just x -> pure x + trace + (Printf.printf + "Got closed replication for object %d %s class %d %s" + (thing & #objectId & #unpack) + (thing & #objectName & show) + (thing & #classId) + (thing & #className & show)) let newThings = context & #things & IntMap.delete (CompressedWord.fromCompressedWord actorId) - let newContext = - context - { contextThings = newThings - } + let newContext = context {contextThings = newThings} pure ( newContext , Replication.Replication actorId (#objectName thing) (#className thing) - State.SClosing + State.Closing Nothing Map.empty) @@ -335,7 +376,9 @@ Nothing -> fail ("could not find property name for property id " ++ show pid) Just x -> pure x + trace (Printf.printf "Getting property %s" (show name)) value <- getPropValue context name + trace (Printf.printf "Got property %s" (show value)) pure (name, value) getPropValue :: Context -> StrictText.Text -> BinaryBit.BitGet Value.Value @@ -355,6 +398,8 @@ "int" -> getIntProperty "loadout_online" -> getLoadoutOnlineProperty "loadout" -> getLoadoutProperty + "loadouts_online" -> getLoadoutsOnlineProperty + "loadouts" -> getLoadoutsProperty "location" -> getLocationProperty "music_stinger" -> getMusicStingerProperty "party_leader" -> getPartyLeaderProperty @@ -367,6 +412,7 @@ "string" -> getStringProperty "team_paint" -> getTeamPaintProperty "unique_id" -> getUniqueIdProperty + "welded_info" -> getWeldedInfoProperty _ -> fail ("Don't know how to read property type " ++ @@ -472,6 +518,16 @@ pure (x, y))) pure (Value.ValueLoadoutOnline (Value.LoadoutOnlineValue values)) +getLoadoutsOnlineProperty :: BinaryBit.BitGet Value.Value +getLoadoutsOnlineProperty = do + Value.ValueLoadoutOnline loadout1 <- getLoadoutOnlineProperty + Value.ValueLoadoutOnline loadout2 <- getLoadoutOnlineProperty + unknown1 <- BinaryBit.getBits 0 + unknown2 <- BinaryBit.getBits 0 + pure + (Value.ValueLoadoutsOnline + (Value.LoadoutsOnlineValue loadout1 loadout2 unknown1 unknown2)) + getLoadoutProperty :: BinaryBit.BitGet Value.Value getLoadoutProperty = do version <- getWord8 @@ -499,6 +555,12 @@ g h)) +getLoadoutsProperty :: BinaryBit.BitGet Value.Value +getLoadoutsProperty = do + Value.ValueLoadout loadout1 <- getLoadoutProperty + Value.ValueLoadout loadout2 <- getLoadoutProperty + pure (Value.ValueLoadouts (Value.LoadoutsValue loadout1 loadout2)) + getLocationProperty :: BinaryBit.BitGet Value.Value getLocationProperty = do vector <- Vector.getIntVector @@ -610,7 +672,12 @@ accentFinish <- getWord32 pure (Value.ValueTeamPaint - (Value.TeamPaintValue team primaryColor accentColor primaryFinish accentFinish)) + (Value.TeamPaintValue + team + primaryColor + accentColor + primaryFinish + accentFinish)) getUniqueIdProperty :: BinaryBit.BitGet Value.Value getUniqueIdProperty = do @@ -625,12 +692,24 @@ (remoteId, localId) <- if systemId == 0 then pure - (RemoteId.RemoteSplitscreenId (RemoteId.SplitscreenId Nothing), Nothing) + ( RemoteId.RemoteSplitscreenId (RemoteId.SplitscreenId Nothing) + , Nothing) else do remoteId <- getRemoteId systemId localId <- fmap Just getWord8 pure (remoteId, localId) pure (Value.ValueUniqueId (Value.UniqueIdValue systemId remoteId localId)) + +getWeldedInfoProperty :: BinaryBit.BitGet Value.Value +getWeldedInfoProperty = do + active <- getBool + actorId <- getInt32 + offset <- Vector.getIntVector + mass <- getFloat32 + rotation <- Vector.getInt8Vector + pure + (Value.ValueWeldedInfo + (Value.WeldedInfoValue active actorId offset mass rotation)) getUniqueId :: BinaryBit.BitGet (Word8.Word8, RemoteId.RemoteId, Maybe Word8.Word8) getUniqueId = do diff --git a/octane.cabal b/octane.cabal --- a/octane.cabal +++ b/octane.cabal @@ -3,7 +3,7 @@ -- see: https://github.com/sol/hpack name: octane -version: 0.15.0 +version: 0.16.0 synopsis: Parse Rocket League replays. description: Octane parses Rocket League replays. category: Game @@ -73,8 +73,20 @@ Octane.Type.Message Octane.Type.OptimizedReplay Octane.Type.Property + Octane.Type.Property.ArrayProperty + Octane.Type.Property.BoolProperty + Octane.Type.Property.ByteProperty + Octane.Type.Property.FloatProperty + Octane.Type.Property.IntProperty + Octane.Type.Property.NameProperty + Octane.Type.Property.QWordProperty + Octane.Type.Property.StrProperty Octane.Type.RawReplay Octane.Type.RemoteId + Octane.Type.RemoteId.PlayStationId + Octane.Type.RemoteId.SplitscreenId + Octane.Type.RemoteId.SteamId + Octane.Type.RemoteId.XboxId Octane.Type.Replay Octane.Type.ReplayWithFrames Octane.Type.ReplayWithoutFrames @@ -83,6 +95,32 @@ Octane.Type.Stream Octane.Type.Text Octane.Type.Value + Octane.Type.Value.BooleanValue + Octane.Type.Value.ByteValue + Octane.Type.Value.CamSettingsValue + Octane.Type.Value.DemolishValue + Octane.Type.Value.EnumValue + Octane.Type.Value.ExplosionValue + Octane.Type.Value.FlaggedIntValue + Octane.Type.Value.FloatValue + Octane.Type.Value.GameModeValue + Octane.Type.Value.IntValue + Octane.Type.Value.LoadoutOnlineValue + Octane.Type.Value.LoadoutsOnlineValue + Octane.Type.Value.LoadoutsValue + Octane.Type.Value.LoadoutValue + Octane.Type.Value.LocationValue + Octane.Type.Value.MusicStingerValue + Octane.Type.Value.PickupValue + Octane.Type.Value.PrivateMatchSettingsValue + Octane.Type.Value.QWordValue + Octane.Type.Value.RelativeRotationValue + Octane.Type.Value.ReservationValue + Octane.Type.Value.RigidBodyStateValue + Octane.Type.Value.StringValue + Octane.Type.Value.TeamPaintValue + Octane.Type.Value.UniqueIdValue + Octane.Type.Value.WeldedInfoValue Octane.Type.Vector Octane.Type.Word16 Octane.Type.Word32 @@ -124,9 +162,15 @@ ghc-options: -Wall -rtsopts -threaded -with-rtsopts=-N build-depends: base + , binary + , binary-bits + , bytestring + , containers , octane , tasty ==0.11.* , tasty-hspec ==1.1.* + , tasty-quickcheck ==0.8.* + , text other-modules: OctaneSpec default-language: Haskell2010 diff --git a/package.yaml b/package.yaml --- a/package.yaml +++ b/package.yaml @@ -65,13 +65,19 @@ octane-test-suite: dependencies: - base + - binary + - binary-bits + - bytestring + - containers - octane - tasty ==0.11.* - tasty-hspec ==1.1.* + - tasty-quickcheck ==0.8.* + - text ghc-options: - -rtsopts - -threaded - -with-rtsopts=-N main: Main.hs source-dirs: test-suite -version: '0.15.0' +version: '0.16.0' diff --git a/stack.yaml b/stack.yaml --- a/stack.yaml +++ b/stack.yaml @@ -1,1 +1,7 @@ +packages: +- . +- extra-dep: true + location: + commit: 6c87162af7366105e045f35bf34624db5292dbdb + git: https://github.com/bitemyapp/hspec-expectations.git resolver: nightly-2016-08-18 diff --git a/test-suite/OctaneSpec.hs b/test-suite/OctaneSpec.hs --- a/test-suite/OctaneSpec.hs +++ b/test-suite/OctaneSpec.hs @@ -1,8 +1,601 @@ +{-# LANGUAGE OverloadedLabels #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# OPTIONS_GHC -fno-warn-orphans #-} + module OctaneSpec ( spec ) where +import qualified Data.Binary as Binary +import qualified Data.Binary.Bits as BinaryBit +import qualified Data.Binary.Bits.Get as BinaryBit +import qualified Data.Binary.Bits.Put as BinaryBit +import qualified Data.Binary.Get as Binary +import qualified Data.Binary.Put as Binary +import qualified Data.ByteString.Lazy as LazyBytes +import qualified Data.Foldable as Foldable +import Data.Function ((&)) +import qualified Data.Functor.Identity as Identity +import qualified Data.Map.Strict as Map +import qualified Data.Proxy as Proxy +import qualified Data.Text as StrictText +import qualified Data.Typeable as Typeable +import qualified Data.Version as Version +import qualified Octane import qualified Test.Tasty.Hspec as Hspec +import qualified Test.Tasty.QuickCheck as QuickCheck spec :: Hspec.Spec -spec = Hspec.describe "Octane" (do pure ()) +spec = + Hspec.parallel $ + Hspec.describe "Octane" $ do + Hspec.describe "binary" $ do + binaryRoundTrip (Proxy.Proxy :: Proxy.Proxy Octane.Boolean) + binaryRoundTrip (Proxy.Proxy :: Proxy.Proxy Octane.CacheItem) + binaryRoundTrip (Proxy.Proxy :: Proxy.Proxy Octane.CacheProperty) + binaryRoundTrip (Proxy.Proxy :: Proxy.Proxy Octane.ClassItem) + binaryRoundTrip (Proxy.Proxy :: Proxy.Proxy (Octane.Dictionary ())) + binaryRoundTrip (Proxy.Proxy :: Proxy.Proxy Octane.Float32) + binaryRoundTrip (Proxy.Proxy :: Proxy.Proxy Octane.Int8) + binaryRoundTrip (Proxy.Proxy :: Proxy.Proxy Octane.Int32) + binaryRoundTrip (Proxy.Proxy :: Proxy.Proxy Octane.KeyFrame) + binaryRoundTrip (Proxy.Proxy :: Proxy.Proxy (Octane.List ())) + binaryRoundTrip (Proxy.Proxy :: Proxy.Proxy Octane.Mark) + binaryRoundTrip (Proxy.Proxy :: Proxy.Proxy Octane.Message) + pure () -- TODO: binaryRoundTrip (Proxy.Proxy :: Proxy.Proxy Octane.OptimizedReplay) + binaryRoundTrip (Proxy.Proxy :: Proxy.Proxy Octane.Property) + binaryRoundTrip (Proxy.Proxy :: Proxy.Proxy (Octane.ArrayProperty ())) + binaryRoundTrip (Proxy.Proxy :: Proxy.Proxy Octane.BoolProperty) + binaryRoundTrip (Proxy.Proxy :: Proxy.Proxy Octane.ByteProperty) + binaryRoundTrip (Proxy.Proxy :: Proxy.Proxy Octane.FloatProperty) + binaryRoundTrip (Proxy.Proxy :: Proxy.Proxy Octane.IntProperty) + binaryRoundTrip (Proxy.Proxy :: Proxy.Proxy Octane.NameProperty) + binaryRoundTrip (Proxy.Proxy :: Proxy.Proxy Octane.QWordProperty) + binaryRoundTrip (Proxy.Proxy :: Proxy.Proxy Octane.StrProperty) + binaryRoundTrip (Proxy.Proxy :: Proxy.Proxy Octane.RawReplay) + pure () -- TODO: binaryRoundTrip (Proxy.Proxy :: Proxy.Proxy Octane.Replay) + pure () -- TODO: binaryRoundTrip (Proxy.Proxy :: Proxy.Proxy Octane.ReplayWithFrames) + pure () -- TODO: binaryRoundTrip (Proxy.Proxy :: Proxy.Proxy Octane.ReplayWithoutFrames) + binaryRoundTrip (Proxy.Proxy :: Proxy.Proxy Octane.Stream) + binaryRoundTrip (Proxy.Proxy :: Proxy.Proxy Octane.Text) + binaryRoundTrip (Proxy.Proxy :: Proxy.Proxy Octane.Word8) + binaryRoundTrip (Proxy.Proxy :: Proxy.Proxy Octane.Word16) + binaryRoundTrip (Proxy.Proxy :: Proxy.Proxy Octane.Word32) + binaryRoundTrip (Proxy.Proxy :: Proxy.Proxy Octane.Word64) + Hspec.describe "binary bit" $ do + binaryBitRoundTrip (Proxy.Proxy :: Proxy.Proxy Octane.Boolean) + binaryBitRoundTrip (Proxy.Proxy :: Proxy.Proxy Octane.Float32) + binaryBitRoundTrip (Proxy.Proxy :: Proxy.Proxy Octane.Int8) + binaryBitRoundTrip (Proxy.Proxy :: Proxy.Proxy Octane.Int32) + pure () -- TODO: binaryBitRoundTrip (Proxy.Proxy :: Proxy.Proxy Octane.PlayStationId) + pure () -- TODO: binaryBitRoundTrip (Proxy.Proxy :: Proxy.Proxy Octane.SplitscreenId) + binaryBitRoundTrip (Proxy.Proxy :: Proxy.Proxy Octane.SteamId) + binaryBitRoundTrip (Proxy.Proxy :: Proxy.Proxy Octane.XboxId) + binaryBitRoundTrip (Proxy.Proxy :: Proxy.Proxy Octane.Text) + binaryBitRoundTrip (Proxy.Proxy :: Proxy.Proxy Octane.Word8) + binaryBitRoundTrip (Proxy.Proxy :: Proxy.Proxy Octane.Word32) + binaryBitRoundTrip (Proxy.Proxy :: Proxy.Proxy Octane.Word64) + Hspec.describe "custom binary bit" $ do + customBinaryBitRoundTrip + (Proxy.Proxy :: Proxy.Proxy Octane.CompressedWord) + (\x -> BinaryBit.putBits undefined x) + (\x -> BinaryBit.getBits (x & #limit & fromIntegral)) + Hspec.it "can round trip Vector Float" $ + QuickCheck.property $ \input -> do + let put = + input & floatVectorUnpack & Octane.putFloatVector & + BinaryBit.runBitPut + let get = + Octane.getFloatVector & BinaryBit.runBitGet & fmap FloatVector + let output = put & Binary.runPut & Binary.runGet get + let epsilon = 0.0001 + [#x, #y, #z] & + map + (\field -> do + let expected = input & floatVectorUnpack & field + let actual = output & floatVectorUnpack & field + let delta = actual - expected + Hspec.shouldSatisfy (abs delta) (< epsilon)) & + Foldable.sequence_ + customBinaryBitRoundTrip + (Proxy.Proxy :: Proxy.Proxy (Octane.Vector Int)) + (\x -> Octane.putIntVector x) + (\_ -> Octane.getIntVector) + customBinaryBitRoundTrip + (Proxy.Proxy :: Proxy.Proxy (Octane.Vector Octane.Int8)) + (\x -> Octane.putInt8Vector x) + (\_ -> Octane.getInt8Vector) + Hspec.describe "Replay" $ do + let proxy = Proxy.Proxy :: Proxy.Proxy Octane.Replay + let rid = Identity.runIdentity + roundTrip + proxy + (\x -> + x & Octane.toOptimizedReplay & rid & Octane.fromOptimizedReplay & rid) + roundTrip + proxy + (\x -> + x & Octane.toOptimizedReplay & rid & Octane.toReplayWithFrames & rid & + Octane.fromReplayWithFrames & + rid & + Octane.fromOptimizedReplay & + rid) + +binaryRoundTrip + :: forall a. + ( QuickCheck.Arbitrary a + , Binary.Binary a + , Eq a + , Show a + , Typeable.Typeable a + ) + => Proxy.Proxy a -> Hspec.SpecWith () +binaryRoundTrip proxy = + roundTrip proxy (\x -> x & Binary.encode & Binary.decode) + +binaryBitRoundTrip + :: forall a. + ( QuickCheck.Arbitrary a + , BinaryBit.BinaryBit a + , Eq a + , Show a + , Typeable.Typeable a + ) + => Proxy.Proxy a -> Hspec.SpecWith () +binaryBitRoundTrip proxy = + customBinaryBitRoundTrip + proxy + (\x -> BinaryBit.putBits undefined x) + (\_ -> BinaryBit.getBits undefined) + +customBinaryBitRoundTrip + :: forall a. + (QuickCheck.Arbitrary a, Eq a, Show a, Typeable.Typeable a) + => Proxy.Proxy a + -> (a -> BinaryBit.BitPut ()) + -> (a -> BinaryBit.BitGet a) + -> Hspec.SpecWith () +customBinaryBitRoundTrip proxy bitPut bitGet = + roundTrip + proxy + (\x -> do + let put = x & bitPut & BinaryBit.runBitPut + let get = x & bitGet & BinaryBit.runBitGet + put & Binary.runPut & Binary.runGet get) + +roundTrip + :: forall a. + (QuickCheck.Arbitrary a, Eq a, Show a, Typeable.Typeable a) + => Proxy.Proxy a -> (a -> a) -> Hspec.SpecWith () +roundTrip proxy f = + Hspec.it + ("can round trip " ++ typeName proxy) + (QuickCheck.property (\x -> Hspec.shouldBe (f x) (x :: a))) + +typeName + :: forall a. + (Typeable.Typeable a) + => Proxy.Proxy a -> String +typeName _ = (undefined :: a) & Typeable.typeOf & show + +instance QuickCheck.Arbitrary Octane.Boolean where + arbitrary = Octane.Boolean <$> QuickCheck.arbitrary + +instance QuickCheck.Arbitrary Octane.CacheItem where + arbitrary = + Octane.CacheItem <$> QuickCheck.arbitrary <*> QuickCheck.arbitrary <*> + QuickCheck.arbitrary <*> + QuickCheck.arbitrary + +instance QuickCheck.Arbitrary Octane.CacheProperty where + arbitrary = + Octane.CacheProperty <$> QuickCheck.arbitrary <*> QuickCheck.arbitrary + +instance QuickCheck.Arbitrary Octane.ClassItem where + arbitrary = Octane.ClassItem <$> QuickCheck.arbitrary <*> QuickCheck.arbitrary + +instance QuickCheck.Arbitrary Octane.CompressedWord where + arbitrary = do + limit <- QuickCheck.choose (1, maxBound) + value <- QuickCheck.choose (0, limit) + pure (Octane.CompressedWord limit value) + +instance (QuickCheck.Arbitrary a) => + QuickCheck.Arbitrary (Octane.Dictionary a) where + arbitrary = + Octane.Dictionary <$> QuickCheck.scale (min 2) QuickCheck.arbitrary + +instance QuickCheck.Arbitrary Octane.Float32 where + arbitrary = Octane.Float32 <$> QuickCheck.arbitrary + +instance QuickCheck.Arbitrary Octane.Frame where + arbitrary = + Octane.Frame <$> QuickCheck.arbitrary <*> QuickCheck.arbitrary <*> + QuickCheck.arbitrary <*> + QuickCheck.arbitrary <*> + QuickCheck.arbitrary + +instance QuickCheck.Arbitrary Octane.Initialization where + arbitrary = + Octane.Initialization <$> QuickCheck.arbitrary <*> QuickCheck.arbitrary + +instance QuickCheck.Arbitrary Octane.Int8 where + arbitrary = Octane.Int8 <$> QuickCheck.arbitrary + +instance QuickCheck.Arbitrary Octane.Int32 where + arbitrary = Octane.Int32 <$> QuickCheck.arbitrary + +instance QuickCheck.Arbitrary Octane.KeyFrame where + arbitrary = + Octane.KeyFrame <$> QuickCheck.arbitrary <*> QuickCheck.arbitrary <*> + QuickCheck.arbitrary + +instance (QuickCheck.Arbitrary a) => + QuickCheck.Arbitrary (Octane.List a) where + arbitrary = Octane.List <$> QuickCheck.scale (min 2) QuickCheck.arbitrary + +instance QuickCheck.Arbitrary Octane.Mark where + arbitrary = Octane.Mark <$> QuickCheck.arbitrary <*> QuickCheck.arbitrary + +instance QuickCheck.Arbitrary Octane.Message where + arbitrary = + Octane.Message <$> QuickCheck.arbitrary <*> QuickCheck.arbitrary <*> + QuickCheck.arbitrary + +instance QuickCheck.Arbitrary Octane.OptimizedReplay where + arbitrary = + Octane.OptimizedReplay <$> QuickCheck.arbitrary <*> QuickCheck.arbitrary <*> + QuickCheck.arbitrary <*> + QuickCheck.arbitrary <*> + QuickCheck.arbitrary <*> + QuickCheck.arbitrary <*> + QuickCheck.arbitrary <*> + QuickCheck.arbitrary <*> + QuickCheck.arbitrary <*> + QuickCheck.arbitrary <*> + QuickCheck.arbitrary <*> + QuickCheck.arbitrary <*> + QuickCheck.arbitrary <*> + QuickCheck.arbitrary + +instance QuickCheck.Arbitrary Octane.Property where + arbitrary = + QuickCheck.oneof + [ Octane.PropertyArray <$> QuickCheck.arbitrary + , Octane.PropertyBool <$> QuickCheck.arbitrary + , Octane.PropertyByte <$> QuickCheck.arbitrary + , Octane.PropertyFloat <$> QuickCheck.arbitrary + , Octane.PropertyInt <$> QuickCheck.arbitrary + , Octane.PropertyName <$> QuickCheck.arbitrary + , Octane.PropertyQWord <$> QuickCheck.arbitrary + , Octane.PropertyStr <$> QuickCheck.arbitrary + ] + +instance (QuickCheck.Arbitrary a) => + QuickCheck.Arbitrary (Octane.ArrayProperty a) where + arbitrary = + Octane.ArrayProperty <$> QuickCheck.arbitrary <*> + QuickCheck.scale (min 2) QuickCheck.arbitrary + +instance QuickCheck.Arbitrary Octane.BoolProperty where + arbitrary = + Octane.BoolProperty <$> QuickCheck.arbitrary <*> QuickCheck.arbitrary + +instance QuickCheck.Arbitrary Octane.ByteProperty where + arbitrary = + Octane.ByteProperty <$> QuickCheck.arbitrary <*> QuickCheck.arbitrary <*> + QuickCheck.arbitrary + +instance QuickCheck.Arbitrary Octane.FloatProperty where + arbitrary = Octane.FloatProperty <$> pure 4 <*> QuickCheck.arbitrary + +instance QuickCheck.Arbitrary Octane.IntProperty where + arbitrary = Octane.IntProperty <$> pure 4 <*> QuickCheck.arbitrary + +instance QuickCheck.Arbitrary Octane.NameProperty where + arbitrary = + Octane.NameProperty <$> QuickCheck.arbitrary <*> QuickCheck.arbitrary + +instance QuickCheck.Arbitrary Octane.QWordProperty where + arbitrary = Octane.QWordProperty <$> pure 8 <*> QuickCheck.arbitrary + +instance QuickCheck.Arbitrary Octane.StrProperty where + arbitrary = + Octane.StrProperty <$> QuickCheck.arbitrary <*> QuickCheck.arbitrary + +instance QuickCheck.Arbitrary Octane.RawReplay where + arbitrary = + Octane.newRawReplay <$> QuickCheck.arbitrary <*> QuickCheck.arbitrary <*> + QuickCheck.arbitrary + +instance QuickCheck.Arbitrary Octane.RemoteId where + arbitrary = + QuickCheck.oneof + [ Octane.RemotePlayStationId <$> QuickCheck.arbitrary + , Octane.RemoteSplitscreenId <$> QuickCheck.arbitrary + , Octane.RemoteSteamId <$> QuickCheck.arbitrary + , Octane.RemoteXboxId <$> QuickCheck.arbitrary + ] + +instance QuickCheck.Arbitrary Octane.PlayStationId where + arbitrary = + Octane.PlayStationId <$> QuickCheck.arbitrary <*> QuickCheck.arbitrary + +instance QuickCheck.Arbitrary Octane.SplitscreenId where + arbitrary = Octane.SplitscreenId <$> QuickCheck.arbitrary + +instance QuickCheck.Arbitrary Octane.SteamId where + arbitrary = Octane.SteamId <$> QuickCheck.arbitrary + +instance QuickCheck.Arbitrary Octane.XboxId where + arbitrary = Octane.XboxId <$> QuickCheck.arbitrary + +instance QuickCheck.Arbitrary Octane.Replay where + arbitrary + -- The vesion must have exactly two pieces and both must be non-negative. + = do + major <- QuickCheck.arbitrarySizedNatural + minor <- QuickCheck.arbitrarySizedNatural + let version = Version.makeVersion [major, minor] + metadata <- QuickCheck.arbitrary + levels <- QuickCheck.arbitrary + -- The messages and tick marks must have keys that can be read as + -- non-negative integers. + messages <- + fmap Map.fromList $ + QuickCheck.listOf $ do + frame <- QuickCheck.arbitrarySizedNatural + let key = frame & (\x -> x :: Word) & show & StrictText.pack + value <- QuickCheck.arbitrary + pure (key, value) + tickMarks <- + fmap Map.fromList $ + QuickCheck.listOf $ do + frame <- QuickCheck.arbitrarySizedNatural + let key = frame & (\x -> x :: Word) & show & StrictText.pack + value <- QuickCheck.arbitrary + pure (key, value) + packages <- QuickCheck.arbitrary + -- Each frame has many replications. Each replication has many values. If + -- we don't limit the number of frames, things get out of hand quickly. + rawFrames <- QuickCheck.scale (min 10) QuickCheck.arbitrary + -- The first frame must be a key frame. Only the first frame can be a key + -- frame. + let frames = + rawFrames & zip (True : repeat False) & + map + (\(isKeyFrame, frame) -> frame {Octane.frameIsKeyFrame = isKeyFrame}) + pure + (Octane.Replay version metadata levels messages tickMarks packages frames) + +instance QuickCheck.Arbitrary Octane.ReplayWithFrames where + arbitrary = + Octane.ReplayWithFrames <$> QuickCheck.arbitrary <*> QuickCheck.arbitrary <*> + QuickCheck.arbitrary <*> + QuickCheck.arbitrary <*> + QuickCheck.arbitrary <*> + QuickCheck.arbitrary <*> + QuickCheck.arbitrary <*> + QuickCheck.arbitrary <*> + QuickCheck.arbitrary <*> + QuickCheck.arbitrary <*> + QuickCheck.arbitrary <*> + QuickCheck.arbitrary <*> + QuickCheck.arbitrary <*> + QuickCheck.arbitrary + +instance QuickCheck.Arbitrary Octane.ReplayWithoutFrames where + arbitrary = + Octane.ReplayWithoutFrames <$> QuickCheck.arbitrary <*> QuickCheck.arbitrary <*> + QuickCheck.arbitrary <*> + QuickCheck.arbitrary <*> + QuickCheck.arbitrary <*> + QuickCheck.arbitrary <*> + QuickCheck.arbitrary <*> + QuickCheck.arbitrary <*> + QuickCheck.arbitrary <*> + QuickCheck.arbitrary <*> + QuickCheck.arbitrary <*> + QuickCheck.arbitrary <*> + QuickCheck.arbitrary <*> + QuickCheck.arbitrary + +instance QuickCheck.Arbitrary Octane.Replication where + arbitrary = + Octane.Replication <$> QuickCheck.arbitrary <*> QuickCheck.arbitrary <*> + QuickCheck.arbitrary <*> + QuickCheck.arbitrary <*> + QuickCheck.arbitrary <*> + QuickCheck.arbitrary + +instance QuickCheck.Arbitrary Octane.State where + arbitrary = + QuickCheck.elements [Octane.Opening, Octane.Existing, Octane.Closing] + +instance QuickCheck.Arbitrary Octane.Stream where + arbitrary = Octane.Stream <$> QuickCheck.arbitrary + +instance QuickCheck.Arbitrary Octane.Text where + arbitrary = Octane.Text <$> QuickCheck.arbitrary + +instance QuickCheck.Arbitrary Octane.Value where + arbitrary = + QuickCheck.oneof + [ Octane.ValueBoolean <$> QuickCheck.arbitrary + , Octane.ValueByte <$> QuickCheck.arbitrary + , Octane.ValueCamSettings <$> QuickCheck.arbitrary + , Octane.ValueDemolish <$> QuickCheck.arbitrary + , Octane.ValueEnum <$> QuickCheck.arbitrary + , Octane.ValueExplosion <$> QuickCheck.arbitrary + , Octane.ValueFlaggedInt <$> QuickCheck.arbitrary + , Octane.ValueFloat <$> QuickCheck.arbitrary + , Octane.ValueGameMode <$> QuickCheck.arbitrary + , Octane.ValueInt <$> QuickCheck.arbitrary + , Octane.ValueLoadout <$> QuickCheck.arbitrary + , Octane.ValueLoadoutOnline <$> QuickCheck.arbitrary + , Octane.ValueLocation <$> QuickCheck.arbitrary + , Octane.ValueMusicStinger <$> QuickCheck.arbitrary + , Octane.ValuePickup <$> QuickCheck.arbitrary + , Octane.ValuePrivateMatchSettings <$> QuickCheck.arbitrary + , Octane.ValueQWord <$> QuickCheck.arbitrary + , Octane.ValueRelativeRotation <$> QuickCheck.arbitrary + , Octane.ValueReservation <$> QuickCheck.arbitrary + , Octane.ValueRigidBodyState <$> QuickCheck.arbitrary + , Octane.ValueString <$> QuickCheck.arbitrary + , Octane.ValueTeamPaint <$> QuickCheck.arbitrary + , Octane.ValueUniqueId <$> QuickCheck.arbitrary + ] + +instance QuickCheck.Arbitrary Octane.BooleanValue where + arbitrary = Octane.BooleanValue <$> QuickCheck.arbitrary + +instance QuickCheck.Arbitrary Octane.ByteValue where + arbitrary = Octane.ByteValue <$> QuickCheck.arbitrary + +instance QuickCheck.Arbitrary Octane.CamSettingsValue where + arbitrary = + Octane.CamSettingsValue <$> QuickCheck.arbitrary <*> QuickCheck.arbitrary <*> + QuickCheck.arbitrary <*> + QuickCheck.arbitrary <*> + QuickCheck.arbitrary <*> + QuickCheck.arbitrary + +instance QuickCheck.Arbitrary Octane.DemolishValue where + arbitrary = + Octane.DemolishValue <$> QuickCheck.arbitrary <*> QuickCheck.arbitrary <*> + QuickCheck.arbitrary <*> + QuickCheck.arbitrary <*> + QuickCheck.arbitrary <*> + QuickCheck.arbitrary + +instance QuickCheck.Arbitrary Octane.EnumValue where + arbitrary = Octane.EnumValue <$> QuickCheck.arbitrary <*> QuickCheck.arbitrary + +instance QuickCheck.Arbitrary Octane.ExplosionValue where + arbitrary = + Octane.ExplosionValue <$> QuickCheck.arbitrary <*> QuickCheck.arbitrary <*> + QuickCheck.arbitrary + +instance QuickCheck.Arbitrary Octane.FlaggedIntValue where + arbitrary = + Octane.FlaggedIntValue <$> QuickCheck.arbitrary <*> QuickCheck.arbitrary + +instance QuickCheck.Arbitrary Octane.FloatValue where + arbitrary = Octane.FloatValue <$> QuickCheck.arbitrary + +instance QuickCheck.Arbitrary Octane.GameModeValue where + arbitrary = Octane.GameModeValue <$> QuickCheck.arbitrary + +instance QuickCheck.Arbitrary Octane.IntValue where + arbitrary = Octane.IntValue <$> QuickCheck.arbitrary + +instance QuickCheck.Arbitrary Octane.LoadoutOnlineValue where + arbitrary = Octane.LoadoutOnlineValue <$> QuickCheck.arbitrary + +instance QuickCheck.Arbitrary Octane.LoadoutValue where + arbitrary = + Octane.LoadoutValue <$> QuickCheck.arbitrary <*> QuickCheck.arbitrary <*> + QuickCheck.arbitrary <*> + QuickCheck.arbitrary <*> + QuickCheck.arbitrary <*> + QuickCheck.arbitrary <*> + QuickCheck.arbitrary <*> + QuickCheck.arbitrary <*> + QuickCheck.arbitrary + +instance QuickCheck.Arbitrary Octane.LocationValue where + arbitrary = Octane.LocationValue <$> QuickCheck.arbitrary + +instance QuickCheck.Arbitrary Octane.MusicStingerValue where + arbitrary = + Octane.MusicStingerValue <$> QuickCheck.arbitrary <*> QuickCheck.arbitrary <*> + QuickCheck.arbitrary + +instance QuickCheck.Arbitrary Octane.PickupValue where + arbitrary = + Octane.PickupValue <$> QuickCheck.arbitrary <*> QuickCheck.arbitrary <*> + QuickCheck.arbitrary + +instance QuickCheck.Arbitrary Octane.PrivateMatchSettingsValue where + arbitrary = + Octane.PrivateMatchSettingsValue <$> QuickCheck.arbitrary <*> + QuickCheck.arbitrary <*> + QuickCheck.arbitrary <*> + QuickCheck.arbitrary <*> + QuickCheck.arbitrary <*> + QuickCheck.arbitrary + +instance QuickCheck.Arbitrary Octane.QWordValue where + arbitrary = Octane.QWordValue <$> QuickCheck.arbitrary + +instance QuickCheck.Arbitrary Octane.RelativeRotationValue where + arbitrary = Octane.RelativeRotationValue <$> QuickCheck.arbitrary + +instance QuickCheck.Arbitrary Octane.ReservationValue where + arbitrary = + Octane.ReservationValue <$> QuickCheck.arbitrary <*> QuickCheck.arbitrary <*> + QuickCheck.arbitrary <*> + QuickCheck.arbitrary <*> + QuickCheck.arbitrary <*> + QuickCheck.arbitrary <*> + QuickCheck.arbitrary + +instance QuickCheck.Arbitrary Octane.RigidBodyStateValue where + arbitrary = + Octane.RigidBodyStateValue <$> QuickCheck.arbitrary <*> QuickCheck.arbitrary <*> + QuickCheck.arbitrary <*> + QuickCheck.arbitrary <*> + QuickCheck.arbitrary + +instance QuickCheck.Arbitrary Octane.StringValue where + arbitrary = Octane.StringValue <$> QuickCheck.arbitrary + +instance QuickCheck.Arbitrary Octane.TeamPaintValue where + arbitrary = + Octane.TeamPaintValue <$> QuickCheck.arbitrary <*> QuickCheck.arbitrary <*> + QuickCheck.arbitrary <*> + QuickCheck.arbitrary <*> + QuickCheck.arbitrary + +instance QuickCheck.Arbitrary Octane.UniqueIdValue where + arbitrary = + Octane.UniqueIdValue <$> QuickCheck.arbitrary <*> QuickCheck.arbitrary <*> + QuickCheck.arbitrary + +instance (QuickCheck.Arbitrary a) => + QuickCheck.Arbitrary (Octane.Vector a) where + arbitrary = + Octane.Vector <$> QuickCheck.arbitrary <*> QuickCheck.arbitrary <*> + QuickCheck.arbitrary + +instance QuickCheck.Arbitrary Octane.Word8 where + arbitrary = Octane.Word8 <$> QuickCheck.arbitrary + +instance QuickCheck.Arbitrary Octane.Word16 where + arbitrary = Octane.Word16 <$> QuickCheck.arbitrary + +instance QuickCheck.Arbitrary Octane.Word32 where + arbitrary = Octane.Word32 <$> QuickCheck.arbitrary + +instance QuickCheck.Arbitrary Octane.Word64 where + arbitrary = Octane.Word64 <$> QuickCheck.arbitrary + +instance QuickCheck.Arbitrary LazyBytes.ByteString where + arbitrary = LazyBytes.pack <$> QuickCheck.arbitrary + +instance QuickCheck.Arbitrary StrictText.Text where + arbitrary = StrictText.pack <$> QuickCheck.arbitrary + +instance QuickCheck.Arbitrary Version.Version where + arbitrary = Version.makeVersion <$> QuickCheck.arbitrary + +newtype FloatVector = FloatVector + { floatVectorUnpack :: Octane.Vector Float + } deriving (Eq, Show) + +instance QuickCheck.Arbitrary FloatVector where + arbitrary = do + x <- QuickCheck.choose (-1, 1) + y <- QuickCheck.choose (-1, 1) + z <- QuickCheck.choose (-1, 1) + pure (FloatVector (Octane.Vector x y z))