{-# LANGUAGE BangPatterns        #-}
{-# LANGUAGE GADTs               #-}
{-# LANGUAGE ScopedTypeVariables #-}
-- |
-- Module      :  Pinch.Protocol.Binary
-- Copyright   :  (c) Abhinav Gupta 2015
-- License     :  BSD3
--
-- Maintainer  :  Abhinav Gupta <mail@abhinavg.net>
-- Stability   :  experimental
--
-- Implements the Thrift Binary Protocol as a 'Protocol'.
module Pinch.Protocol.Binary (binaryProtocol) where


import Control.Monad
import Data.Bits           (shiftR, (.&.))
import Data.ByteString     (ByteString)
import Data.HashMap.Strict (HashMap)
import Data.Int            (Int16, Int32, Int8)

import qualified Data.ByteString        as B
import qualified Data.HashMap.Strict    as M
import qualified Data.Serialize.Get     as G
import qualified Data.Serialize.IEEE754 as G
import qualified Data.Text.Encoding     as TE

import Pinch.Internal.Builder (Builder)
import Pinch.Internal.Message
import Pinch.Internal.TType
import Pinch.Internal.Value
import Pinch.Protocol         (Protocol (..))

import qualified Pinch.Internal.Builder  as BB
import qualified Pinch.Internal.FoldList as FL


-- | Provides an implementation of the Thrift Binary Protocol.
binaryProtocol :: Protocol
binaryProtocol :: Protocol
binaryProtocol = Protocol
    { serializeValue :: forall a. IsTType a => Value a -> Builder
serializeValue     = forall a. IsTType a => Value a -> Builder
binarySerialize
    , deserializeValue' :: forall a. IsTType a => Get (Value a)
deserializeValue'  = forall a. TType a -> Get (Value a)
binaryDeserialize forall a. IsTType a => TType a
ttype
    , serializeMessage :: Message -> Builder
serializeMessage   = Message -> Builder
binarySerializeMessage
    , deserializeMessage' :: Get Message
deserializeMessage' = Get Message
binaryDeserializeMessage
    }

------------------------------------------------------------------------------

binarySerializeMessage :: Message -> Builder
binarySerializeMessage :: Message -> Builder
binarySerializeMessage Message
msg =
    Word8 -> Builder
BB.word8 Word8
0x80 forall a. Semigroup a => a -> a -> a
<>
    Word8 -> Builder
BB.word8 Word8
0x01 forall a. Semigroup a => a -> a -> a
<>
    Word8 -> Builder
BB.word8 Word8
0x00 forall a. Semigroup a => a -> a -> a
<>
    Int8 -> Builder
BB.int8 (MessageType -> Int8
messageCode forall a b. (a -> b) -> a -> b
$ Message -> MessageType
messageType Message
msg) forall a. Semigroup a => a -> a -> a
<>
    ByteString -> Builder
string (Text -> ByteString
TE.encodeUtf8 forall a b. (a -> b) -> a -> b
$ Message -> Text
messageName Message
msg) forall a. Semigroup a => a -> a -> a
<>
    Int32 -> Builder
BB.int32BE (Message -> Int32
messageId Message
msg) forall a. Semigroup a => a -> a -> a
<>
    forall a. IsTType a => Value a -> Builder
binarySerialize (Message -> Value TStruct
messagePayload Message
msg)

binaryDeserializeMessage :: G.Get Message
binaryDeserializeMessage :: Get Message
binaryDeserializeMessage = do
    Int32
size <- Get Int32
G.getInt32be
    if Int32
size forall a. Ord a => a -> a -> Bool
< Int32
0
        then forall {a}. (Integral a, Bits a, Show a) => a -> Get Message
parseStrict Int32
size
        else forall {a}. Integral a => a -> Get Message
parseNonStrict Int32
size
  where
    -- versionAndType:4 name~4 seqid:4 payload
    -- versionAndType = version:2 0x00 type:1
    parseStrict :: a -> Get Message
parseStrict a
versionAndType = do
        forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (a
version forall a. Eq a => a -> a -> Bool
== a
1) forall a b. (a -> b) -> a -> b
$
            forall (m :: * -> *) a. MonadFail m => String -> m a
fail forall a b. (a -> b) -> a -> b
$ String
"Unsupported version: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show a
version
        Text -> MessageType -> Int32 -> Value TStruct -> Message
Message
            forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ByteString -> Text
TE.decodeUtf8 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Get Int32
G.getInt32be forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Int -> Get ByteString
G.getBytes forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Integral a, Num b) => a -> b
fromIntegral)
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get MessageType
typ
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get Int32
G.getInt32be
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. TType a -> Get (Value a)
binaryDeserialize forall a. IsTType a => TType a
ttype
      where
        version :: a
version = (a
0x7fff0000 forall a. Bits a => a -> a -> a
.&. a
versionAndType) forall a. Bits a => a -> Int -> a
`shiftR` Int
16

        code :: Int8
code = forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ a
0x00ff forall a. Bits a => a -> a -> a
.&. a
versionAndType
        typ :: Get MessageType
typ = case Int8 -> Maybe MessageType
fromMessageCode Int8
code of
            Maybe MessageType
Nothing -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail forall a b. (a -> b) -> a -> b
$ String
"Unknown message type: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Int8
code
            Just MessageType
t -> forall (m :: * -> *) a. Monad m => a -> m a
return MessageType
t

    -- name~4 type:1 seqid:4 payload
    parseNonStrict :: a -> Get Message
parseNonStrict a
nameLength =
        Text -> MessageType -> Int32 -> Value TStruct -> Message
Message
            forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ByteString -> Text
TE.decodeUtf8 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Get ByteString
G.getBytes (forall a b. (Integral a, Num b) => a -> b
fromIntegral a
nameLength)
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get MessageType
parseMessageType
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get Int32
G.getInt32be
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. TType a -> Get (Value a)
binaryDeserialize forall a. IsTType a => TType a
ttype


parseMessageType :: G.Get MessageType
parseMessageType :: Get MessageType
parseMessageType = Get Int8
G.getInt8 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Int8
code -> case Int8 -> Maybe MessageType
fromMessageCode Int8
code of
    Maybe MessageType
Nothing -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail forall a b. (a -> b) -> a -> b
$ String
"Unknown message type: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Int8
code
    Just MessageType
t -> forall (m :: * -> *) a. Monad m => a -> m a
return MessageType
t

------------------------------------------------------------------------------

binaryDeserialize :: TType a -> G.Get (Value a)
binaryDeserialize :: forall a. TType a -> Get (Value a)
binaryDeserialize TType a
typ = case TType a
typ of
  TType a
TBool   -> Get (Value TBool)
parseBool
  TType a
TByte   -> Get (Value TByte)
parseByte
  TType a
TDouble -> Get (Value TDouble)
parseDouble
  TType a
TInt16  -> Get (Value TInt16)
parseInt16
  TType a
TInt32  -> Get (Value TInt32)
parseInt32
  TType a
TInt64  -> Get (Value TInt64)
parseInt64
  TType a
TBinary -> Get (Value TBinary)
parseBinary
  TType a
TStruct -> Get (Value TStruct)
parseStruct
  TType a
TMap    -> Get (Value TMap)
parseMap
  TType a
TSet    -> Get (Value TSet)
parseSet
  TType a
TList   -> Get (Value TList)
parseList

getTType :: Int8 -> G.Get SomeTType
getTType :: Int8 -> Get SomeTType
getTType Int8
code =
    forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall (m :: * -> *) a. MonadFail m => String -> m a
fail forall a b. (a -> b) -> a -> b
$ String
"Unknown TType: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Int8
code) forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Int8 -> Maybe SomeTType
fromTypeCode Int8
code

parseTType :: G.Get SomeTType
parseTType :: Get SomeTType
parseTType = Get Int8
G.getInt8 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Int8 -> Get SomeTType
getTType

parseBool :: G.Get (Value TBool)
parseBool :: Get (Value TBool)
parseBool = Bool -> Value TBool
VBool forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. Eq a => a -> a -> Bool
== Int8
1) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Int8
G.getInt8

parseByte :: G.Get (Value TByte)
parseByte :: Get (Value TByte)
parseByte = Int8 -> Value TByte
VByte forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Int8
G.getInt8

parseDouble :: G.Get (Value TDouble)
parseDouble :: Get (Value TDouble)
parseDouble = Double -> Value TDouble
VDouble forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Double
G.getFloat64be

parseInt16 :: G.Get (Value TInt16)
parseInt16 :: Get (Value TInt16)
parseInt16 = Int16 -> Value TInt16
VInt16 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Int16
G.getInt16be

parseInt32 :: G.Get (Value TInt32)
parseInt32 :: Get (Value TInt32)
parseInt32 = Int32 -> Value TInt32
VInt32 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Int32
G.getInt32be

parseInt64 :: G.Get (Value TInt64)
parseInt64 :: Get (Value TInt64)
parseInt64 = Int64 -> Value TInt64
VInt64 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Int64
G.getInt64be

parseBinary :: G.Get (Value TBinary)
parseBinary :: Get (Value TBinary)
parseBinary = ByteString -> Value TBinary
VBinary forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Get Int32
G.getInt32be forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Int -> Get ByteString
G.getBytes forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Integral a, Num b) => a -> b
fromIntegral)


parseMap :: G.Get (Value TMap)
parseMap :: Get (Value TMap)
parseMap = do
    SomeTType
ktype' <- Get SomeTType
parseTType
    SomeTType
vtype' <- Get SomeTType
parseTType
    Int32
count <- Get Int32
G.getInt32be

    case (SomeTType
ktype', SomeTType
vtype') of
      (SomeTType TType a
ktype, SomeTType TType a
vtype) -> do
        FoldList (MapItem a a)
items <- forall (m :: * -> *) a. Monad m => Int -> m a -> m (FoldList a)
FL.replicateM (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int32
count) forall a b. (a -> b) -> a -> b
$
            forall k v. Value k -> Value v -> MapItem k v
MapItem forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. TType a -> Get (Value a)
binaryDeserialize TType a
ktype
                    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. TType a -> Get (Value a)
binaryDeserialize TType a
vtype
        forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a v.
(IsTType a, IsTType v) =>
FoldList (MapItem a v) -> Value TMap
VMap FoldList (MapItem a a)
items


parseSet :: G.Get (Value TSet)
parseSet :: Get (Value TSet)
parseSet = do
    SomeTType
vtype' <- Get SomeTType
parseTType
    Int32
count <- Get Int32
G.getInt32be

    case SomeTType
vtype' of
      SomeTType TType a
vtype ->
          forall a. IsTType a => FoldList (Value a) -> Value TSet
VSet forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) a. Monad m => Int -> m a -> m (FoldList a)
FL.replicateM (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int32
count) (forall a. TType a -> Get (Value a)
binaryDeserialize TType a
vtype)


parseList :: G.Get (Value TList)
parseList :: Get (Value TList)
parseList = do
    SomeTType
vtype' <- Get SomeTType
parseTType
    Int32
count <- Get Int32
G.getInt32be

    case SomeTType
vtype' of
      SomeTType TType a
vtype ->
        forall a. IsTType a => FoldList (Value a) -> Value TList
VList forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) a. Monad m => Int -> m a -> m (FoldList a)
FL.replicateM (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int32
count) (forall a. TType a -> Get (Value a)
binaryDeserialize TType a
vtype)


parseStruct :: G.Get (Value TStruct)
parseStruct :: Get (Value TStruct)
parseStruct = Get Int8
G.getInt8 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= HashMap Int16 SomeValue -> Int8 -> Get (Value TStruct)
loop forall k v. HashMap k v
M.empty
  where
    loop :: HashMap Int16 SomeValue -> Int8 -> G.Get (Value TStruct)
    loop :: HashMap Int16 SomeValue -> Int8 -> Get (Value TStruct)
loop HashMap Int16 SomeValue
fields    Int8
0 = forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ HashMap Int16 SomeValue -> Value TStruct
VStruct HashMap Int16 SomeValue
fields
    loop HashMap Int16 SomeValue
fields Int8
code = do
        SomeTType
vtype' <- Int8 -> Get SomeTType
getTType Int8
code
        Int16
fieldId <- Get Int16
G.getInt16be
        case SomeTType
vtype' of
          SomeTType TType a
vtype -> do
            SomeValue
value <- forall a. IsTType a => Value a -> SomeValue
SomeValue forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. TType a -> Get (Value a)
binaryDeserialize TType a
vtype
            HashMap Int16 SomeValue -> Int8 -> Get (Value TStruct)
loop (forall k v.
(Eq k, Hashable k) =>
k -> v -> HashMap k v -> HashMap k v
M.insert Int16
fieldId SomeValue
value HashMap Int16 SomeValue
fields) forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Get Int8
G.getInt8


------------------------------------------------------------------------------

binarySerialize :: forall a. IsTType a => Value a -> Builder
binarySerialize :: forall a. IsTType a => Value a -> Builder
binarySerialize = case (forall a. IsTType a => TType a
ttype :: TType a) of
  TType a
TBinary  -> Value TBinary -> Builder
serializeBinary
  TType a
TBool    -> Value TBool -> Builder
serializeBool
  TType a
TByte    -> Value TByte -> Builder
serializeByte
  TType a
TDouble  -> Value TDouble -> Builder
serializeDouble
  TType a
TInt16   -> Value TInt16 -> Builder
serializeInt16
  TType a
TInt32   -> Value TInt32 -> Builder
serializeInt32
  TType a
TInt64   -> Value TInt64 -> Builder
serializeInt64
  TType a
TStruct  -> Value TStruct -> Builder
serializeStruct
  TType a
TList    -> Value TList -> Builder
serializeList
  TType a
TMap     -> Value TMap -> Builder
serializeMap
  TType a
TSet     -> Value TSet -> Builder
serializeSet
{-# INLINE binarySerialize #-}

serializeBinary :: Value TBinary -> Builder
serializeBinary :: Value TBinary -> Builder
serializeBinary (VBinary ByteString
x) = ByteString -> Builder
string ByteString
x
{-# INLINE serializeBinary #-}

serializeBool :: Value TBool -> Builder
serializeBool :: Value TBool -> Builder
serializeBool (VBool Bool
x) = Int8 -> Builder
BB.int8 forall a b. (a -> b) -> a -> b
$ if Bool
x then Int8
1 else Int8
0
{-# INLINE serializeBool #-}

serializeByte :: Value TByte -> Builder
serializeByte :: Value TByte -> Builder
serializeByte (VByte Int8
x) = Int8 -> Builder
BB.int8 Int8
x
{-# INLINE serializeByte #-}

serializeDouble :: Value TDouble -> Builder
serializeDouble :: Value TDouble -> Builder
serializeDouble (VDouble Double
x) = Double -> Builder
BB.doubleBE Double
x
{-# INLINE serializeDouble #-}

serializeInt16 :: Value TInt16 -> Builder
serializeInt16 :: Value TInt16 -> Builder
serializeInt16 (VInt16 Int16
x) = Int16 -> Builder
BB.int16BE Int16
x
{-# INLINE serializeInt16 #-}

serializeInt32 :: Value TInt32 -> Builder
serializeInt32 :: Value TInt32 -> Builder
serializeInt32 (VInt32 Int32
x) = Int32 -> Builder
BB.int32BE Int32
x
{-# INLINE serializeInt32 #-}

serializeInt64 :: Value TInt64 -> Builder
serializeInt64 :: Value TInt64 -> Builder
serializeInt64 (VInt64 Int64
x) = Int64 -> Builder
BB.int64BE Int64
x
{-# INLINE serializeInt64 #-}

serializeList :: Value TList -> Builder
serializeList :: Value TList -> Builder
serializeList (VList FoldList (Value a)
xs) = forall a. IsTType a => TType a -> FoldList (Value a) -> Builder
serializeCollection forall a. IsTType a => TType a
ttype FoldList (Value a)
xs
{-# INLINE serializeList #-}

serializeSet :: Value TSet -> Builder
serializeSet :: Value TSet -> Builder
serializeSet (VSet FoldList (Value a)
xs) = forall a. IsTType a => TType a -> FoldList (Value a) -> Builder
serializeCollection forall a. IsTType a => TType a
ttype FoldList (Value a)
xs
{-# INLINE serializeSet #-}

serializeStruct :: Value TStruct -> Builder
serializeStruct :: Value TStruct -> Builder
serializeStruct (VStruct HashMap Int16 SomeValue
fields) =
    forall a k v. (a -> k -> v -> a) -> a -> HashMap k v -> a
M.foldlWithKey'
        (\Builder
rest Int16
fid (SomeValue Value a
val) -> Builder
rest forall a. Semigroup a => a -> a -> a
<> forall a. IsTType a => Int16 -> TType a -> Value a -> Builder
writeField Int16
fid forall a. IsTType a => TType a
ttype Value a
val)
        forall a. Monoid a => a
mempty HashMap Int16 SomeValue
fields
    forall a. Semigroup a => a -> a -> a
<> Int8 -> Builder
BB.int8 Int8
0
  where
    writeField :: IsTType a => Int16 -> TType a -> Value a -> Builder
    writeField :: forall a. IsTType a => Int16 -> TType a -> Value a -> Builder
writeField Int16
fieldId TType a
fieldType Value a
fieldValue =
        forall a. TType a -> Builder
typeCode TType a
fieldType forall a. Semigroup a => a -> a -> a
<> Int16 -> Builder
BB.int16BE Int16
fieldId forall a. Semigroup a => a -> a -> a
<> forall a. IsTType a => Value a -> Builder
binarySerialize Value a
fieldValue
    {-# INLINE writeField #-}
{-# INLINE serializeStruct #-}

serializeMap :: Value TMap -> Builder
serializeMap :: Value TMap -> Builder
serializeMap Value TMap
VNullMap = forall a. HasCallStack => String -> a
error String
"serializeMap: VNullMap"
serializeMap (VMap FoldList (MapItem k v)
items) = forall k v.
(IsTType k, IsTType v) =>
TType k -> TType v -> FoldList (MapItem k v) -> Builder
serialize forall a. IsTType a => TType a
ttype forall a. IsTType a => TType a
ttype FoldList (MapItem k v)
items
  where
    serialize
        :: (IsTType k, IsTType v)
        => TType k -> TType v -> FL.FoldList (MapItem k v) -> Builder
    serialize :: forall k v.
(IsTType k, IsTType v) =>
TType k -> TType v -> FoldList (MapItem k v) -> Builder
serialize TType k
kt TType v
vt FoldList (MapItem k v)
xs =
        forall a. TType a -> Builder
typeCode TType k
kt forall a. Semigroup a => a -> a -> a
<> forall a. TType a -> Builder
typeCode TType v
vt forall a. Semigroup a => a -> a -> a
<> Int32 -> Builder
BB.int32BE Int32
size forall a. Semigroup a => a -> a -> a
<> Builder
body
      where
        (Builder
body, Int32
size) = forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
FL.foldl' forall {a} {a} {b}.
(IsTType a, IsTType a, Num b) =>
(Builder, b) -> MapItem a a -> (Builder, b)
go (forall a. Monoid a => a
mempty, Int32
0 :: Int32) FoldList (MapItem k v)
xs
        go :: (Builder, b) -> MapItem a a -> (Builder, b)
go (Builder
prev, !b
c) (MapItem Value a
k Value a
v) =
            ( Builder
prev forall a. Semigroup a => a -> a -> a
<> forall a. IsTType a => Value a -> Builder
binarySerialize Value a
k forall a. Semigroup a => a -> a -> a
<> forall a. IsTType a => Value a -> Builder
binarySerialize Value a
v
            , b
c forall a. Num a => a -> a -> a
+ b
1
            )
{-# INLINE serializeMap #-}

serializeCollection
    :: IsTType a
    => TType a -> FL.FoldList (Value a) -> Builder
serializeCollection :: forall a. IsTType a => TType a -> FoldList (Value a) -> Builder
serializeCollection TType a
vtype FoldList (Value a)
xs =
    let go :: (Builder, b) -> Value a -> (Builder, b)
go (Builder
prev, !b
c) Value a
item = (Builder
prev forall a. Semigroup a => a -> a -> a
<> forall a. IsTType a => Value a -> Builder
binarySerialize Value a
item, b
c forall a. Num a => a -> a -> a
+ b
1)
        (Builder
body, Int32
size) = forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
FL.foldl' forall {a} {b}.
(IsTType a, Num b) =>
(Builder, b) -> Value a -> (Builder, b)
go (forall a. Monoid a => a
mempty, Int32
0 :: Int32) FoldList (Value a)
xs
    in forall a. TType a -> Builder
typeCode TType a
vtype forall a. Semigroup a => a -> a -> a
<> Int32 -> Builder
BB.int32BE Int32
size forall a. Semigroup a => a -> a -> a
<> Builder
body
{-# INLINE serializeCollection #-}

------------------------------------------------------------------------------


messageCode :: MessageType -> Int8
messageCode :: MessageType -> Int8
messageCode MessageType
Call      = Int8
1
messageCode MessageType
Reply     = Int8
2
messageCode MessageType
Exception = Int8
3
messageCode MessageType
Oneway    = Int8
4
{-# INLINE messageCode #-}


fromMessageCode :: Int8 -> Maybe MessageType
fromMessageCode :: Int8 -> Maybe MessageType
fromMessageCode Int8
1 = forall a. a -> Maybe a
Just MessageType
Call
fromMessageCode Int8
2 = forall a. a -> Maybe a
Just MessageType
Reply
fromMessageCode Int8
3 = forall a. a -> Maybe a
Just MessageType
Exception
fromMessageCode Int8
4 = forall a. a -> Maybe a
Just MessageType
Oneway
fromMessageCode Int8
_ = forall a. Maybe a
Nothing
{-# INLINE fromMessageCode #-}


-- | Map a TType to its type code.
toTypeCode :: TType a -> Int8
toTypeCode :: forall a. TType a -> Int8
toTypeCode TType a
TBool   = Int8
2
toTypeCode TType a
TByte   = Int8
3
toTypeCode TType a
TDouble = Int8
4
toTypeCode TType a
TInt16  = Int8
6
toTypeCode TType a
TInt32  = Int8
8
toTypeCode TType a
TInt64  = Int8
10
toTypeCode TType a
TBinary = Int8
11
toTypeCode TType a
TStruct = Int8
12
toTypeCode TType a
TMap    = Int8
13
toTypeCode TType a
TSet    = Int8
14
toTypeCode TType a
TList   = Int8
15
{-# INLINE toTypeCode #-}


-- | Map a type code to the corresponding TType.
fromTypeCode :: Int8 -> Maybe SomeTType
fromTypeCode :: Int8 -> Maybe SomeTType
fromTypeCode Int8
2  = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a. IsTType a => TType a -> SomeTType
SomeTType TType TBool
TBool
fromTypeCode Int8
3  = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a. IsTType a => TType a -> SomeTType
SomeTType TType TByte
TByte
fromTypeCode Int8
4  = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a. IsTType a => TType a -> SomeTType
SomeTType TType TDouble
TDouble
fromTypeCode Int8
6  = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a. IsTType a => TType a -> SomeTType
SomeTType TType TInt16
TInt16
fromTypeCode Int8
8  = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a. IsTType a => TType a -> SomeTType
SomeTType TType TInt32
TInt32
fromTypeCode Int8
10 = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a. IsTType a => TType a -> SomeTType
SomeTType TType TInt64
TInt64
fromTypeCode Int8
11 = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a. IsTType a => TType a -> SomeTType
SomeTType TType TBinary
TBinary
fromTypeCode Int8
12 = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a. IsTType a => TType a -> SomeTType
SomeTType TType TStruct
TStruct
fromTypeCode Int8
13 = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a. IsTType a => TType a -> SomeTType
SomeTType TType TMap
TMap
fromTypeCode Int8
14 = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a. IsTType a => TType a -> SomeTType
SomeTType TType TSet
TSet
fromTypeCode Int8
15 = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a. IsTType a => TType a -> SomeTType
SomeTType TType TList
TList
fromTypeCode Int8
_  = forall a. Maybe a
Nothing
{-# INLINE fromTypeCode #-}

------------------------------------------------------------------------------


string :: ByteString -> Builder
string :: ByteString -> Builder
string ByteString
b = Int32 -> Builder
BB.int32BE (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ ByteString -> Int
B.length ByteString
b) forall a. Semigroup a => a -> a -> a
<> ByteString -> Builder
BB.byteString ByteString
b
{-# INLINE string #-}

typeCode :: TType a -> Builder
typeCode :: forall a. TType a -> Builder
typeCode = Int8 -> Builder
BB.int8 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. TType a -> Int8
toTypeCode
{-# INLINE typeCode #-}