{- An internal representation of a frame, as specified by the Pulsar protocol: http://pulsar.apache.org/docs/en/develop-binary-protocol -}
module Pulsar.Protocol.Frame where

import qualified Data.Binary                   as B
import qualified Data.ByteString.Lazy.Char8    as CL
import           Data.Int                       ( Int32 )
import           Proto.PulsarApi                ( BaseCommand
                                                , MessageMetadata
                                                )
import           Pulsar.Protocol.CheckSum       ( CheckSum )

-- The maximum allowable size of a single frame is 5 MB: http://pulsar.apache.org/docs/en/develop-binary-protocol/#framing
frameMaxSize :: Int
frameMaxSize :: Int
frameMaxSize = 5 Int -> Int -> Int
forall a. Num a => a -> a -> a
* 1024 Int -> Int -> Int
forall a. Num a => a -> a -> a
* 1024 -- 5mb

-- A 2-byte byte array (0x0e01) identifying the current format
frameMagicNumber :: B.Word16
frameMagicNumber :: Word16
frameMagicNumber = 0x0e01

data Frame = SimpleFrame SimpleCmd | PayloadFrame SimpleCmd PayloadCmd

-- Simple command: http://pulsar.apache.org/docs/en/develop-binary-protocol/#simple-commands
data SimpleCmd = SimpleCommand
  { SimpleCmd -> Int32
frameTotalSize :: Int32        -- The size of the frame, counting everything that comes after it (4 bytes)
  , SimpleCmd -> Int32
frameCommandSize :: Int32      -- The size of the protobuf-serialized command (4 bytes)
  , SimpleCmd -> ByteString
frameMessage :: CL.ByteString  -- The protobuf message serialized in a raw binary format (rather than in protobuf format)
  }

-- Payload command: http://pulsar.apache.org/docs/en/develop-binary-protocol/#payload-commands
data PayloadCmd = PayloadCommand
  { PayloadCmd -> Maybe CheckSum
frameCheckSum :: Maybe CheckSum -- A CRC32-C checksum of everything that comes after it (4 bytes) - OPTIONAL
  , PayloadCmd -> Int32
frameMetadataSize :: Int32      -- The size of the message metadata (4 bytes)
  , PayloadCmd -> ByteString
frameMetadata :: CL.ByteString  -- The message metadata stored as a binary protobuf message
  , PayloadCmd -> ByteString
framePayload :: CL.ByteString   -- Anything left in the frame is considered the payload and can include any sequence of bytes
  }

newtype Payload = Payload CL.ByteString deriving Int -> Payload -> ShowS
[Payload] -> ShowS
Payload -> String
(Int -> Payload -> ShowS)
-> (Payload -> String) -> ([Payload] -> ShowS) -> Show Payload
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Payload] -> ShowS
$cshowList :: [Payload] -> ShowS
show :: Payload -> String
$cshow :: Payload -> String
showsPrec :: Int -> Payload -> ShowS
$cshowsPrec :: Int -> Payload -> ShowS
Show

data Response = SimpleResponse BaseCommand | PayloadResponse BaseCommand MessageMetadata (Maybe Payload) deriving Int -> Response -> ShowS
[Response] -> ShowS
Response -> String
(Int -> Response -> ShowS)
-> (Response -> String) -> ([Response] -> ShowS) -> Show Response
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Response] -> ShowS
$cshowList :: [Response] -> ShowS
show :: Response -> String
$cshow :: Response -> String
showsPrec :: Int -> Response -> ShowS
$cshowsPrec :: Int -> Response -> ShowS
Show

getCommand :: Response -> BaseCommand
getCommand :: Response -> BaseCommand
getCommand response :: Response
response = case Response
response of
  (SimpleResponse cmd :: BaseCommand
cmd     ) -> BaseCommand
cmd
  (PayloadResponse cmd :: BaseCommand
cmd _ _) -> BaseCommand
cmd