module Network.AMQP.Protocol where

import Control.Monad
import Data.Binary
import Data.Binary.Get
import Data.Binary.Put

import qualified Data.ByteString.Lazy.Char8 as BL

import Network.AMQP.Types
import Network.AMQP.Generated

--True if a content (contentheader and possibly contentbody) will follow the method

hasContent :: FramePayload -> Bool
hasContent :: FramePayload -> Bool
hasContent (MethodPayload Basic_get_ok{}) = Bool
True
hasContent (MethodPayload Basic_deliver{}) = Bool
True
hasContent (MethodPayload Basic_return{}) = Bool
True
hasContent FramePayload
_ = Bool
False

data Frame = Frame ChannelID FramePayload --channel, payload

    deriving Int -> Frame -> ShowS
[Frame] -> ShowS
Frame -> String
(Int -> Frame -> ShowS)
-> (Frame -> String) -> ([Frame] -> ShowS) -> Show Frame
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Frame] -> ShowS
$cshowList :: [Frame] -> ShowS
show :: Frame -> String
$cshow :: Frame -> String
showsPrec :: Int -> Frame -> ShowS
$cshowsPrec :: Int -> Frame -> ShowS
Show
instance Binary Frame where
    get :: Get Frame
get = do
        Word8
fType <- Get Word8
getWord8
        ChannelID
channel <- Get ChannelID
forall t. Binary t => Get t
get :: Get ChannelID
        PayloadSize
payloadSize <- Get PayloadSize
forall t. Binary t => Get t
get :: Get PayloadSize
        FramePayload
payload <- Word8 -> PayloadSize -> Get FramePayload
getPayload Word8
fType PayloadSize
payloadSize :: Get FramePayload
        Word8
0xCE <- Get Word8
getWord8 --frame end

        Frame -> Get Frame
forall (m :: * -> *) a. Monad m => a -> m a
return (Frame -> Get Frame) -> Frame -> Get Frame
forall a b. (a -> b) -> a -> b
$ ChannelID -> FramePayload -> Frame
Frame ChannelID
channel FramePayload
payload

    put :: Frame -> Put
put (Frame ChannelID
chan FramePayload
payload) = do
        Word8 -> Put
putWord8 (Word8 -> Put) -> Word8 -> Put
forall a b. (a -> b) -> a -> b
$ FramePayload -> Word8
frameType FramePayload
payload
        ChannelID -> Put
forall t. Binary t => t -> Put
put ChannelID
chan
        let buf :: ByteString
buf = Put -> ByteString
runPut (Put -> ByteString) -> Put -> ByteString
forall a b. (a -> b) -> a -> b
$ FramePayload -> Put
putPayload FramePayload
payload
        PayloadSize -> Put
forall t. Binary t => t -> Put
put ((Int64 -> PayloadSize
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int64 -> PayloadSize) -> Int64 -> PayloadSize
forall a b. (a -> b) -> a -> b
$ ByteString -> Int64
BL.length ByteString
buf)::PayloadSize)
        ByteString -> Put
putLazyByteString ByteString
buf
        Word8 -> Put
putWord8 Word8
0xCE

-- gets the size of the frame

-- the bytestring should be at least 7 bytes long, otherwise this method will fail

peekFrameSize :: BL.ByteString -> PayloadSize
peekFrameSize :: ByteString -> PayloadSize
peekFrameSize = Get PayloadSize -> ByteString -> PayloadSize
forall a. Get a -> ByteString -> a
runGet Get PayloadSize
f
  where
    f :: Get PayloadSize
f = do
        Get Word8 -> Get ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void Get Word8
getWord8 -- 1 byte

        Get ChannelID -> Get ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Get ChannelID
forall t. Binary t => Get t
get :: Get ChannelID) -- 2 bytes

        Get PayloadSize
forall t. Binary t => Get t
get :: Get PayloadSize -- 4 bytes


data FramePayload =
      MethodPayload MethodPayload
    | ContentHeaderPayload ShortInt ShortInt LongLongInt ContentHeaderProperties --classID, weight, bodySize, propertyFields

    | ContentBodyPayload BL.ByteString
    | HeartbeatPayload
    deriving Int -> FramePayload -> ShowS
[FramePayload] -> ShowS
FramePayload -> String
(Int -> FramePayload -> ShowS)
-> (FramePayload -> String)
-> ([FramePayload] -> ShowS)
-> Show FramePayload
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FramePayload] -> ShowS
$cshowList :: [FramePayload] -> ShowS
show :: FramePayload -> String
$cshow :: FramePayload -> String
showsPrec :: Int -> FramePayload -> ShowS
$cshowsPrec :: Int -> FramePayload -> ShowS
Show

frameType :: FramePayload -> Word8
frameType :: FramePayload -> Word8
frameType (MethodPayload MethodPayload
_) = Word8
1
frameType ContentHeaderPayload{} = Word8
2
frameType (ContentBodyPayload ByteString
_) = Word8
3
frameType FramePayload
HeartbeatPayload = Word8
8

getPayload :: Word8 -> PayloadSize -> Get FramePayload
getPayload :: Word8 -> PayloadSize -> Get FramePayload
getPayload Word8
1 PayloadSize
_ = do --METHOD FRAME

    MethodPayload
payLoad <- Get MethodPayload
forall t. Binary t => Get t
get :: Get MethodPayload
    FramePayload -> Get FramePayload
forall (m :: * -> *) a. Monad m => a -> m a
return (MethodPayload -> FramePayload
MethodPayload MethodPayload
payLoad)
getPayload Word8
2 PayloadSize
_ = do --content header frame

    ChannelID
classID <- Get ChannelID
forall t. Binary t => Get t
get :: Get ShortInt
    ChannelID
weight <- Get ChannelID
forall t. Binary t => Get t
get :: Get ShortInt
    LongLongInt
bodySize <- Get LongLongInt
forall t. Binary t => Get t
get :: Get LongLongInt
    ContentHeaderProperties
props <- ChannelID -> Get ContentHeaderProperties
getContentHeaderProperties ChannelID
classID
    FramePayload -> Get FramePayload
forall (m :: * -> *) a. Monad m => a -> m a
return (ChannelID
-> ChannelID
-> LongLongInt
-> ContentHeaderProperties
-> FramePayload
ContentHeaderPayload ChannelID
classID ChannelID
weight LongLongInt
bodySize ContentHeaderProperties
props)
getPayload Word8
3 PayloadSize
payloadSize = do --content body frame

    ByteString
payload <- Int64 -> Get ByteString
getLazyByteString (Int64 -> Get ByteString) -> Int64 -> Get ByteString
forall a b. (a -> b) -> a -> b
$ PayloadSize -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral PayloadSize
payloadSize
    FramePayload -> Get FramePayload
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString -> FramePayload
ContentBodyPayload ByteString
payload)
getPayload Word8
8 PayloadSize
payloadSize = do
    -- ignoring the actual payload, but still need to read the bytes from the network buffer

    ByteString
_ <- Int64 -> Get ByteString
getLazyByteString (Int64 -> Get ByteString) -> Int64 -> Get ByteString
forall a b. (a -> b) -> a -> b
$ PayloadSize -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral PayloadSize
payloadSize
    FramePayload -> Get FramePayload
forall (m :: * -> *) a. Monad m => a -> m a
return FramePayload
HeartbeatPayload
-- this should never happen:

getPayload Word8
n PayloadSize
_ = String -> Get FramePayload
forall a. HasCallStack => String -> a
error (String
"Unknown frame payload: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Word8 -> String
forall a. Show a => a -> String
show Word8
n)

putPayload :: FramePayload -> Put
putPayload :: FramePayload -> Put
putPayload (MethodPayload MethodPayload
payload) = MethodPayload -> Put
forall t. Binary t => t -> Put
put MethodPayload
payload
putPayload (ContentHeaderPayload ChannelID
classID ChannelID
weight LongLongInt
bodySize ContentHeaderProperties
p) = do
    ChannelID -> Put
forall t. Binary t => t -> Put
put ChannelID
classID
    ChannelID -> Put
forall t. Binary t => t -> Put
put ChannelID
weight
    LongLongInt -> Put
forall t. Binary t => t -> Put
put LongLongInt
bodySize
    ContentHeaderProperties -> Put
putContentHeaderProperties ContentHeaderProperties
p
putPayload (ContentBodyPayload ByteString
payload) = ByteString -> Put
putLazyByteString ByteString
payload
putPayload FramePayload
HeartbeatPayload = ByteString -> Put
putLazyByteString ByteString
BL.empty