module Rattletrap.Decode.RemoteId
  ( decodeRemoteIdBits
  )
where

import Rattletrap.Decode.Common
import Rattletrap.Decode.Str
import Rattletrap.Decode.Word64le
import Rattletrap.Type.RemoteId
import Rattletrap.Type.Word64le
import Rattletrap.Type.Word8le
import Rattletrap.Utility.Bytes

import qualified Data.ByteString as Bytes
import qualified Data.Text as Text
import qualified Data.Text.Encoding as Text
import qualified Data.Word as Word

decodeRemoteIdBits :: (Int, Int, Int) -> Word8le -> DecodeBits RemoteId
decodeRemoteIdBits :: (Int, Int, Int) -> Word8le -> DecodeBits RemoteId
decodeRemoteIdBits (Int, Int, Int)
version Word8le
systemId = case Word8le -> Word8
word8leValue Word8le
systemId of
  Word8
0 -> Word32 -> RemoteId
RemoteIdSplitscreen (Word32 -> RemoteId) -> BitGet Word32 -> DecodeBits RemoteId
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> BitGet Word32
forall a. Bits a => Int -> BitGet a
getBitsLE Int
24
  Word8
1 -> Word64le -> RemoteId
RemoteIdSteam (Word64le -> RemoteId) -> BitGet Word64le -> DecodeBits RemoteId
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BitGet Word64le
decodeWord64leBits
  Word8
2 -> Text -> [Word8] -> RemoteId
RemoteIdPlayStation (Text -> [Word8] -> RemoteId)
-> BitGet Text -> BitGet ([Word8] -> RemoteId)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BitGet Text
decodePsName BitGet ([Word8] -> RemoteId)
-> BitGet [Word8] -> DecodeBits RemoteId
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Int, Int, Int) -> BitGet [Word8]
decodePsBytes (Int, Int, Int)
version
  Word8
4 -> Word64le -> RemoteId
RemoteIdXbox (Word64le -> RemoteId) -> BitGet Word64le -> DecodeBits RemoteId
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BitGet Word64le
decodeWord64leBits
  Word8
6 -> do
    (Word64le
a, Word64le
b, Word64le
c, Word64le
d) <- DecodeBits (Word64le, Word64le, Word64le, Word64le)
getWord256
    RemoteId -> DecodeBits RemoteId
forall (f :: * -> *) a. Applicative f => a -> f a
pure (RemoteId -> DecodeBits RemoteId)
-> RemoteId -> DecodeBits RemoteId
forall a b. (a -> b) -> a -> b
$ Word64le -> Word64le -> Word64le -> Word64le -> RemoteId
RemoteIdSwitch Word64le
a Word64le
b Word64le
c Word64le
d
  Word8
7 -> if (Int, Int, Int)
version (Int, Int, Int) -> (Int, Int, Int) -> Bool
forall a. Ord a => a -> a -> Bool
>= (Int
868, Int
24, Int
10)
    then Either Word64le (Word64le, Word64le, Word64le, Word64le)
-> RemoteId
RemoteIdPsyNet (Either Word64le (Word64le, Word64le, Word64le, Word64le)
 -> RemoteId)
-> (Word64le
    -> Either Word64le (Word64le, Word64le, Word64le, Word64le))
-> Word64le
-> RemoteId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word64le
-> Either Word64le (Word64le, Word64le, Word64le, Word64le)
forall a b. a -> Either a b
Left (Word64le -> RemoteId) -> BitGet Word64le -> DecodeBits RemoteId
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BitGet Word64le
decodeWord64leBits
    else Either Word64le (Word64le, Word64le, Word64le, Word64le)
-> RemoteId
RemoteIdPsyNet (Either Word64le (Word64le, Word64le, Word64le, Word64le)
 -> RemoteId)
-> ((Word64le, Word64le, Word64le, Word64le)
    -> Either Word64le (Word64le, Word64le, Word64le, Word64le))
-> (Word64le, Word64le, Word64le, Word64le)
-> RemoteId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Word64le, Word64le, Word64le, Word64le)
-> Either Word64le (Word64le, Word64le, Word64le, Word64le)
forall a b. b -> Either a b
Right ((Word64le, Word64le, Word64le, Word64le) -> RemoteId)
-> DecodeBits (Word64le, Word64le, Word64le, Word64le)
-> DecodeBits RemoteId
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> DecodeBits (Word64le, Word64le, Word64le, Word64le)
getWord256
  Word8
11 -> Str -> RemoteId
RemoteIdEpic (Str -> RemoteId) -> BitGet Str -> DecodeBits RemoteId
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BitGet Str
decodeStrBits
  Word8
_ -> String -> DecodeBits RemoteId
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String
"[RT09] unknown system id " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Word8le -> String
forall a. Show a => a -> String
show Word8le
systemId)

decodePsName :: DecodeBits Text.Text
decodePsName :: BitGet Text
decodePsName = (ByteString -> Text) -> BitGet ByteString -> BitGet Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap
  ((Char -> Bool) -> Text -> Text
Text.dropWhileEnd (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\x00') (Text -> Text) -> (ByteString -> Text) -> ByteString -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Text
Text.decodeLatin1 (ByteString -> Text)
-> (ByteString -> ByteString) -> ByteString -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
reverseBytes)
  (Int -> BitGet ByteString
getByteStringBits Int
16)

decodePsBytes :: (Int, Int, Int) -> DecodeBits [Word.Word8]
decodePsBytes :: (Int, Int, Int) -> BitGet [Word8]
decodePsBytes (Int, Int, Int)
version = ByteString -> [Word8]
Bytes.unpack
  (ByteString -> [Word8]) -> BitGet ByteString -> BitGet [Word8]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> BitGet ByteString
getByteStringBits (if (Int, Int, Int)
version (Int, Int, Int) -> (Int, Int, Int) -> Bool
forall a. Ord a => a -> a -> Bool
>= (Int
868, Int
20, Int
1) then Int
24 else Int
16)

getWord256 :: DecodeBits (Word64le, Word64le, Word64le, Word64le)
getWord256 :: DecodeBits (Word64le, Word64le, Word64le, Word64le)
getWord256 = do
  Word64le
a <- BitGet Word64le
decodeWord64leBits
  Word64le
b <- BitGet Word64le
decodeWord64leBits
  Word64le
c <- BitGet Word64le
decodeWord64leBits
  Word64le
d <- BitGet Word64le
decodeWord64leBits
  (Word64le, Word64le, Word64le, Word64le)
-> DecodeBits (Word64le, Word64le, Word64le, Word64le)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Word64le
a, Word64le
b, Word64le
c, Word64le
d)