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 LongLongInt
_ Bool
_ ShortString
_ ShortString
_ LongInt
_)) = Bool
True
hasContent (MethodPayload (Basic_deliver ShortString
_ LongLongInt
_ Bool
_ ShortString
_ ShortString
_)) = Bool
True
hasContent (MethodPayload (Basic_return ShortInt
_ ShortString
_ ShortString
_ ShortString
_)) = 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
        ShortInt
channel <- Get ShortInt
forall t. Binary t => Get t
get :: Get ChannelID
        LongInt
payloadSize <- Get LongInt
forall t. Binary t => Get t
get :: Get PayloadSize
        FramePayload
payload <- Word8 -> LongInt -> Get FramePayload
getPayload Word8
fType LongInt
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
$ ShortInt -> FramePayload -> Frame
Frame ShortInt
channel FramePayload
payload

    put :: Frame -> Put
put (Frame ShortInt
chan FramePayload
payload) = do
        Word8 -> Put
putWord8 (Word8 -> Put) -> Word8 -> Put
forall a b. (a -> b) -> a -> b
$ FramePayload -> Word8
frameType FramePayload
payload
        ShortInt -> Put
forall t. Binary t => t -> Put
put ShortInt
chan
        let buf :: ByteString
buf = Put -> ByteString
runPut (Put -> ByteString) -> Put -> ByteString
forall a b. (a -> b) -> a -> b
$ FramePayload -> Put
putPayload FramePayload
payload
        LongInt -> Put
forall t. Binary t => t -> Put
put ((Int64 -> LongInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int64 -> LongInt) -> Int64 -> LongInt
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 -> LongInt
peekFrameSize = Get LongInt -> ByteString -> LongInt
forall a. Get a -> ByteString -> a
runGet Get LongInt
f
  where
    f :: Get LongInt
f = do
      Get Word8 -> Get ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Get Word8 -> Get ()) -> Get Word8 -> Get ()
forall a b. (a -> b) -> a -> b
$ Get Word8
getWord8 -- 1 byte

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

      Get LongInt
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 ShortInt
_ ShortInt
_ LongLongInt
_ ContentHeaderProperties
_) = Word8
2
frameType (ContentBodyPayload ByteString
_) = Word8
3
frameType FramePayload
HeartbeatPayload = Word8
8

getPayload :: Word8 -> PayloadSize -> Get FramePayload
getPayload :: Word8 -> LongInt -> Get FramePayload
getPayload Word8
1 LongInt
_ = 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 LongInt
_ = do --content header frame

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

    ByteString
payload <- Int64 -> Get ByteString
getLazyByteString (Int64 -> Get ByteString) -> Int64 -> Get ByteString
forall a b. (a -> b) -> a -> b
$ LongInt -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral LongInt
payloadSize
    FramePayload -> Get FramePayload
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString -> FramePayload
ContentBodyPayload ByteString
payload)
getPayload Word8
8 LongInt
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
$ LongInt -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral LongInt
payloadSize
    FramePayload -> Get FramePayload
forall (m :: * -> *) a. Monad m => a -> m a
return FramePayload
HeartbeatPayload
getPayload Word8
n LongInt
_ = 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 ShortInt
classID ShortInt
weight LongLongInt
bodySize ContentHeaderProperties
p) = do
    ShortInt -> Put
forall t. Binary t => t -> Put
put ShortInt
classID
    ShortInt -> Put
forall t. Binary t => t -> Put
put ShortInt
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