{-# LANGUAGE BangPatterns, DeriveDataTypeable #-}
-- |

--

-- This module contains data-types specified in the AMQP spec

module Network.AMQP.Types (
    AMQPException(..),
    Octet,
    Bit,
    ChannelID,
    PayloadSize,
    ShortInt,
    LongInt,
    LongLongInt,
    ShortString(..),
    LongString(..),
    ConsumerTag,
    Timestamp,
    FieldTable(..),
    FieldValue(..),
    Decimals,
    DecimalValue(..),
    ConfirmationResult(..),
    CloseType(..)
) where

import Control.Applicative
import Data.Int
import Data.IntSet (IntSet)
import Data.Binary
import Data.Binary.Get
import Data.Binary.IEEE754
import Data.Binary.Put
import Data.Char
import Data.Text (Text)
import Data.Typeable

import qualified Control.Exception as CE
import qualified Data.ByteString as BS
import qualified Data.ByteString.Lazy as BL
import qualified Data.Map as M
import qualified Data.Text.Encoding as T

-- | describes whether a channel was closed by user-request (Normal) or by an AMQP exception (Abnormal)

data CloseType = Normal | Abnormal
    deriving (Typeable, Int -> CloseType -> ShowS
[CloseType] -> ShowS
CloseType -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CloseType] -> ShowS
$cshowList :: [CloseType] -> ShowS
show :: CloseType -> String
$cshow :: CloseType -> String
showsPrec :: Int -> CloseType -> ShowS
$cshowsPrec :: Int -> CloseType -> ShowS
Show, Eq CloseType
CloseType -> CloseType -> Bool
CloseType -> CloseType -> Ordering
CloseType -> CloseType -> CloseType
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: CloseType -> CloseType -> CloseType
$cmin :: CloseType -> CloseType -> CloseType
max :: CloseType -> CloseType -> CloseType
$cmax :: CloseType -> CloseType -> CloseType
>= :: CloseType -> CloseType -> Bool
$c>= :: CloseType -> CloseType -> Bool
> :: CloseType -> CloseType -> Bool
$c> :: CloseType -> CloseType -> Bool
<= :: CloseType -> CloseType -> Bool
$c<= :: CloseType -> CloseType -> Bool
< :: CloseType -> CloseType -> Bool
$c< :: CloseType -> CloseType -> Bool
compare :: CloseType -> CloseType -> Ordering
$ccompare :: CloseType -> CloseType -> Ordering
Ord, CloseType -> CloseType -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CloseType -> CloseType -> Bool
$c/= :: CloseType -> CloseType -> Bool
== :: CloseType -> CloseType -> Bool
$c== :: CloseType -> CloseType -> Bool
Eq)

data AMQPException =
      -- | the 'String' contains the reason why the channel was closed

      ChannelClosedException CloseType String
    | ConnectionClosedException CloseType String -- ^ String may contain a reason

    | AllChannelsAllocatedException Int -- ^ the 'Int' contains the channel-max property of the connection (i.e. the highest permitted channel id)

  deriving (Typeable, Int -> AMQPException -> ShowS
[AMQPException] -> ShowS
AMQPException -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AMQPException] -> ShowS
$cshowList :: [AMQPException] -> ShowS
show :: AMQPException -> String
$cshow :: AMQPException -> String
showsPrec :: Int -> AMQPException -> ShowS
$cshowsPrec :: Int -> AMQPException -> ShowS
Show, Eq AMQPException
AMQPException -> AMQPException -> Bool
AMQPException -> AMQPException -> Ordering
AMQPException -> AMQPException -> AMQPException
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: AMQPException -> AMQPException -> AMQPException
$cmin :: AMQPException -> AMQPException -> AMQPException
max :: AMQPException -> AMQPException -> AMQPException
$cmax :: AMQPException -> AMQPException -> AMQPException
>= :: AMQPException -> AMQPException -> Bool
$c>= :: AMQPException -> AMQPException -> Bool
> :: AMQPException -> AMQPException -> Bool
$c> :: AMQPException -> AMQPException -> Bool
<= :: AMQPException -> AMQPException -> Bool
$c<= :: AMQPException -> AMQPException -> Bool
< :: AMQPException -> AMQPException -> Bool
$c< :: AMQPException -> AMQPException -> Bool
compare :: AMQPException -> AMQPException -> Ordering
$ccompare :: AMQPException -> AMQPException -> Ordering
Ord, AMQPException -> AMQPException -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AMQPException -> AMQPException -> Bool
$c/= :: AMQPException -> AMQPException -> Bool
== :: AMQPException -> AMQPException -> Bool
$c== :: AMQPException -> AMQPException -> Bool
Eq)
instance CE.Exception AMQPException


-- performs runGet on a bytestring until the string is empty

readMany :: (Show a, Binary a) => BL.ByteString -> [a]
readMany :: forall a. (Show a, Binary a) => ByteString -> [a]
readMany = forall a. Get a -> ByteString -> a
runGet (forall a. (Show a, Binary a) => [a] -> Int -> Get [a]
readMany' [] Int
0)

readMany' :: (Show a, Binary a) => [a] -> Int -> Get [a]
readMany' :: forall a. (Show a, Binary a) => [a] -> Int -> Get [a]
readMany' [a]
_ Int
1000 = forall a. HasCallStack => String -> a
error String
"readMany overflow"
readMany' [a]
acc Int
overflow = do
    a
x <- forall t. Binary t => Get t
get
    Bool
emp <- Get Bool
isEmpty
    if Bool -> Bool
not Bool
emp
        then forall a. (Show a, Binary a) => [a] -> Int -> Get [a]
readMany' (a
xforall a. a -> [a] -> [a]
:[a]
acc) (Int
overflowforall a. Num a => a -> a -> a
+Int
1)
        else forall (m :: * -> *) a. Monad m => a -> m a
return (a
xforall a. a -> [a] -> [a]
:[a]
acc)

putMany :: Binary a => [a] -> PutM ()
putMany :: forall a. Binary a => [a] -> PutM ()
putMany = forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ forall t. Binary t => t -> PutM ()
put

-- Lowlevel Types

type Octet = Word8
type Bit = Bool

type ChannelID = ShortInt
type PayloadSize = LongInt

type ShortInt = Word16
type LongInt = Word32
type LongLongInt = Word64

type ConsumerTag = Text

newtype ShortString = ShortString Text
    deriving (ShortString -> ShortString -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ShortString -> ShortString -> Bool
$c/= :: ShortString -> ShortString -> Bool
== :: ShortString -> ShortString -> Bool
$c== :: ShortString -> ShortString -> Bool
Eq, Eq ShortString
ShortString -> ShortString -> Bool
ShortString -> ShortString -> Ordering
ShortString -> ShortString -> ShortString
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: ShortString -> ShortString -> ShortString
$cmin :: ShortString -> ShortString -> ShortString
max :: ShortString -> ShortString -> ShortString
$cmax :: ShortString -> ShortString -> ShortString
>= :: ShortString -> ShortString -> Bool
$c>= :: ShortString -> ShortString -> Bool
> :: ShortString -> ShortString -> Bool
$c> :: ShortString -> ShortString -> Bool
<= :: ShortString -> ShortString -> Bool
$c<= :: ShortString -> ShortString -> Bool
< :: ShortString -> ShortString -> Bool
$c< :: ShortString -> ShortString -> Bool
compare :: ShortString -> ShortString -> Ordering
$ccompare :: ShortString -> ShortString -> Ordering
Ord, ReadPrec [ShortString]
ReadPrec ShortString
Int -> ReadS ShortString
ReadS [ShortString]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ShortString]
$creadListPrec :: ReadPrec [ShortString]
readPrec :: ReadPrec ShortString
$creadPrec :: ReadPrec ShortString
readList :: ReadS [ShortString]
$creadList :: ReadS [ShortString]
readsPrec :: Int -> ReadS ShortString
$creadsPrec :: Int -> ReadS ShortString
Read, Int -> ShortString -> ShowS
[ShortString] -> ShowS
ShortString -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ShortString] -> ShowS
$cshowList :: [ShortString] -> ShowS
show :: ShortString -> String
$cshow :: ShortString -> String
showsPrec :: Int -> ShortString -> ShowS
$cshowsPrec :: Int -> ShortString -> ShowS
Show)
instance Binary ShortString where
    get :: Get ShortString
get = do
        Word8
len <- Get Word8
getWord8
        ByteString
dat <- Int -> Get ByteString
getByteString (forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
len)
        forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Text -> ShortString
ShortString forall a b. (a -> b) -> a -> b
$ ByteString -> Text
T.decodeUtf8 ByteString
dat

    put :: ShortString -> PutM ()
put (ShortString Text
x) = do
        let s :: ByteString
s = Text -> ByteString
T.encodeUtf8 Text
x
        if ByteString -> Int
BS.length ByteString
s forall a. Ord a => a -> a -> Bool
> Int
255
            then forall a. HasCallStack => String -> a
error String
"cannot encode ShortString with length > 255"
            else do
                Word8 -> PutM ()
putWord8 forall a b. (a -> b) -> a -> b
$ forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteString -> Int
BS.length ByteString
s)
                ByteString -> PutM ()
putByteString ByteString
s

newtype LongString = LongString BS.ByteString
    deriving (LongString -> LongString -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: LongString -> LongString -> Bool
$c/= :: LongString -> LongString -> Bool
== :: LongString -> LongString -> Bool
$c== :: LongString -> LongString -> Bool
Eq, Eq LongString
LongString -> LongString -> Bool
LongString -> LongString -> Ordering
LongString -> LongString -> LongString
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: LongString -> LongString -> LongString
$cmin :: LongString -> LongString -> LongString
max :: LongString -> LongString -> LongString
$cmax :: LongString -> LongString -> LongString
>= :: LongString -> LongString -> Bool
$c>= :: LongString -> LongString -> Bool
> :: LongString -> LongString -> Bool
$c> :: LongString -> LongString -> Bool
<= :: LongString -> LongString -> Bool
$c<= :: LongString -> LongString -> Bool
< :: LongString -> LongString -> Bool
$c< :: LongString -> LongString -> Bool
compare :: LongString -> LongString -> Ordering
$ccompare :: LongString -> LongString -> Ordering
Ord, ReadPrec [LongString]
ReadPrec LongString
Int -> ReadS LongString
ReadS [LongString]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [LongString]
$creadListPrec :: ReadPrec [LongString]
readPrec :: ReadPrec LongString
$creadPrec :: ReadPrec LongString
readList :: ReadS [LongString]
$creadList :: ReadS [LongString]
readsPrec :: Int -> ReadS LongString
$creadsPrec :: Int -> ReadS LongString
Read, Int -> LongString -> ShowS
[LongString] -> ShowS
LongString -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [LongString] -> ShowS
$cshowList :: [LongString] -> ShowS
show :: LongString -> String
$cshow :: LongString -> String
showsPrec :: Int -> LongString -> ShowS
$cshowsPrec :: Int -> LongString -> ShowS
Show)
instance Binary LongString where
    get :: Get LongString
get = do
        Word32
len <- Get Word32
getWord32be
        ByteString
dat <- Int -> Get ByteString
getByteString (forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
len)
        forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ ByteString -> LongString
LongString ByteString
dat

    put :: LongString -> PutM ()
put (LongString ByteString
x) = do
        Word32 -> PutM ()
putWord32be forall a b. (a -> b) -> a -> b
$ forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteString -> Int
BS.length ByteString
x)
        ByteString -> PutM ()
putByteString ByteString
x

type Timestamp = Word64

--- field-table ---


-- | Keys must be shorter than 256 bytes when encoded as UTF-8

data FieldTable = FieldTable (M.Map Text FieldValue)
    deriving (FieldTable -> FieldTable -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FieldTable -> FieldTable -> Bool
$c/= :: FieldTable -> FieldTable -> Bool
== :: FieldTable -> FieldTable -> Bool
$c== :: FieldTable -> FieldTable -> Bool
Eq, Eq FieldTable
FieldTable -> FieldTable -> Bool
FieldTable -> FieldTable -> Ordering
FieldTable -> FieldTable -> FieldTable
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: FieldTable -> FieldTable -> FieldTable
$cmin :: FieldTable -> FieldTable -> FieldTable
max :: FieldTable -> FieldTable -> FieldTable
$cmax :: FieldTable -> FieldTable -> FieldTable
>= :: FieldTable -> FieldTable -> Bool
$c>= :: FieldTable -> FieldTable -> Bool
> :: FieldTable -> FieldTable -> Bool
$c> :: FieldTable -> FieldTable -> Bool
<= :: FieldTable -> FieldTable -> Bool
$c<= :: FieldTable -> FieldTable -> Bool
< :: FieldTable -> FieldTable -> Bool
$c< :: FieldTable -> FieldTable -> Bool
compare :: FieldTable -> FieldTable -> Ordering
$ccompare :: FieldTable -> FieldTable -> Ordering
Ord, ReadPrec [FieldTable]
ReadPrec FieldTable
Int -> ReadS FieldTable
ReadS [FieldTable]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [FieldTable]
$creadListPrec :: ReadPrec [FieldTable]
readPrec :: ReadPrec FieldTable
$creadPrec :: ReadPrec FieldTable
readList :: ReadS [FieldTable]
$creadList :: ReadS [FieldTable]
readsPrec :: Int -> ReadS FieldTable
$creadsPrec :: Int -> ReadS FieldTable
Read, Int -> FieldTable -> ShowS
[FieldTable] -> ShowS
FieldTable -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FieldTable] -> ShowS
$cshowList :: [FieldTable] -> ShowS
show :: FieldTable -> String
$cshow :: FieldTable -> String
showsPrec :: Int -> FieldTable -> ShowS
$cshowsPrec :: Int -> FieldTable -> ShowS
Show)
instance Binary FieldTable where
    get :: Get FieldTable
get = do
        Word32
len <- forall t. Binary t => Get t
get :: Get LongInt --length of fieldValuePairs in bytes

        if Word32
len forall a. Ord a => a -> a -> Bool
> Word32
0
            then do
                ByteString
fvp <- Int64 -> Get ByteString
getLazyByteString (forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
len)
                let !fields :: [(ShortString, FieldValue)]
fields = forall a. (Show a, Binary a) => ByteString -> [a]
readMany ByteString
fvp
                forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Map Text FieldValue -> FieldTable
FieldTable forall a b. (a -> b) -> a -> b
$ forall k a. Ord k => [(k, a)] -> Map k a
M.fromList forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (\(ShortString Text
a, FieldValue
b) -> (Text
a,FieldValue
b)) [(ShortString, FieldValue)]
fields
            else forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Map Text FieldValue -> FieldTable
FieldTable forall k a. Map k a
M.empty

    put :: FieldTable -> PutM ()
put (FieldTable Map Text FieldValue
fvp) = do
        let bytes :: ByteString
bytes = PutM () -> ByteString
runPut (forall a. Binary a => [a] -> PutM ()
putMany forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (\(Text
a,FieldValue
b) -> (Text -> ShortString
ShortString Text
a, FieldValue
b)) forall a b. (a -> b) -> a -> b
$ forall k a. Map k a -> [(k, a)]
M.toList Map Text FieldValue
fvp) :: BL.ByteString
        forall t. Binary t => t -> PutM ()
put ((forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ ByteString -> Int64
BL.length ByteString
bytes):: LongInt)
        ByteString -> PutM ()
putLazyByteString ByteString
bytes

--- field-value ---


data FieldValue = FVBool Bool
                | FVInt8 Int8
                | FVInt16 Int16
                | FVInt32 Int32
                | FVInt64 Int64
                | FVFloat Float
                | FVDouble Double
                | FVDecimal DecimalValue
                | FVString BS.ByteString
                | FVFieldArray [FieldValue]
                | FVTimestamp Timestamp
                | FVFieldTable FieldTable
                | FVVoid
                | FVByteArray BS.ByteString
    deriving (FieldValue -> FieldValue -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FieldValue -> FieldValue -> Bool
$c/= :: FieldValue -> FieldValue -> Bool
== :: FieldValue -> FieldValue -> Bool
$c== :: FieldValue -> FieldValue -> Bool
Eq, Eq FieldValue
FieldValue -> FieldValue -> Bool
FieldValue -> FieldValue -> Ordering
FieldValue -> FieldValue -> FieldValue
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: FieldValue -> FieldValue -> FieldValue
$cmin :: FieldValue -> FieldValue -> FieldValue
max :: FieldValue -> FieldValue -> FieldValue
$cmax :: FieldValue -> FieldValue -> FieldValue
>= :: FieldValue -> FieldValue -> Bool
$c>= :: FieldValue -> FieldValue -> Bool
> :: FieldValue -> FieldValue -> Bool
$c> :: FieldValue -> FieldValue -> Bool
<= :: FieldValue -> FieldValue -> Bool
$c<= :: FieldValue -> FieldValue -> Bool
< :: FieldValue -> FieldValue -> Bool
$c< :: FieldValue -> FieldValue -> Bool
compare :: FieldValue -> FieldValue -> Ordering
$ccompare :: FieldValue -> FieldValue -> Ordering
Ord, ReadPrec [FieldValue]
ReadPrec FieldValue
Int -> ReadS FieldValue
ReadS [FieldValue]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [FieldValue]
$creadListPrec :: ReadPrec [FieldValue]
readPrec :: ReadPrec FieldValue
$creadPrec :: ReadPrec FieldValue
readList :: ReadS [FieldValue]
$creadList :: ReadS [FieldValue]
readsPrec :: Int -> ReadS FieldValue
$creadsPrec :: Int -> ReadS FieldValue
Read, Int -> FieldValue -> ShowS
[FieldValue] -> ShowS
FieldValue -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FieldValue] -> ShowS
$cshowList :: [FieldValue] -> ShowS
show :: FieldValue -> String
$cshow :: FieldValue -> String
showsPrec :: Int -> FieldValue -> ShowS
$cshowsPrec :: Int -> FieldValue -> ShowS
Show)

instance Binary FieldValue where
    get :: Get FieldValue
get = do
        Word8
fieldType <- Get Word8
getWord8
        case Int -> Char
chr forall a b. (a -> b) -> a -> b
$ forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
fieldType of
            Char
't' -> Bool -> FieldValue
FVBool forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall t. Binary t => Get t
get
            Char
'b' -> Int8 -> FieldValue
FVInt8 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall t. Binary t => Get t
get
            Char
's' -> Int16 -> FieldValue
FVInt16 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall t. Binary t => Get t
get
            Char
'I' -> Int32 -> FieldValue
FVInt32 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall t. Binary t => Get t
get
            Char
'l' -> Int64 -> FieldValue
FVInt64 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall t. Binary t => Get t
get
            Char
'f' -> Float -> FieldValue
FVFloat forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Float
getFloat32be
            Char
'd' -> Double -> FieldValue
FVDouble forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Double
getFloat64be
            Char
'D' -> DecimalValue -> FieldValue
FVDecimal forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall t. Binary t => Get t
get
            Char
'S' -> do
                LongString ByteString
x <- forall t. Binary t => Get t
get :: Get LongString
                forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ ByteString -> FieldValue
FVString ByteString
x
            Char
'A' -> do
                Int32
len <- forall t. Binary t => Get t
get :: Get Int32
                if Int32
len forall a. Ord a => a -> a -> Bool
> Int32
0
                    then do
                        ByteString
fvp <- Int64 -> Get ByteString
getLazyByteString (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int32
len)
                        let !fields :: [FieldValue]
fields = forall a. (Show a, Binary a) => ByteString -> [a]
readMany ByteString
fvp
                        forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ [FieldValue] -> FieldValue
FVFieldArray [FieldValue]
fields
                    else forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ [FieldValue] -> FieldValue
FVFieldArray []
            Char
'T' -> Timestamp -> FieldValue
FVTimestamp forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall t. Binary t => Get t
get
            Char
'F' -> FieldTable -> FieldValue
FVFieldTable forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall t. Binary t => Get t
get
            Char
'V' -> forall (m :: * -> *) a. Monad m => a -> m a
return FieldValue
FVVoid
            Char
'x' -> do
                Word32
len <- forall t. Binary t => Get t
get :: Get Word32
                ByteString -> FieldValue
FVByteArray forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Get ByteString
getByteString (forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
len)
            -- this should never happen:

            Char
c   -> forall a. HasCallStack => String -> a
error (String
"Unknown field type: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Char
c)

    put :: FieldValue -> PutM ()
put (FVBool Bool
x) = forall t. Binary t => t -> PutM ()
put Char
't' forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall t. Binary t => t -> PutM ()
put Bool
x
    put (FVInt8 Int8
x) = forall t. Binary t => t -> PutM ()
put Char
'b' forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall t. Binary t => t -> PutM ()
put Int8
x
    put (FVInt16 Int16
x) = forall t. Binary t => t -> PutM ()
put Char
's' forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall t. Binary t => t -> PutM ()
put Int16
x
    put (FVInt32 Int32
x) = forall t. Binary t => t -> PutM ()
put Char
'I' forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall t. Binary t => t -> PutM ()
put Int32
x
    put (FVInt64 Int64
x) = forall t. Binary t => t -> PutM ()
put Char
'l' forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall t. Binary t => t -> PutM ()
put Int64
x
    put (FVFloat Float
x) = forall t. Binary t => t -> PutM ()
put Char
'f' forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Float -> PutM ()
putFloat32be Float
x
    put (FVDouble Double
x) = forall t. Binary t => t -> PutM ()
put Char
'd' forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Double -> PutM ()
putFloat64be Double
x
    put (FVDecimal DecimalValue
x) = forall t. Binary t => t -> PutM ()
put Char
'D' forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall t. Binary t => t -> PutM ()
put DecimalValue
x
    put (FVString ByteString
x) = forall t. Binary t => t -> PutM ()
put Char
'S' forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall t. Binary t => t -> PutM ()
put (ByteString -> LongString
LongString ByteString
x)
    put (FVFieldArray [FieldValue]
x) = do
        forall t. Binary t => t -> PutM ()
put Char
'A'
        if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [FieldValue]
x
            then forall t. Binary t => t -> PutM ()
put (Int32
0 :: Int32)
            else do
                let bytes :: ByteString
bytes = PutM () -> ByteString
runPut (forall a. Binary a => [a] -> PutM ()
putMany [FieldValue]
x) :: BL.ByteString
                forall t. Binary t => t -> PutM ()
put ((forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ ByteString -> Int64
BL.length ByteString
bytes):: Int32)
                ByteString -> PutM ()
putLazyByteString ByteString
bytes
    put (FVTimestamp Timestamp
s)    = forall t. Binary t => t -> PutM ()
put Char
'T' forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall t. Binary t => t -> PutM ()
put Timestamp
s
    put (FVFieldTable FieldTable
s)   = forall t. Binary t => t -> PutM ()
put Char
'F' forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall t. Binary t => t -> PutM ()
put FieldTable
s
    put FieldValue
FVVoid = forall t. Binary t => t -> PutM ()
put Char
'V'
    put (FVByteArray ByteString
x) = do
        forall t. Binary t => t -> PutM ()
put Char
'x'
        let len :: Word32
len = forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteString -> Int
BS.length ByteString
x) :: Word32
        forall t. Binary t => t -> PutM ()
put Word32
len
        ByteString -> PutM ()
putByteString ByteString
x

data DecimalValue = DecimalValue Decimals LongInt
    deriving (DecimalValue -> DecimalValue -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DecimalValue -> DecimalValue -> Bool
$c/= :: DecimalValue -> DecimalValue -> Bool
== :: DecimalValue -> DecimalValue -> Bool
$c== :: DecimalValue -> DecimalValue -> Bool
Eq, Eq DecimalValue
DecimalValue -> DecimalValue -> Bool
DecimalValue -> DecimalValue -> Ordering
DecimalValue -> DecimalValue -> DecimalValue
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: DecimalValue -> DecimalValue -> DecimalValue
$cmin :: DecimalValue -> DecimalValue -> DecimalValue
max :: DecimalValue -> DecimalValue -> DecimalValue
$cmax :: DecimalValue -> DecimalValue -> DecimalValue
>= :: DecimalValue -> DecimalValue -> Bool
$c>= :: DecimalValue -> DecimalValue -> Bool
> :: DecimalValue -> DecimalValue -> Bool
$c> :: DecimalValue -> DecimalValue -> Bool
<= :: DecimalValue -> DecimalValue -> Bool
$c<= :: DecimalValue -> DecimalValue -> Bool
< :: DecimalValue -> DecimalValue -> Bool
$c< :: DecimalValue -> DecimalValue -> Bool
compare :: DecimalValue -> DecimalValue -> Ordering
$ccompare :: DecimalValue -> DecimalValue -> Ordering
Ord, ReadPrec [DecimalValue]
ReadPrec DecimalValue
Int -> ReadS DecimalValue
ReadS [DecimalValue]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DecimalValue]
$creadListPrec :: ReadPrec [DecimalValue]
readPrec :: ReadPrec DecimalValue
$creadPrec :: ReadPrec DecimalValue
readList :: ReadS [DecimalValue]
$creadList :: ReadS [DecimalValue]
readsPrec :: Int -> ReadS DecimalValue
$creadsPrec :: Int -> ReadS DecimalValue
Read, Int -> DecimalValue -> ShowS
[DecimalValue] -> ShowS
DecimalValue -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DecimalValue] -> ShowS
$cshowList :: [DecimalValue] -> ShowS
show :: DecimalValue -> String
$cshow :: DecimalValue -> String
showsPrec :: Int -> DecimalValue -> ShowS
$cshowsPrec :: Int -> DecimalValue -> ShowS
Show)
instance Binary DecimalValue where
    get :: Get DecimalValue
get = do
      Word8
a <- Get Word8
getWord8
      Word32
b <- forall t. Binary t => Get t
get :: Get LongInt
      forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Word8 -> Word32 -> DecimalValue
DecimalValue Word8
a Word32
b

    put :: DecimalValue -> PutM ()
put (DecimalValue Word8
a Word32
b) = forall t. Binary t => t -> PutM ()
put Word8
a forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall t. Binary t => t -> PutM ()
put Word32
b

type Decimals = Octet

data ConfirmationResult = Complete (IntSet, IntSet) | Partial (IntSet, IntSet, IntSet) deriving Int -> ConfirmationResult -> ShowS
[ConfirmationResult] -> ShowS
ConfirmationResult -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ConfirmationResult] -> ShowS
$cshowList :: [ConfirmationResult] -> ShowS
show :: ConfirmationResult -> String
$cshow :: ConfirmationResult -> String
showsPrec :: Int -> ConfirmationResult -> ShowS
$cshowsPrec :: Int -> ConfirmationResult -> ShowS
Show