module Rattletrap.Type.RemoteId where

import qualified Rattletrap.BitGet as BitGet
import qualified Rattletrap.BitPut as BitPut
import qualified Rattletrap.Schema as Schema
import qualified Rattletrap.Type.Str as Str
import qualified Rattletrap.Type.U64 as U64
import qualified Rattletrap.Type.U8 as U8
import qualified Rattletrap.Type.Version as Version
import Rattletrap.Utility.Bytes
import qualified Rattletrap.Utility.Json as Json

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

data RemoteId
  = PlayStation Text.Text [Word.Word8]
  | PsyNet (Either U64.U64 (U64.U64, U64.U64, U64.U64, U64.U64))
  | Splitscreen Word.Word32
  -- ^ Really only 24 bits.
  | Steam U64.U64
  | Switch U64.U64 U64.U64 U64.U64 U64.U64
  | Xbox U64.U64
  | Epic Str.Str
  deriving (RemoteId -> RemoteId -> Bool
(RemoteId -> RemoteId -> Bool)
-> (RemoteId -> RemoteId -> Bool) -> Eq RemoteId
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RemoteId -> RemoteId -> Bool
$c/= :: RemoteId -> RemoteId -> Bool
== :: RemoteId -> RemoteId -> Bool
$c== :: RemoteId -> RemoteId -> Bool
Eq, Int -> RemoteId -> ShowS
[RemoteId] -> ShowS
RemoteId -> String
(Int -> RemoteId -> ShowS)
-> (RemoteId -> String) -> ([RemoteId] -> ShowS) -> Show RemoteId
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RemoteId] -> ShowS
$cshowList :: [RemoteId] -> ShowS
show :: RemoteId -> String
$cshow :: RemoteId -> String
showsPrec :: Int -> RemoteId -> ShowS
$cshowsPrec :: Int -> RemoteId -> ShowS
Show)

instance Json.FromJSON RemoteId where
  parseJSON :: Value -> Parser RemoteId
parseJSON = String -> (Object -> Parser RemoteId) -> Value -> Parser RemoteId
forall a. String -> (Object -> Parser a) -> Value -> Parser a
Json.withObject String
"RemoteId" ((Object -> Parser RemoteId) -> Value -> Parser RemoteId)
-> (Object -> Parser RemoteId) -> Value -> Parser RemoteId
forall a b. (a -> b) -> a -> b
$ \Object
object -> [Parser RemoteId] -> Parser RemoteId
forall (t :: * -> *) (f :: * -> *) a.
(Foldable t, Alternative f) =>
t (f a) -> f a
Foldable.asum
    [ (Text -> [Word8] -> RemoteId) -> (Text, [Word8]) -> RemoteId
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Text -> [Word8] -> RemoteId
PlayStation ((Text, [Word8]) -> RemoteId)
-> Parser (Text, [Word8]) -> Parser RemoteId
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object -> String -> Parser (Text, [Word8])
forall value. FromJSON value => Object -> String -> Parser value
Json.required Object
object String
"play_station"
    , Either U64 (U64, U64, U64, U64) -> RemoteId
PsyNet (Either U64 (U64, U64, U64, U64) -> RemoteId)
-> Parser (Either U64 (U64, U64, U64, U64)) -> Parser RemoteId
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object -> String -> Parser (Either U64 (U64, U64, U64, U64))
forall value. FromJSON value => Object -> String -> Parser value
Json.required Object
object String
"psy_net"
    , Word32 -> RemoteId
Splitscreen (Word32 -> RemoteId) -> Parser Word32 -> Parser RemoteId
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object -> String -> Parser Word32
forall value. FromJSON value => Object -> String -> Parser value
Json.required Object
object String
"splitscreen"
    , U64 -> RemoteId
Steam (U64 -> RemoteId) -> Parser U64 -> Parser RemoteId
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object -> String -> Parser U64
forall value. FromJSON value => Object -> String -> Parser value
Json.required Object
object String
"steam"
    , (U64 -> U64 -> U64 -> U64 -> RemoteId)
-> (U64, U64, U64, U64) -> RemoteId
forall a b c d e. (a -> b -> c -> d -> e) -> (a, b, c, d) -> e
uncurry4 U64 -> U64 -> U64 -> U64 -> RemoteId
Switch ((U64, U64, U64, U64) -> RemoteId)
-> Parser (U64, U64, U64, U64) -> Parser RemoteId
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object -> String -> Parser (U64, U64, U64, U64)
forall value. FromJSON value => Object -> String -> Parser value
Json.required Object
object String
"switch"
    , U64 -> RemoteId
Xbox (U64 -> RemoteId) -> Parser U64 -> Parser RemoteId
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object -> String -> Parser U64
forall value. FromJSON value => Object -> String -> Parser value
Json.required Object
object String
"xbox"
    , Str -> RemoteId
Epic (Str -> RemoteId) -> Parser Str -> Parser RemoteId
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object -> String -> Parser Str
forall value. FromJSON value => Object -> String -> Parser value
Json.required Object
object String
"epic"
    ]

uncurry4 :: (a -> b -> c -> d -> e) -> (a, b, c, d) -> e
uncurry4 :: (a -> b -> c -> d -> e) -> (a, b, c, d) -> e
uncurry4 a -> b -> c -> d -> e
f (a
a, b
b, c
c, d
d) = a -> b -> c -> d -> e
f a
a b
b c
c d
d

instance Json.ToJSON RemoteId where
  toJSON :: RemoteId -> Value
toJSON RemoteId
x = case RemoteId
x of
    PlayStation Text
y [Word8]
z -> [Pair] -> Value
Json.object [String -> (Text, [Word8]) -> Pair
forall value pair.
(ToJSON value, KeyValue pair) =>
String -> value -> pair
Json.pair String
"play_station" (Text
y, [Word8]
z)]
    PsyNet Either U64 (U64, U64, U64, U64)
y -> [Pair] -> Value
Json.object [String -> Either U64 (U64, U64, U64, U64) -> Pair
forall value pair.
(ToJSON value, KeyValue pair) =>
String -> value -> pair
Json.pair String
"psy_net" Either U64 (U64, U64, U64, U64)
y]
    Splitscreen Word32
y -> [Pair] -> Value
Json.object [String -> Word32 -> Pair
forall value pair.
(ToJSON value, KeyValue pair) =>
String -> value -> pair
Json.pair String
"splitscreen" Word32
y]
    Steam U64
y -> [Pair] -> Value
Json.object [String -> U64 -> Pair
forall value pair.
(ToJSON value, KeyValue pair) =>
String -> value -> pair
Json.pair String
"steam" U64
y]
    Switch U64
y U64
z U64
a U64
b -> [Pair] -> Value
Json.object [String -> (U64, U64, U64, U64) -> Pair
forall value pair.
(ToJSON value, KeyValue pair) =>
String -> value -> pair
Json.pair String
"switch" (U64
y, U64
z, U64
a, U64
b)]
    Xbox U64
y -> [Pair] -> Value
Json.object [String -> U64 -> Pair
forall value pair.
(ToJSON value, KeyValue pair) =>
String -> value -> pair
Json.pair String
"xbox" U64
y]
    Epic Str
y -> [Pair] -> Value
Json.object [String -> Str -> Pair
forall value pair.
(ToJSON value, KeyValue pair) =>
String -> value -> pair
Json.pair String
"epic" Str
y]

schema :: Schema.Schema
schema :: Schema
schema = String -> Value -> Schema
Schema.named String
"remote-id" (Value -> Schema) -> ([Value] -> Value) -> [Value] -> Schema
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Value] -> Value
Schema.oneOf ([Value] -> Schema) -> [Value] -> Schema
forall a b. (a -> b) -> a -> b
$ ((String, Value) -> Value) -> [(String, Value)] -> [Value]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap
  (\(String
k, Value
v) -> [(Pair, Bool)] -> Value
Schema.object [(String -> Value -> Pair
forall value pair.
(ToJSON value, KeyValue pair) =>
String -> value -> pair
Json.pair String
k Value
v, Bool
True)])
  [ ( String
"play_station"
    , [Value] -> Value
Schema.tuple
      [Schema -> Value
Schema.ref Schema
Schema.string, Schema -> Value
Schema.json (Schema -> Value) -> Schema -> Value
forall a b. (a -> b) -> a -> b
$ Schema -> Schema
Schema.array Schema
Schema.number]
    )
  , ( String
"psy_net"
    , [Value] -> Value
Schema.oneOf
      [ [(Pair, Bool)] -> Value
Schema.object [(String -> Value -> Pair
forall value pair.
(ToJSON value, KeyValue pair) =>
String -> value -> pair
Json.pair String
"Left" (Value -> Pair) -> Value -> Pair
forall a b. (a -> b) -> a -> b
$ Schema -> Value
Schema.ref Schema
U64.schema, Bool
True)]
      , [(Pair, Bool)] -> Value
Schema.object
        [ ( String -> Value -> Pair
forall value pair.
(ToJSON value, KeyValue pair) =>
String -> value -> pair
Json.pair String
"Right" (Value -> Pair) -> (Value -> Value) -> Value -> Pair
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Value] -> Value
Schema.tuple ([Value] -> Value) -> (Value -> [Value]) -> Value -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Value -> [Value]
forall a. Int -> a -> [a]
replicate Int
4 (Value -> Pair) -> Value -> Pair
forall a b. (a -> b) -> a -> b
$ Schema -> Value
Schema.ref
            Schema
U64.schema
          , Bool
True
          )
        ]
      ]
    )
  , (String
"splitscreen", Schema -> Value
Schema.ref Schema
Schema.integer)
  , (String
"steam", Schema -> Value
Schema.ref Schema
U64.schema)
  , (String
"switch", [Value] -> Value
Schema.tuple ([Value] -> Value) -> (Value -> [Value]) -> Value -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Value -> [Value]
forall a. Int -> a -> [a]
replicate Int
4 (Value -> Value) -> Value -> Value
forall a b. (a -> b) -> a -> b
$ Schema -> Value
Schema.ref Schema
U64.schema)
  , (String
"xbox", Schema -> Value
Schema.ref Schema
U64.schema)
  , (String
"epic", Schema -> Value
Schema.ref Schema
Str.schema)
  ]

bitPut :: RemoteId -> BitPut.BitPut
bitPut :: RemoteId -> BitPut
bitPut RemoteId
remoteId = case RemoteId
remoteId of
  PlayStation Text
name [Word8]
bytes ->
    let rawName :: ByteString
rawName = ByteString -> ByteString
reverseBytes (Int -> ByteString -> ByteString
forall a. Integral a => a -> ByteString -> ByteString
padBytes (Int
16 :: Int) (Text -> ByteString
encodeLatin1 Text
name))
    in ByteString -> BitPut
BitPut.byteString ByteString
rawName BitPut -> BitPut -> BitPut
forall a. Semigroup a => a -> a -> a
<> ByteString -> BitPut
BitPut.byteString ([Word8] -> ByteString
Bytes.pack [Word8]
bytes)
  PsyNet Either U64 (U64, U64, U64, U64)
e -> case Either U64 (U64, U64, U64, U64)
e of
    Left U64
l -> U64 -> BitPut
U64.bitPut U64
l
    Right (U64
a, U64
b, U64
c, U64
d) -> U64 -> U64 -> U64 -> U64 -> BitPut
putWord256 U64
a U64
b U64
c U64
d
  Splitscreen Word32
word24 -> Int -> Word32 -> BitPut
forall a. Bits a => Int -> a -> BitPut
BitPut.bits Int
24 Word32
word24
  Steam U64
word64 -> U64 -> BitPut
U64.bitPut U64
word64
  Switch U64
a U64
b U64
c U64
d -> U64 -> U64 -> U64 -> U64 -> BitPut
putWord256 U64
a U64
b U64
c U64
d
  Xbox U64
word64 -> U64 -> BitPut
U64.bitPut U64
word64
  Epic Str
str -> Str -> BitPut
Str.bitPut Str
str

putWord256 :: U64.U64 -> U64.U64 -> U64.U64 -> U64.U64 -> BitPut.BitPut
putWord256 :: U64 -> U64 -> U64 -> U64 -> BitPut
putWord256 U64
a U64
b U64
c U64
d =
  U64 -> BitPut
U64.bitPut U64
a BitPut -> BitPut -> BitPut
forall a. Semigroup a => a -> a -> a
<> U64 -> BitPut
U64.bitPut U64
b BitPut -> BitPut -> BitPut
forall a. Semigroup a => a -> a -> a
<> U64 -> BitPut
U64.bitPut U64
c BitPut -> BitPut -> BitPut
forall a. Semigroup a => a -> a -> a
<> U64 -> BitPut
U64.bitPut U64
d

bitGet :: Version.Version -> U8.U8 -> BitGet.BitGet RemoteId
bitGet :: Version -> U8 -> BitGet RemoteId
bitGet Version
version U8
systemId = case U8 -> Word8
U8.toWord8 U8
systemId of
  Word8
0 -> Word32 -> RemoteId
Splitscreen (Word32 -> RemoteId) -> BitGet Word32 -> BitGet RemoteId
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> BitGet Word32
forall a. Bits a => Int -> BitGet a
BitGet.bits Int
24
  Word8
1 -> U64 -> RemoteId
Steam (U64 -> RemoteId) -> BitGet U64 -> BitGet RemoteId
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BitGet U64
U64.bitGet
  Word8
2 -> Text -> [Word8] -> RemoteId
PlayStation (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] -> BitGet RemoteId
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Version -> BitGet [Word8]
decodePsBytes Version
version
  Word8
4 -> U64 -> RemoteId
Xbox (U64 -> RemoteId) -> BitGet U64 -> BitGet RemoteId
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BitGet U64
U64.bitGet
  Word8
6 -> do
    (U64
a, U64
b, U64
c, U64
d) <- BitGet (U64, U64, U64, U64)
getWord256
    RemoteId -> BitGet RemoteId
forall (f :: * -> *) a. Applicative f => a -> f a
pure (RemoteId -> BitGet RemoteId) -> RemoteId -> BitGet RemoteId
forall a b. (a -> b) -> a -> b
$ U64 -> U64 -> U64 -> U64 -> RemoteId
Switch U64
a U64
b U64
c U64
d
  Word8
7 -> if Version -> Bool
psyNetIsU64 Version
version
    then Either U64 (U64, U64, U64, U64) -> RemoteId
PsyNet (Either U64 (U64, U64, U64, U64) -> RemoteId)
-> (U64 -> Either U64 (U64, U64, U64, U64)) -> U64 -> RemoteId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. U64 -> Either U64 (U64, U64, U64, U64)
forall a b. a -> Either a b
Left (U64 -> RemoteId) -> BitGet U64 -> BitGet RemoteId
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BitGet U64
U64.bitGet
    else Either U64 (U64, U64, U64, U64) -> RemoteId
PsyNet (Either U64 (U64, U64, U64, U64) -> RemoteId)
-> ((U64, U64, U64, U64) -> Either U64 (U64, U64, U64, U64))
-> (U64, U64, U64, U64)
-> RemoteId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (U64, U64, U64, U64) -> Either U64 (U64, U64, U64, U64)
forall a b. b -> Either a b
Right ((U64, U64, U64, U64) -> RemoteId)
-> BitGet (U64, U64, U64, U64) -> BitGet RemoteId
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BitGet (U64, U64, U64, U64)
getWord256
  Word8
11 -> Str -> RemoteId
Epic (Str -> RemoteId) -> BitGet Str -> BitGet RemoteId
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BitGet Str
Str.bitGet
  Word8
_ -> String -> BitGet RemoteId
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String
"[RT09] unknown system id " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> U8 -> String
forall a. Show a => a -> String
show U8
systemId)

psyNetIsU64 :: Version.Version -> Bool
psyNetIsU64 :: Version -> Bool
psyNetIsU64 Version
v =
  Version -> Int
Version.major Version
v Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
868 Bool -> Bool -> Bool
&& Version -> Int
Version.minor Version
v Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
24 Bool -> Bool -> Bool
&& Version -> Int
Version.patch Version
v Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
10

decodePsName :: BitGet.BitGet 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
BitGet.byteString Int
16)

decodePsBytes :: Version.Version -> BitGet.BitGet [Word.Word8]
decodePsBytes :: Version -> BitGet [Word8]
decodePsBytes Version
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
BitGet.byteString (if Version -> Bool
playStationIsU24 Version
version then Int
24 else Int
16)

playStationIsU24 :: Version.Version -> Bool
playStationIsU24 :: Version -> Bool
playStationIsU24 Version
v =
  Version -> Int
Version.major Version
v Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
868 Bool -> Bool -> Bool
&& Version -> Int
Version.minor Version
v Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
20 Bool -> Bool -> Bool
&& Version -> Int
Version.patch Version
v Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
1

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