Section.hs

module Rattletrap.Type.Section where

import qualified Control.Monad as Monad
import qualified Data.ByteString as ByteString
import qualified Data.Text as Text
import qualified Rattletrap.ByteGet as ByteGet
import qualified Rattletrap.BytePut as BytePut
import qualified Rattletrap.Exception.CrcMismatch as CrcMismatch
import qualified Rattletrap.Schema as Schema
import qualified Rattletrap.Type.U32 as U32
import qualified Rattletrap.Utility.Crc as Crc
import qualified Rattletrap.Utility.Json as Json

-- | A section is a large piece of a 'Rattletrap.Replay.Replay'. It has a
-- 32-bit size (in bytes), a 32-bit CRC (see "Rattletrap.Utility.Crc"), and then a
-- bunch of data (the body). This interface is provided so that you don't have
-- to think about the size and CRC.
data Section a = Section
  { -- | read only
    size :: U32.U32,
    -- | read only
    crc :: U32.U32,
    -- | The actual content in the section.
    body :: a
  }
  deriving (Eq, Show)

instance (Json.FromJSON a) => Json.FromJSON (Section a) where
  parseJSON = Json.withObject "Section" $ \object -> do
    size <- Json.required object "size"
    crc <- Json.required object "crc"
    body <- Json.required object "body"
    pure Section {size, crc, body}

instance (Json.ToJSON a) => Json.ToJSON (Section a) where
  toJSON x =
    Json.object
      [ Json.pair "size" $ size x,
        Json.pair "crc" $ crc x,
        Json.pair "body" $ body x
      ]

schema :: Schema.Schema -> Schema.Schema
schema s =
  Schema.named ("section-" <> Text.unpack (Schema.name s)) $
    Schema.object
      [ (Json.pair "size" $ Schema.ref U32.schema, True),
        (Json.pair "crc" $ Schema.ref U32.schema, True),
        (Json.pair "body" $ Schema.ref s, True)
      ]

create :: (a -> BytePut.BytePut) -> a -> Section a
create encode body_ =
  let bytes = BytePut.toByteString $ encode body_
   in Section
        { size = U32.fromWord32 . fromIntegral $ ByteString.length bytes,
          crc = U32.fromWord32 $ Crc.compute bytes,
          body = body_
        }

-- | Given a way to put the 'body', puts a section. This will also put
-- the size and CRC.
bytePut :: (a -> BytePut.BytePut) -> Section a -> BytePut.BytePut
bytePut putBody section =
  let rawBody = BytePut.toByteString . putBody $ body section
      size_ = ByteString.length rawBody
      crc_ = Crc.compute rawBody
   in U32.bytePut (U32.fromWord32 (fromIntegral size_))
        <> U32.bytePut (U32.fromWord32 crc_)
        <> BytePut.byteString rawBody

byteGet ::
  Bool -> (U32.U32 -> ByteGet.ByteGet a) -> ByteGet.ByteGet (Section a)
byteGet skip getBody = ByteGet.label "Section" $ do
  size <- ByteGet.label "size" U32.byteGet
  crc <- ByteGet.label "crc" U32.byteGet
  body <- ByteGet.label "body" $ do
    rawBody <- ByteGet.byteString . fromIntegral $ U32.toWord32 size
    Monad.unless skip $ do
      let expected = U32.toWord32 crc
          actual = Crc.compute rawBody
      Monad.when (actual /= expected) . ByteGet.throw $
        CrcMismatch.CrcMismatch
          expected
          actual
    ByteGet.embed (getBody size) rawBody
  pure Section {size, crc, body}

crcMessage :: U32.U32 -> U32.U32 -> String
crcMessage actual expected =
  unwords
    [ "[RT10] actual CRC",
      show actual,
      "does not match expected CRC",
      show expected
    ]