octane 0.13.0 → 0.13.1

raw patch · 25 files changed

+440/−234 lines, 25 filesdep ~http-clientdep ~http-client-tlsPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependency ranges changed: http-client, http-client-tls

API changes (from Hackage documentation)

Files

• library/Octane/Main.hs +1/−1
• library/Octane/Type/ClassItem.hs +1/−1
• library/Octane/Type/CompressedWord.hs +90/−0
• library/Octane/Type/Float32.hs +6/−2
• library/Octane/Type/Frame.hs +4/−1
• library/Octane/Type/Initialization.hs +34/−1
• library/Octane/Type/Int32.hs +7/−3
• library/Octane/Type/Int8.hs +1/−1
• library/Octane/Type/RemoteId.hs +1/−0
• library/Octane/Type/ReplayWithFrames.hs +8/−4
• library/Octane/Type/Replication.hs +2/−1
• library/Octane/Type/Stream.hs +4/−1
• library/Octane/Type/Value.hs +3/−2
• library/Octane/Type/Vector.hs +88/−6
• library/Octane/Type/Word16.hs +3/−1
• library/Octane/Type/Word32.hs +6/−2
• library/Octane/Type/Word64.hs +6/−2
• library/Octane/Utility.hs +2/−0
• library/Octane/Utility/ClassPropertyMap.hs +3/−1
• library/Octane/Utility/Generator.hs +91/−0
• library/Octane/Utility/Optimizer.hs +6/−5
• library/Octane/Utility/Parser.hs +64/−192
• octane.cabal +5/−3
• package.yaml +3/−3
• stack.yaml +1/−1

@@ -65,7 +65,7 @@  decode :: String -> IO Replay.Replay decode x = do-    case Client.parseUrl x of+    case Client.parseUrlThrow x of         Nothing -> do             let file = x             Binary.decodeFile file

@@ -14,7 +14,7 @@   -- | A class (like @Core.Object@) and it's associated ID in the net stream--- (like 0).+-- (like @0@). data ClassItem = ClassItem     { name :: Text.Text     -- ^ The class's name.

@@ -0,0 +1,90 @@+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE OverloadedStrings #-}++module Octane.Type.CompressedWord (CompressedWord(..), fromCompressedWord) 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.Bits as Bits+import qualified GHC.Generics as Generics+import qualified Octane.Type.Boolean as Boolean++-- $setup+-- >>> import qualified Data.Binary.Get as Binary+-- >>> import qualified Data.Binary.Put as Binary+++-- | A compressed, unsigned integer. When serialized, the least significant bit+-- is first. Bits are serialized until the next bit would be greater than the+-- limit, or the number of bits necessary to reach the limit has been reached,+-- whichever comes first.+data CompressedWord = CompressedWord+    { limit :: Word+    , value :: Word+    } deriving (Eq, Generics.Generic, Show)++-- | Abuses the first argument to 'BinaryBit.getBits' as the maximum value.+--+-- >>> Binary.runGet (BinaryBit.runBitGet (BinaryBit.getBits 4)) "\x7f" :: CompressedWord+-- CompressedWord {limit = 4, value = 2}+--+-- >>> Binary.runPut (BinaryBit.runBitPut (BinaryBit.putBits 0 (CompressedWord 4 2)))+-- "\128"+instance BinaryBit.BinaryBit CompressedWord where+    getBits n = do+        let theLimit = fromIntegral n+        theValue <- getStep theLimit (bitSize theLimit) 0 0+        pure (CompressedWord theLimit theValue)++    putBits _ compressedWord = do+        let theLimit = fromIntegral (limit compressedWord)+        let theValue = fromIntegral (value compressedWord)+        let maxBits = bitSize theLimit+        let upper = (2 ^ (maxBits - 1)) - 1+        let lower = theLimit - upper+        let numBits = if lower > theValue || theValue > upper+                then maxBits+                else maxBits - 1+        BinaryBit.putWord64be numBits theValue++instance DeepSeq.NFData CompressedWord where++-- | Encoded as an object.+--+-- >>> Aeson.encode (CompressedWord 2 1)+-- "{\"Value\":1,\"Limit\":2}"+instance Aeson.ToJSON CompressedWord where+    toJSON compressedWord = Aeson.object+        [ "Limit" .= limit compressedWord+        , "Value" .= value compressedWord+        ]+++-- | Converts a 'CompressedWord' into any integral value. This is a lossy+-- conversion because it discards the compressed word's maximum value.+--+-- >>> fromCompressedWord (CompressedWord 2 1) :: Int+-- 1+fromCompressedWord :: (Integral a) => CompressedWord -> a+fromCompressedWord compressedWord = compressedWord & value & fromIntegral+++bitSize :: (Integral a, Integral b) => a -> b+bitSize x = x & fromIntegral & logBase (2 :: Double) & ceiling+++getStep :: Word -> Word -> Word -> Word -> BinaryBit.BitGet Word+getStep theLimit maxBits position theValue = do+    let x = Bits.shiftL 1 (fromIntegral position)+    if position < maxBits && theValue + x <= theLimit+    then do+        bit <- BinaryBit.getBits 0+        let newValue = if Boolean.unpack bit then theValue + x else theValue+        getStep theLimit maxBits (position + 1) newValue+    else pure theValue

@@ -29,7 +29,9 @@     { unpack :: Float     } deriving (Eq, Fractional, Generics.Generic, Num, Ord) --- | >>> Binary.decode "\x9a\x99\x99\x3f" :: Float32+-- | Little-endian.+--+-- >>> Binary.decode "\x9a\x99\x99\x3f" :: Float32 -- 1.2 -- -- >>> Binary.encode (1.2 :: Float32)@@ -43,7 +45,9 @@         & unpack         & IEEE754.putFloat32le --- | >>> Binary.runGet (BinaryBit.runBitGet (BinaryBit.getBits 0)) "\x59\x99\x99\xfc" :: Float32+-- | Little-endian with the bits in each byte reversed.+--+-- >>> Binary.runGet (BinaryBit.runBitGet (BinaryBit.getBits 0)) "\x59\x99\x99\xfc" :: Float32 -- 1.2 -- -- >>> Binary.runPut (BinaryBit.runBitPut (BinaryBit.putBits 0 (1.2 :: Float32)))

@@ -16,6 +16,7 @@ import qualified Data.Text as StrictText import qualified GHC.Generics as Generics import qualified Octane.Data as Data+import qualified Octane.Type.CompressedWord as CompressedWord import qualified Octane.Type.Float32 as Float32 import qualified Octane.Type.Initialization as Initialization import qualified Octane.Type.Replication as Replication@@ -61,7 +62,7 @@ instance Aeson.ToJSON Spawned where     toJSON (Spawned xs) = xs         & map (\ x -> do-            let k = x & Replication.actorId & show & StrictText.pack+            let k = x & Replication.actorId & CompressedWord.value & show & StrictText.pack             let v = Aeson.object                     [ "Name" .= Replication.objectName x                     , "Class" .= Replication.className x@@ -87,6 +88,7 @@         & map (\ x -> do             let k = x                     & Replication.actorId+                    & CompressedWord.value                     & show                     & StrictText.pack             let v = x@@ -117,6 +119,7 @@ instance Aeson.ToJSON Destroyed where     toJSON (Destroyed xs) = xs         & map Replication.actorId+        & map CompressedWord.value         & Aeson.toJSON  getDestroyed :: [Replication.Replication] -> Destroyed

@@ -2,10 +2,19 @@ {-# LANGUAGE DuplicateRecordFields #-} {-# LANGUAGE StrictData #-} -module Octane.Type.Initialization (Initialization(..)) where+module Octane.Type.Initialization+    ( Initialization(..)+    , getInitialization+    , putInitialization+    ) where  import qualified Control.DeepSeq as DeepSeq+import qualified Data.Binary.Bits.Get as BinaryBit+import qualified Data.Binary.Bits.Put as BinaryBit+import qualified Data.Set as Set+import qualified Data.Text as StrictText import qualified GHC.Generics as Generics+import qualified Octane.Data as Data import qualified Octane.Type.Int8 as Int8 import qualified Octane.Type.Vector as Vector @@ -22,3 +31,27 @@     } deriving (Eq, Generics.Generic, Show)  instance DeepSeq.NFData Initialization where+++-- | Gets the 'Initialization' for a given class.+getInitialization :: StrictText.Text -> BinaryBit.BitGet Initialization+getInitialization className = do+    location' <- if Set.member className Data.classesWithLocation+        then fmap Just Vector.getIntVector+        else pure Nothing+    rotation' <- if Set.member className Data.classesWithRotation+        then fmap Just Vector.getInt8Vector+        else pure Nothing+    pure Initialization { location = location', rotation = rotation' }+++-- | Puts the 'Initialization'. Note that unlike 'getInitialization', this does+-- not require the class name.+putInitialization :: Initialization -> BinaryBit.BitPut ()+putInitialization initialization = do+    case location initialization of+        Nothing -> pure ()+        Just x -> Vector.putIntVector x+    case rotation initialization of+        Nothing -> pure ()+        Just x -> Vector.putInt8Vector x

@@ -25,7 +25,9 @@     { unpack :: Int.Int32     } deriving (Eq, Generics.Generic, Num, Ord) --- | >>> Binary.decode "\x01\x00\x00\x00" :: Int32+-- | Little-endian.+--+-- >>> Binary.decode "\x01\x00\x00\x00" :: Int32 -- 1 -- -- >>> Binary.encode (1 :: Int32)@@ -39,7 +41,9 @@         let value = unpack int32         Binary.putInt32le value --- | >>> Binary.runGet (BinaryBit.runBitGet (BinaryBit.getBits 0)) "\x80\x00\x00\x00" :: Int32+-- | Little-endian with the bits in each byte reversed.+--+-- >>> Binary.runGet (BinaryBit.runBitGet (BinaryBit.getBits 0)) "\x80\x00\x00\x00" :: Int32 -- 1 -- -- >>> Binary.runPut (BinaryBit.runBitPut (BinaryBit.putBits 0 (1 :: Int32)))@@ -64,7 +68,7 @@  -- | Shown as @1234@. ----- show (1 :: Int32)+-- >>> show (1 :: Int32) -- "1" instance Show Int32 where     show int32 = show (unpack int32)

@@ -70,7 +70,7 @@  -- | Shown as @1234@. ----- show (1 :: Int8)+-- >>> show (1 :: Int8) -- "1" instance Show Int8 where     show int8 = show (unpack int8)

@@ -32,6 +32,7 @@ -- >>> import qualified Data.Binary.Get as Binary -- >>> import qualified Data.Binary.Put as Binary + -- | A player's canonical remote ID. This is the best way to uniquely identify -- players data RemoteId

@@ -8,7 +8,6 @@  import qualified Control.DeepSeq as DeepSeq import qualified Data.Binary as Binary-import qualified Data.ByteString.Lazy as LazyBytes import qualified GHC.Generics as Generics import qualified Octane.Type.CacheItem as CacheItem import qualified Octane.Type.ClassItem as ClassItem@@ -20,9 +19,9 @@ import qualified Octane.Type.Message as Message import qualified Octane.Type.Property as Property import qualified Octane.Type.ReplayWithoutFrames as ReplayWithoutFrames-import qualified Octane.Type.Stream as Stream import qualified Octane.Type.Text as Text import qualified Octane.Type.Word32 as Word32+import qualified Octane.Utility.Generator as Generator import qualified Octane.Utility.Parser as Parser  @@ -70,7 +69,7 @@         , properties = replayWithoutFrames & ReplayWithoutFrames.properties         , levels = replayWithoutFrames & ReplayWithoutFrames.levels         , keyFrames = replayWithoutFrames & ReplayWithoutFrames.keyFrames-        , frames = replayWithoutFrames & Parser.parseFrames+        , frames = replayWithoutFrames & Parser.parseStream         , messages = replayWithoutFrames & ReplayWithoutFrames.messages         , marks = replayWithoutFrames & ReplayWithoutFrames.marks         , packages = replayWithoutFrames & ReplayWithoutFrames.packages@@ -92,7 +91,12 @@         , ReplayWithoutFrames.properties = replayWithFrames & properties         , ReplayWithoutFrames.levels = replayWithFrames & levels         , ReplayWithoutFrames.keyFrames = replayWithFrames & keyFrames-        , ReplayWithoutFrames.stream = Stream.Stream LazyBytes.empty -- TODO+        , ReplayWithoutFrames.stream = Generator.generateStream+            (replayWithFrames & frames)+            (replayWithFrames & objects)+            (replayWithFrames & names)+            (replayWithFrames & classes)+            (replayWithFrames & cache)         , ReplayWithoutFrames.messages = replayWithFrames & messages         , ReplayWithoutFrames.marks = replayWithFrames & marks         , ReplayWithoutFrames.packages = replayWithFrames & packages

@@ -8,6 +8,7 @@ import qualified Data.Map.Strict as Map import qualified Data.Text as StrictText import qualified GHC.Generics as Generics+import qualified Octane.Type.CompressedWord as CompressedWord import qualified Octane.Type.Initialization as Initialization import qualified Octane.Type.State as State import qualified Octane.Type.Value as Value@@ -18,7 +19,7 @@ -- This cannot be an instance of 'Data.Binary.Bits.BinaryBit' because it -- requires out-of-band information (the class property map) to decode. data Replication = Replication-    { actorId :: Word+    { actorId :: CompressedWord.CompressedWord     -- ^ The actor's ID.     , objectName :: StrictText.Text     -- ^ The name of the actor's object.

@@ -43,8 +43,11 @@  -- | Doesn't show the actual bytes to avoid dumping tons of text. ----- >>> show (Stream "\xf0")+-- >>> show (Stream "\x00") -- "Stream {unpack = \"1 byte\"}"+--+-- >>> show (Stream "\x00\x00")+-- "Stream {unpack = \"2 bytes\"}" instance Show Stream where     show stream = do         let size = stream & unpack & LazyBytes.length

@@ -7,6 +7,7 @@ import qualified Control.DeepSeq as DeepSeq import qualified GHC.Generics as Generics 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@@ -65,7 +66,7 @@         Word32.Word32         (Maybe Word32.Word32)     | VLoadoutOnline-        [[(Word32.Word32, Int)]]+        [[(Word32.Word32, CompressedWord.CompressedWord)]]     | VLocation         (Vector.Vector Int)     | VMusicStinger@@ -88,7 +89,7 @@     | VRelativeRotation         (Vector.Vector Float)     | VReservation-        Int+        CompressedWord.CompressedWord         Word8.Word8         RemoteId.RemoteId         (Maybe Word8.Word8)

@@ -2,11 +2,25 @@ {-# LANGUAGE DuplicateRecordFields #-} {-# LANGUAGE StrictData #-} -module Octane.Type.Vector (Vector(..)) where+module Octane.Type.Vector+    ( Vector(..)+    , getFloatVector+    , getInt8Vector+    , getIntVector+    , putInt8Vector+    , putIntVector+    ) where  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 GHC.Generics as Generics+import qualified Octane.Type.Boolean as Boolean+import qualified Octane.Type.CompressedWord as CompressedWord+import qualified Octane.Type.Int8 as Int8   -- | Three values packed together. Although the fields are called @x@, @y@, and@@ -28,8 +42,76 @@ -- Aeson.encode (Vector 1 2 3 :: Vector Int) -- "[1,2,3]" instance (Aeson.ToJSON a) => Aeson.ToJSON (Vector a) where-    toJSON vector = Aeson.toJSON-        [ x vector-        , y vector-        , z vector-        ]+    toJSON vector = Aeson.toJSON [x vector, y vector, z vector]+++-- | Gets a 'Vector' full of 'Float's.+getFloatVector :: BinaryBit.BitGet (Vector Float)+getFloatVector = do+    let maxValue = 1+    let numBits = 16++    x' <- getFloat maxValue numBits+    y' <- getFloat maxValue numBits+    z' <- getFloat maxValue numBits++    pure Vector { x = x', y = y', z = z' }+++getFloat :: Int -> Int -> BinaryBit.BitGet Float+getFloat maxValue numBits = do+    let maxBitValue = (Bits.shiftL 1 (numBits - 1)) - 1+    let bias = Bits.shiftL 1 (numBits - 1)+    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)+++-- | Gets a 'Vector' full of 'Int8's.+getInt8Vector :: BinaryBit.BitGet (Vector Int8.Int8)+getInt8Vector = do+    hasX <- BinaryBit.getBits 0+    x' <- if Boolean.unpack hasX then BinaryBit.getBits 0 else pure 0++    hasY <- BinaryBit.getBits 0+    y' <- if Boolean.unpack hasY then BinaryBit.getBits 0 else pure 0++    hasZ <- BinaryBit.getBits 0+    z' <- if Boolean.unpack hasZ then BinaryBit.getBits 0 else pure 0++    pure Vector { x = x' , y = y' , z = z' }+++-- | Gets a 'Vector' full of 'Int's.+getIntVector :: BinaryBit.BitGet (Vector Int)+getIntVector = do+    numBits <- fmap CompressedWord.fromCompressedWord (BinaryBit.getBits 19)+    let bias = Bits.shiftL 1 (numBits + 1)+    let maxBits = numBits + 2+    let maxValue = 2 ^ maxBits++    dx <- fmap CompressedWord.fromCompressedWord (BinaryBit.getBits maxValue)+    dy <- fmap CompressedWord.fromCompressedWord (BinaryBit.getBits maxValue)+    dz <- fmap CompressedWord.fromCompressedWord (BinaryBit.getBits maxValue)++    pure Vector { x = dx - bias , y = dy - bias , z = dz - bias }+++-- | Puts a 'Vector' full of 'Int8's.+putInt8Vector :: Vector Int8.Int8 -> BinaryBit.BitPut ()+putInt8Vector _ = do+    pure ()+++-- | Puts a 'Vector' full of 'Int's.+putIntVector :: Vector Int -> BinaryBit.BitPut ()+putIntVector _ = do+    pure ()

@@ -21,7 +21,9 @@     { unpack :: Word.Word16     } deriving (Eq, Generics.Generic, Num, Ord) --- | >>> Binary.decode "\x01\x00" :: Word16+-- | Little-endian.+--+-- >>> Binary.decode "\x01\x00" :: Word16 -- 0x0001 -- -- >>> Binary.encode (1 :: Word16)

@@ -30,7 +30,9 @@     { unpack :: Word.Word32     } deriving (Eq, Generics.Generic, Num, Ord) --- | >>> Binary.decode "\x01\x00\x00\x00" :: Word32+-- | Little-endian.+--+-- >>> Binary.decode "\x01\x00\x00\x00" :: Word32 -- 0x00000001 -- -- >>> Binary.encode (1 :: Word32)@@ -44,7 +46,9 @@         let value = unpack word32         Binary.putWord32le value --- | >>> Binary.runGet (BinaryBit.runBitGet (BinaryBit.getBits 0)) "\x80\x00\x00\x00" :: Word32+-- | Little-endian with the bits in each byte reversed.+--+-- >>> Binary.runGet (BinaryBit.runBitGet (BinaryBit.getBits 0)) "\x80\x00\x00\x00" :: Word32 -- 0x00000001 -- -- >>> Binary.runPut (BinaryBit.runBitPut (BinaryBit.putBits 0 (1 :: Word32)))

@@ -30,7 +30,9 @@     { unpack :: Word.Word64     } deriving (Eq, Generics.Generic, Num, Ord) --- | >>> Binary.decode "\x01\x00\x00\x00\x00\x00\x00\x00" :: Word64+-- | Little-endian.+--+-- >>> Binary.decode "\x01\x00\x00\x00\x00\x00\x00\x00" :: Word64 -- 0x0000000000000001 -- -- >>> Binary.encode (1 :: Word64)@@ -44,7 +46,9 @@         let value = unpack word64         Binary.putWord64le value --- | >>> Binary.runGet (BinaryBit.runBitGet (BinaryBit.getBits 0)) "\x80\x00\x00\x00\x00\x00\x00\x00" :: Word64+-- | Little-endian with the bits in each byte reversed.+--+-- >>> Binary.runGet (BinaryBit.runBitGet (BinaryBit.getBits 0)) "\x80\x00\x00\x00\x00\x00\x00\x00" :: Word64 -- 0x0000000000000001 -- -- >>> Binary.runPut (BinaryBit.runBitPut (BinaryBit.putBits 0 (1 :: Word64)))

@@ -3,6 +3,7 @@     , module Octane.Utility.CRC     , module Octane.Utility.Embed     , module Octane.Utility.Endian+    , module Octane.Utility.Generator     , module Octane.Utility.Optimizer     , module Octane.Utility.Parser     ) where@@ -11,5 +12,6 @@ import Octane.Utility.CRC import Octane.Utility.Embed import Octane.Utility.Endian+import Octane.Utility.Generator import Octane.Utility.Optimizer import Octane.Utility.Parser

@@ -1,3 +1,5 @@+{-# LANGUAGE PackageImports #-}+ -- | This module is responsible for building the class property map, which maps -- class IDs to a map of property IDs to property names. This map is the -- cornerstone of the replay stream parser.@@ -22,7 +24,7 @@ import qualified Octane.Type.ReplayWithoutFrames as ReplayWithoutFrames import qualified Octane.Type.Text as Text import qualified Octane.Type.Word32 as Word32-import qualified Text.Regex as Regex+import qualified "regex-compat" Text.Regex as Regex   -- | The class property map is a map from class IDs in the stream to a map from

@@ -0,0 +1,91 @@+module Octane.Utility.Generator (generateStream) where++import Data.Function ((&))++import qualified Data.Binary.Bits as BinaryBit+import qualified Data.Binary.Bits.Put as BinaryBit+import qualified Data.Binary.Put as Binary+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.Frame as Frame+import qualified Octane.Type.Initialization as Initialization+import qualified Octane.Type.List as List+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+++-- | Generates a network stream.+generateStream+    :: [Frame.Frame]+    -> List.List Text.Text+    -> List.List Text.Text+    -> List.List ClassItem.ClassItem+    -> List.List CacheItem.CacheItem+    -> Stream.Stream+generateStream frames _objects _names _classes _cache = do+    let bitPut = putFrames frames+    let bytePut = BinaryBit.runBitPut bitPut+    let bytes = Binary.runPut bytePut+    Stream.Stream bytes+++putFrames :: [Frame.Frame] -> BinaryBit.BitPut ()+putFrames frames = do+    case frames of+        [] -> pure ()+        frame : rest -> do+            putFrame frame+            putFrames rest+++putFrame :: Frame.Frame -> BinaryBit.BitPut ()+putFrame frame = do+    frame & Frame.time & BinaryBit.putBits 32+    frame & Frame.delta & BinaryBit.putBits 32+    frame & Frame.replications & putReplications+++putReplications :: [Replication.Replication] -> BinaryBit.BitPut ()+putReplications 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 :: Replication.Replication -> BinaryBit.BitPut ()+putReplication replication = do+    replication & Replication.actorId & BinaryBit.putBits 0+    case Replication.state replication of+        State.SOpening -> putNewReplication replication+        State.SExisting -> putExistingReplication replication+        State.SClosing -> putClosedReplication replication+++putNewReplication :: Replication.Replication -> BinaryBit.BitPut ()+putNewReplication replication = do+    True & Boolean.Boolean & BinaryBit.putBits 1 -- open+    True & Boolean.Boolean & BinaryBit.putBits 1 -- new+    False & Boolean.Boolean & BinaryBit.putBits 1 -- unknown+    -- TODO: convert object name into ID and put it+    case Replication.initialization replication of+        Nothing -> pure ()+        Just x -> Initialization.putInitialization x+++putExistingReplication :: Replication.Replication -> BinaryBit.BitPut ()+putExistingReplication _replication = do+    True & Boolean.Boolean & BinaryBit.putBits 1 -- open+    False & Boolean.Boolean & BinaryBit.putBits 1 -- existing+    -- TODO: put props+++putClosedReplication :: Replication.Replication -> BinaryBit.BitPut ()+putClosedReplication _replication = do+    False & Boolean.Boolean & BinaryBit.putBits 1 -- closed

@@ -8,6 +8,7 @@ import qualified Data.IntMap.Strict as IntMap import qualified Data.Map.Strict as Map import qualified Data.Text as StrictText+import qualified Octane.Type.CompressedWord as CompressedWord import qualified Octane.Type.Frame as Frame import qualified Octane.Type.Replication as Replication import qualified Octane.Type.State as State@@ -43,7 +44,7 @@             & Replication.state             & (== State.SOpening))         & map Replication.actorId-        & map fromIntegral+        & map CompressedWord.fromCompressedWord     state2 = spawned         & foldr             (IntMap.alter (\ maybeValue -> Just (case maybeValue of@@ -57,7 +58,7 @@             & Replication.state             & (== State.SClosing))         & map Replication.actorId-        & map fromIntegral+        & map CompressedWord.fromCompressedWord     state3 = destroyed         & foldr             (IntMap.alter (\ maybeValue -> Just (case maybeValue of@@ -82,7 +83,7 @@                             (Replication.properties replication)                             properties                         )))-                (replication & Replication.actorId & fromIntegral))+                (replication & Replication.actorId & CompressedWord.fromCompressedWord))             state3      in state4@@ -96,7 +97,7 @@         & reject (\ replication -> let             isOpening = Replication.state replication == State.SOpening             actorId = Replication.actorId replication-            currentState = IntMap.lookup (fromIntegral actorId) state+            currentState = IntMap.lookup (CompressedWord.fromCompressedWord actorId) state             isAlive = fmap fst currentState             wasAlreadyAlive = isAlive == Just True             in isOpening && wasAlreadyAlive)@@ -106,7 +107,7 @@             then let                 actorId = Replication.actorId replication                 currentState = IntMap.findWithDefault-                    (True, Map.empty) (fromIntegral actorId) state+                    (True, Map.empty) (CompressedWord.fromCompressedWord actorId) state                 currentProperties = snd currentState                 newProperties = Replication.properties replication                 changes = newProperties

@@ -2,7 +2,7 @@ {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE StrictData #-} -module Octane.Utility.Parser (parseFrames) where+module Octane.Utility.Parser (parseStream) where  import Data.Function ((&)) @@ -11,7 +11,6 @@ import qualified Data.Binary.Bits as BinaryBit import qualified Data.Binary.Bits.Get as Bits import qualified Data.Binary.Get as Binary-import qualified Data.Bits as Bits import qualified Data.IntMap.Strict as IntMap import qualified Data.Map.Strict as Map import qualified Data.Set as Set@@ -20,12 +19,12 @@ 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.Dictionary as Dictionary import qualified Octane.Type.Float32 as Float32 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.Int8 as Int8 import qualified Octane.Type.KeyFrame as KeyFrame import qualified Octane.Type.List as List import qualified Octane.Type.Property as Property@@ -46,8 +45,8 @@   -- | Parses the network stream and returns a list of frames.-parseFrames :: ReplayWithoutFrames.ReplayWithoutFrames -> [Frame.Frame]-parseFrames replay = let+parseStream :: ReplayWithoutFrames.ReplayWithoutFrames -> [Frame.Frame]+parseStream replay = let     numFrames = replay         & ReplayWithoutFrames.properties         & Dictionary.unpack@@ -127,7 +126,7 @@  getReplication :: Context -> Bits.BitGet (Context, Replication.Replication) getReplication context = do-    actorId <- getActorId+    actorId <- BinaryBit.getBits maxActorId     isOpen <- getBool     let go =             if Boolean.unpack isOpen@@ -137,7 +136,7 @@   getOpenReplication :: Context-                   -> Int+                   -> CompressedWord.CompressedWord                    -> Bits.BitGet (Context, Replication.Replication) getOpenReplication context actorId = do     isNew <- getBool@@ -149,7 +148,7 @@   getNewReplication :: Context-                  -> Int+                  -> CompressedWord.CompressedWord                   -> Bits.BitGet (Context, Replication.Replication) getNewReplication context actorId = do     unknownFlag <- getBool@@ -160,10 +159,12 @@     objectName <- case context & contextObjectMap & IntMap.lookup (Int32.fromInt32 objectId) of         Nothing -> fail ("could not find object name for id " ++ show objectId)         Just x -> pure x-    (classId, className) <- case CPM.getClass (contextObjectMap context) Data.classes (contextClassMap context) (Int32.fromInt32 objectId) of-        Nothing -> fail ("could not find class for object id " ++ show objectId)-        Just x -> pure x-    classInit <- getInitialization className+    (classId, className) <- CPM.getClass+        (contextObjectMap context)+        Data.classes+        (contextClassMap context)+        (Int32.fromInt32 objectId)+    classInit <- Initialization.getInitialization className     let thing = Thing             { thingFlag = unknownFlag             , thingObjectId = objectId@@ -173,12 +174,12 @@             , thingInitialization = classInit             }     let things = contextThings context-    let newThings = IntMap.insert actorId thing things+    let newThings = IntMap.insert (CompressedWord.fromCompressedWord actorId) thing things     let newContext = context { contextThings = newThings }     pure         ( newContext         , Replication.Replication-          { Replication.actorId = fromIntegral actorId+          { Replication.actorId = actorId           , Replication.objectName = objectName           , Replication.className = className           , Replication.state = State.SOpening@@ -188,15 +189,15 @@   getExistingReplication :: Context-                       -> Int+                       -> CompressedWord.CompressedWord                        -> Bits.BitGet (Context, Replication.Replication) getExistingReplication context actorId = do-    thing <- case context & contextThings & IntMap.lookup actorId of+    thing <- case context & contextThings & IntMap.lookup (CompressedWord.fromCompressedWord actorId) of         Nothing -> fail ("could not find thing for existing actor " ++ show actorId)         Just x -> pure x     props <- getProps context thing     pure (context, Replication.Replication-        { Replication.actorId = fromIntegral actorId+        { Replication.actorId = actorId         , Replication.objectName = thingObjectName thing         , Replication.className = thingClassName thing         , Replication.state = State.SExisting@@ -206,18 +207,18 @@   getClosedReplication :: Context-                     -> Int+                     -> CompressedWord.CompressedWord                      -> Bits.BitGet (Context, Replication.Replication) getClosedReplication context actorId = do-    thing <- case context & contextThings & IntMap.lookup actorId of+    thing <- case context & contextThings & IntMap.lookup (CompressedWord.fromCompressedWord actorId) of         Nothing -> fail ("could not find thing for closed actor " ++ show actorId)         Just x -> pure x-    let newThings = context & contextThings & IntMap.delete actorId+    let newThings = context & contextThings & IntMap.delete (CompressedWord.fromCompressedWord actorId)     let newContext = context { contextThings = newThings }     pure         ( newContext         , Replication.Replication-          { Replication.actorId = fromIntegral actorId+          { Replication.actorId = actorId           , Replication.objectName = thingObjectName thing           , Replication.className = thingClassName thing           , Replication.state = State.SClosing@@ -254,7 +255,7 @@         Nothing -> fail ("could not find property map for class id " ++ show classId)         Just x -> pure x     let maxId = props & IntMap.keys & (0 :) & maximum-    pid <- getInt maxId+    pid <- fmap CompressedWord.fromCompressedWord (BinaryBit.getBits maxId)     name <- case props & IntMap.lookup pid of         Nothing -> fail ("could not find property name for property id " ++ show pid)         Just x -> pure x@@ -323,8 +324,8 @@     atk <- getWord32     vicFlag <- getBool     vic <- getWord32-    vec1 <- getVector-    vec2 <- getVector+    vec1 <- Vector.getIntVector+    vec2 <- Vector.getIntVector     pure (Value.VDemolish atkFlag atk vicFlag vic vec1 vec2)  @@ -343,7 +344,7 @@     a <- if Boolean.unpack noGoal         then pure Nothing         else fmap Just getInt32-    b <- getVector+    b <- Vector.getIntVector     pure (Value.VExplosion noGoal a b)  @@ -374,12 +375,12 @@  getLoadoutOnlineProperty :: Bits.BitGet Value.Value getLoadoutOnlineProperty = do-    size <- getWord8-    values <- Monad.replicateM (size & Word8.unpack & fromIntegral) (do-        innerSize <- getWord8-        Monad.replicateM (innerSize & Word8.unpack & fromIntegral) (do+    size <- fmap Word8.fromWord8 getWord8+    values <- Monad.replicateM size (do+        innerSize <- fmap Word8.fromWord8 getWord8+        Monad.replicateM innerSize (do             x <- getWord32-            y <- getInt 27+            y <- BinaryBit.getBits 27             pure (x, y)))     pure (Value.VLoadoutOnline values) @@ -394,17 +395,13 @@     antenna <- getWord32     topper <- getWord32     g <- getWord32-    h <- if version > 10-        then do-            value <- getWord32-            pure (Just value)-        else pure Nothing+    h <- if version > 10 then fmap Just getWord32 else pure Nothing     pure (Value.VLoadout version body decal wheels rocketTrail antenna topper g h)   getLocationProperty :: Bits.BitGet Value.Value getLocationProperty = do-    vector <- getVector+    vector <- Vector.getIntVector     pure (Value.VLocation vector)  @@ -445,7 +442,7 @@  getRelativeRotationProperty :: Bits.BitGet Value.Value getRelativeRotationProperty = do-    vector <- getFloatVector+    vector <- Vector.getFloatVector     pure (Value.VRelativeRotation vector)  getReservationProperty :: Context -> Bits.BitGet Value.Value@@ -453,11 +450,9 @@     -- I think this is the connection order. The first player to connect     -- gets number 0, and it goes up from there. The maximum is 7, which     -- would be a full 4x4 game.-    number <- getInt7+    number <- BinaryBit.getBits maxConnectionNumber     (systemId, remoteId, localId) <- getUniqueId-    playerName <- if systemId == 0 then pure Nothing else do-        string <- getText-        pure (Just string)+    playerName <- if systemId == 0 then pure Nothing else fmap Just getText     -- No idea what these two flags are. Might be for bots?     a <- getBool     b <- getBool@@ -473,21 +468,17 @@     pure (Value.VReservation number systemId remoteId localId playerName a b)  -neoTokyoVersion :: Version.Version-neoTokyoVersion = Version.makeVersion [868, 12]-- getRigidBodyStateProperty :: Bits.BitGet Value.Value getRigidBodyStateProperty = do     flag <- getBool-    position <- getVector-    rotation <- getFloatVector+    position <- Vector.getIntVector+    rotation <- Vector.getFloatVector     x <- if Boolean.unpack flag         then pure Nothing-        else fmap Just getVector+        else fmap Just Vector.getIntVector     y <- if Boolean.unpack flag         then pure Nothing-        else fmap Just getVector+        else fmap Just Vector.getIntVector     pure (Value.VRigidBodyState flag position rotation x y)  @@ -517,36 +508,24 @@ -- specially because it sometimes doesn't have the remote or local IDs. getPartyLeaderProperty :: Bits.BitGet Value.Value getPartyLeaderProperty = do-    systemId <- getSystemId+    systemId <- getWord8     (remoteId, localId) <- if systemId == 0         then pure (RemoteId.RemoteSplitscreenId (RemoteId.SplitscreenId Nothing), Nothing)         else do             remoteId <- getRemoteId systemId-            localId <- getLocalId+            localId <- fmap Just getWord8             pure (remoteId, localId)     pure (Value.VUniqueId systemId remoteId localId)  -getFloat32 :: Bits.BitGet Float32.Float32-getFloat32 = BinaryBit.getBits 0---getText :: Bits.BitGet Text.Text-getText = BinaryBit.getBits 0-- getUniqueId :: Bits.BitGet (Word8.Word8, RemoteId.RemoteId, Maybe Word8.Word8) getUniqueId = do-    systemId <- getSystemId+    systemId <- getWord8     remoteId <- getRemoteId systemId-    localId <- getLocalId+    localId <- fmap Just getWord8     pure (systemId, remoteId, localId)  -getSystemId :: Bits.BitGet Word8.Word8-getSystemId = getWord8-- getRemoteId :: Word8.Word8 -> Bits.BitGet RemoteId.RemoteId getRemoteId systemId = case systemId of     0 -> do@@ -564,8 +543,7 @@     _ -> fail ("unknown system id " ++ show systemId)  -getLocalId :: Bits.BitGet (Maybe Word8.Word8)-getLocalId = fmap Just getWord8+-- Data types   data Thing = Thing@@ -605,8 +583,7 @@   extractContext :: ReplayWithoutFrames.ReplayWithoutFrames -> Context-extractContext replay =-    Context+extractContext replay = Context     { contextObjectMap = CPM.getPropertyMap replay     , contextClassPropertyMap = CPM.getClassPropertyMap replay     , contextThings = IntMap.empty@@ -624,152 +601,47 @@     }  -getVector :: Bits.BitGet (Vector.Vector Int)-getVector = do-    numBits <- getNumVectorBits-    let bias = Bits.shiftL 1 (numBits + 1)-    let maxBits = numBits + 2-    let maxValue = 2 ^ maxBits-    dx <- getInt maxValue-    dy <- getInt maxValue-    dz <- getInt maxValue-    pure-        Vector.Vector-        { Vector.x = dx - bias-        , Vector.y = dy - bias-        , Vector.z = dz - bias-        }+-- Constants  -getVectorBytewise-    :: Bits.BitGet (Vector.Vector Int8.Int8)-getVectorBytewise = do-    hasX <- getBool-    x <- if Boolean.unpack hasX then getInt8 else pure 0-    hasY <- getBool-    y <- if Boolean.unpack hasY then getInt8 else pure 0-    hasZ <- getBool-    z <- if Boolean.unpack hasZ then getInt8 else pure 0-    pure-        Vector.Vector-        { Vector.x = x-        , Vector.y = y-        , Vector.z = z-        }+neoTokyoVersion :: Version.Version+neoTokyoVersion = Version.makeVersion [868, 12]  -getFloatVector :: Bits.BitGet (Vector.Vector Float)-getFloatVector = do-    let maxValue = 1-    let numBits = 16-    x <- getFloat maxValue numBits-    y <- getFloat maxValue numBits-    z <- getFloat maxValue numBits-    pure Vector.Vector { Vector.x = x, Vector.y = y, Vector.z = z }+maxActorId :: Int+maxActorId = 1024  -getFloat :: Int -> Int -> Bits.BitGet Float-getFloat maxValue numBits = do-    let maxBitValue = (Bits.shiftL 1 (numBits - 1)) - 1-    let bias = Bits.shiftL 1 (numBits - 1)-    let serIntMax = Bits.shiftL 1 numBits-    delta <- getInt serIntMax-    let unscaledValue = delta - 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)+maxConnectionNumber :: Int+maxConnectionNumber = 7  -getInitialization :: StrictText.Text -> Bits.BitGet Initialization.Initialization-getInitialization className = do-    location <--        if Set.member className Data.classesWithLocation-            then do-                vector <- getVector-                pure (Just vector)-            else pure Nothing-    rotation <--        if Set.member className Data.classesWithRotation-            then do-                vector <- getVectorBytewise-                pure (Just vector)-            else pure Nothing-    pure-        Initialization.Initialization-        { Initialization.location = location-        , Initialization.rotation = rotation-        }+-- Type-restricted helpers.  -bitSize-    :: (Integral a)-    => a -> a-bitSize x = x & fromIntegral & logBase (2 :: Double) & ceiling+getBool :: Bits.BitGet Boolean.Boolean+getBool = BinaryBit.getBits 0  --- Reads an integer bitwise. The bits of the integer are backwards, so the--- least significant bit is first. The argument is the maximum value this--- integer can have. Bits will be read until the next bit would be greater than--- the maximum value, or the number of bits necessary to reach the maximum--- value has been reached, whichever comes first.------ For example, if the maximum value is 4 and "11" has been read already,--- nothing more will be read because another "1" would put the value over the--- maximum.-getInt-    :: Int -> Bits.BitGet Int-getInt maxValue = do-    let maxBits = bitSize maxValue-        go i value = do-            let x = Bits.shiftL 1 i-            if i < maxBits && value + x <= maxValue-                then do-                    bit <- getBool-                    let newValue =-                            if Boolean.unpack bit-                                then value + x-                                else value-                    go (i + 1) newValue-                else pure value-    go 0 0+getFloat32 :: Bits.BitGet Float32.Float32+getFloat32 = BinaryBit.getBits 0   getInt32 :: Bits.BitGet Int32.Int32 getInt32 = BinaryBit.getBits 0  -getInt8 :: Bits.BitGet Int8.Int8-getInt8 = BinaryBit.getBits 0---getWord64 :: Bits.BitGet Word64.Word64-getWord64 = BinaryBit.getBits 0---getWord32 :: Bits.BitGet Word32.Word32-getWord32 = BinaryBit.getBits 0+getText :: Bits.BitGet Text.Text+getText = BinaryBit.getBits 0   getWord8 :: Bits.BitGet Word8.Word8 getWord8 = BinaryBit.getBits 0  -getActorId :: Bits.BitGet Int-getActorId = getInt 1024---getNumVectorBits :: Bits.BitGet Int-getNumVectorBits = getInt 19---getInt7 :: Bits.BitGet Int-getInt7 = getInt 7+getWord32 :: Bits.BitGet Word32.Word32+getWord32 = BinaryBit.getBits 0  -getBool :: Bits.BitGet Boolean.Boolean-getBool = BinaryBit.getBits 0+getWord64 :: Bits.BitGet Word64.Word64+getWord64 = BinaryBit.getBits 0

@@ -3,7 +3,7 @@ -- see: https://github.com/sol/hpack  name:           octane-version:        0.13.0+version:        0.13.1 synopsis:       Parse Rocket League replays. description:    Octane parses Rocket League replays. category:       Game@@ -46,8 +46,8 @@     , data-binary-ieee754 ==0.4.*     , deepseq ==1.4.*     , file-embed ==0.0.*-    , http-client ==0.4.*-    , http-client-tls ==0.2.*+    , http-client >=0.4.30 && <0.6+    , http-client-tls >=0.2 && <0.4     , regex-compat ==0.95.*     , text ==1.2.*     , unordered-containers ==0.2.*@@ -61,6 +61,7 @@       Octane.Type.CacheItem       Octane.Type.CacheProperty       Octane.Type.ClassItem+      Octane.Type.CompressedWord       Octane.Type.Dictionary       Octane.Type.Float32       Octane.Type.Frame@@ -93,6 +94,7 @@       Octane.Utility.CRC       Octane.Utility.Embed       Octane.Utility.Endian+      Octane.Utility.Generator       Octane.Utility.Optimizer       Octane.Utility.Parser   default-language: Haskell2010

@@ -43,8 +43,8 @@   - data-binary-ieee754 ==0.4.*   - deepseq ==1.4.*   - file-embed ==0.0.*-  - http-client ==0.4.*-  - http-client-tls ==0.2.*+  - http-client >=0.4.30 && <0.6+  - http-client-tls >=0.2 && <0.4   - regex-compat ==0.95.*   - text ==1.2.*   - unordered-containers ==0.2.*@@ -79,4 +79,4 @@     - -with-rtsopts=-N     main: Main.hs     source-dirs: test-suite-version: '0.13.0'+version: '0.13.1'

@@ -1,1 +1,1 @@-resolver: nightly-2016-06-04+resolver: nightly-2016-07-05