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
data Section a = Section
{ Section a -> U32
size :: U32.U32
, Section a -> U32
crc :: U32.U32
, Section a -> a
body :: a
}
deriving (Section a -> Section a -> Bool
(Section a -> Section a -> Bool)
-> (Section a -> Section a -> Bool) -> Eq (Section a)
forall a. Eq a => Section a -> Section a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Section a -> Section a -> Bool
$c/= :: forall a. Eq a => Section a -> Section a -> Bool
== :: Section a -> Section a -> Bool
$c== :: forall a. Eq a => Section a -> Section a -> Bool
Eq, Int -> Section a -> ShowS
[Section a] -> ShowS
Section a -> String
(Int -> Section a -> ShowS)
-> (Section a -> String)
-> ([Section a] -> ShowS)
-> Show (Section a)
forall a. Show a => Int -> Section a -> ShowS
forall a. Show a => [Section a] -> ShowS
forall a. Show a => Section a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Section a] -> ShowS
$cshowList :: forall a. Show a => [Section a] -> ShowS
show :: Section a -> String
$cshow :: forall a. Show a => Section a -> String
showsPrec :: Int -> Section a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> Section a -> ShowS
Show)
instance Json.FromJSON a => Json.FromJSON (Section a) where
parseJSON :: Value -> Parser (Section a)
parseJSON = String
-> (Object -> Parser (Section a)) -> Value -> Parser (Section a)
forall a. String -> (Object -> Parser a) -> Value -> Parser a
Json.withObject String
"Section" ((Object -> Parser (Section a)) -> Value -> Parser (Section a))
-> (Object -> Parser (Section a)) -> Value -> Parser (Section a)
forall a b. (a -> b) -> a -> b
$ \Object
object -> do
U32
size <- Object -> String -> Parser U32
forall value. FromJSON value => Object -> String -> Parser value
Json.required Object
object String
"size"
U32
crc <- Object -> String -> Parser U32
forall value. FromJSON value => Object -> String -> Parser value
Json.required Object
object String
"crc"
a
body <- Object -> String -> Parser a
forall value. FromJSON value => Object -> String -> Parser value
Json.required Object
object String
"body"
Section a -> Parser (Section a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Section :: forall a. U32 -> U32 -> a -> Section a
Section { U32
size :: U32
size :: U32
size, U32
crc :: U32
crc :: U32
crc, a
body :: a
body :: a
body }
instance Json.ToJSON a => Json.ToJSON (Section a) where
toJSON :: Section a -> Value
toJSON Section a
x = [Pair] -> Value
Json.object
[ String -> U32 -> Pair
forall value pair.
(ToJSON value, KeyValue pair) =>
String -> value -> pair
Json.pair String
"size" (U32 -> Pair) -> U32 -> Pair
forall a b. (a -> b) -> a -> b
$ Section a -> U32
forall a. Section a -> U32
size Section a
x
, String -> U32 -> Pair
forall value pair.
(ToJSON value, KeyValue pair) =>
String -> value -> pair
Json.pair String
"crc" (U32 -> Pair) -> U32 -> Pair
forall a b. (a -> b) -> a -> b
$ Section a -> U32
forall a. Section a -> U32
crc Section a
x
, String -> a -> Pair
forall value pair.
(ToJSON value, KeyValue pair) =>
String -> value -> pair
Json.pair String
"body" (a -> Pair) -> a -> Pair
forall a b. (a -> b) -> a -> b
$ Section a -> a
forall a. Section a -> a
body Section a
x
]
schema :: Schema.Schema -> Schema.Schema
schema :: Schema -> Schema
schema Schema
s =
String -> Value -> Schema
Schema.named (String
"section-" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Text -> String
Text.unpack (Schema -> Text
Schema.name Schema
s)) (Value -> Schema) -> Value -> Schema
forall a b. (a -> b) -> a -> b
$ [(Pair, Bool)] -> Value
Schema.object
[ (String -> Value -> Pair
forall value pair.
(ToJSON value, KeyValue pair) =>
String -> value -> pair
Json.pair String
"size" (Value -> Pair) -> Value -> Pair
forall a b. (a -> b) -> a -> b
$ Schema -> Value
Schema.ref Schema
U32.schema, Bool
True)
, (String -> Value -> Pair
forall value pair.
(ToJSON value, KeyValue pair) =>
String -> value -> pair
Json.pair String
"crc" (Value -> Pair) -> Value -> Pair
forall a b. (a -> b) -> a -> b
$ Schema -> Value
Schema.ref Schema
U32.schema, Bool
True)
, (String -> Value -> Pair
forall value pair.
(ToJSON value, KeyValue pair) =>
String -> value -> pair
Json.pair String
"body" (Value -> Pair) -> Value -> Pair
forall a b. (a -> b) -> a -> b
$ Schema -> Value
Schema.ref Schema
s, Bool
True)
]
create :: (a -> BytePut.BytePut) -> a -> Section a
create :: (a -> BytePut) -> a -> Section a
create a -> BytePut
encode a
body_ =
let bytes :: ByteString
bytes = BytePut -> ByteString
BytePut.toByteString (BytePut -> ByteString) -> BytePut -> ByteString
forall a b. (a -> b) -> a -> b
$ a -> BytePut
encode a
body_
in
Section :: forall a. U32 -> U32 -> a -> Section a
Section
{ size :: U32
size = Word32 -> U32
U32.fromWord32 (Word32 -> U32) -> (Int -> Word32) -> Int -> U32
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> U32) -> Int -> U32
forall a b. (a -> b) -> a -> b
$ ByteString -> Int
ByteString.length ByteString
bytes
, crc :: U32
crc = Word32 -> U32
U32.fromWord32 (Word32 -> U32) -> Word32 -> U32
forall a b. (a -> b) -> a -> b
$ ByteString -> Word32
Crc.compute ByteString
bytes
, body :: a
body = a
body_
}
bytePut :: (a -> BytePut.BytePut) -> Section a -> BytePut.BytePut
bytePut :: (a -> BytePut) -> Section a -> BytePut
bytePut a -> BytePut
putBody Section a
section =
let
rawBody :: ByteString
rawBody = BytePut -> ByteString
BytePut.toByteString (BytePut -> ByteString) -> (a -> BytePut) -> a -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> BytePut
putBody (a -> ByteString) -> a -> ByteString
forall a b. (a -> b) -> a -> b
$ Section a -> a
forall a. Section a -> a
body Section a
section
size_ :: Int
size_ = ByteString -> Int
ByteString.length ByteString
rawBody
crc_ :: Word32
crc_ = ByteString -> Word32
Crc.compute ByteString
rawBody
in
U32 -> BytePut
U32.bytePut (Word32 -> U32
U32.fromWord32 (Int -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
size_))
BytePut -> BytePut -> BytePut
forall a. Semigroup a => a -> a -> a
<> U32 -> BytePut
U32.bytePut (Word32 -> U32
U32.fromWord32 Word32
crc_)
BytePut -> BytePut -> BytePut
forall a. Semigroup a => a -> a -> a
<> ByteString -> BytePut
BytePut.byteString ByteString
rawBody
byteGet
:: Bool -> (U32.U32 -> ByteGet.ByteGet a) -> ByteGet.ByteGet (Section a)
byteGet :: Bool -> (U32 -> ByteGet a) -> ByteGet (Section a)
byteGet Bool
skip U32 -> ByteGet a
getBody = String -> ByteGet (Section a) -> ByteGet (Section a)
forall a. String -> ByteGet a -> ByteGet a
ByteGet.label String
"Section" (ByteGet (Section a) -> ByteGet (Section a))
-> ByteGet (Section a) -> ByteGet (Section a)
forall a b. (a -> b) -> a -> b
$ do
U32
size <- String -> ByteGet U32 -> ByteGet U32
forall a. String -> ByteGet a -> ByteGet a
ByteGet.label String
"size" ByteGet U32
U32.byteGet
U32
crc <- String -> ByteGet U32 -> ByteGet U32
forall a. String -> ByteGet a -> ByteGet a
ByteGet.label String
"crc" ByteGet U32
U32.byteGet
a
body <- String -> ByteGet a -> ByteGet a
forall a. String -> ByteGet a -> ByteGet a
ByteGet.label String
"body" (ByteGet a -> ByteGet a) -> ByteGet a -> ByteGet a
forall a b. (a -> b) -> a -> b
$ do
ByteString
rawBody <- Int -> ByteGet ByteString
ByteGet.byteString (Int -> ByteGet ByteString)
-> (Word32 -> Int) -> Word32 -> ByteGet ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32 -> ByteGet ByteString) -> Word32 -> ByteGet ByteString
forall a b. (a -> b) -> a -> b
$ U32 -> Word32
U32.toWord32 U32
size
Bool -> Get ByteString Identity () -> Get ByteString Identity ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
Monad.unless Bool
skip (Get ByteString Identity () -> Get ByteString Identity ())
-> Get ByteString Identity () -> Get ByteString Identity ()
forall a b. (a -> b) -> a -> b
$ do
let
expected :: Word32
expected = U32 -> Word32
U32.toWord32 U32
crc
actual :: Word32
actual = ByteString -> Word32
Crc.compute ByteString
rawBody
Bool -> Get ByteString Identity () -> Get ByteString Identity ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
Monad.when (Word32
actual Word32 -> Word32 -> Bool
forall a. Eq a => a -> a -> Bool
/= Word32
expected) (Get ByteString Identity () -> Get ByteString Identity ())
-> (CrcMismatch -> Get ByteString Identity ())
-> CrcMismatch
-> Get ByteString Identity ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CrcMismatch -> Get ByteString Identity ()
forall e a. Exception e => e -> ByteGet a
ByteGet.throw (CrcMismatch -> Get ByteString Identity ())
-> CrcMismatch -> Get ByteString Identity ()
forall a b. (a -> b) -> a -> b
$ Word32 -> Word32 -> CrcMismatch
CrcMismatch.CrcMismatch
Word32
expected
Word32
actual
ByteGet a -> ByteString -> ByteGet a
forall a. ByteGet a -> ByteString -> ByteGet a
ByteGet.embed (U32 -> ByteGet a
getBody U32
size) ByteString
rawBody
Section a -> ByteGet (Section a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Section :: forall a. U32 -> U32 -> a -> Section a
Section { U32
size :: U32
size :: U32
size, U32
crc :: U32
crc :: U32
crc, a
body :: a
body :: a
body }
crcMessage :: U32.U32 -> U32.U32 -> String
crcMessage :: U32 -> U32 -> String
crcMessage U32
actual U32
expected = [String] -> String
unwords
[ String
"[RT10] actual CRC"
, U32 -> String
forall a. Show a => a -> String
show U32
actual
, String
"does not match expected CRC"
, U32 -> String
forall a. Show a => a -> String
show U32
expected
]