{-# 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
(Int -> CloseType -> ShowS)
-> (CloseType -> String)
-> ([CloseType] -> ShowS)
-> Show CloseType
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
Eq CloseType
-> (CloseType -> CloseType -> Ordering)
-> (CloseType -> CloseType -> Bool)
-> (CloseType -> CloseType -> Bool)
-> (CloseType -> CloseType -> Bool)
-> (CloseType -> CloseType -> Bool)
-> (CloseType -> CloseType -> CloseType)
-> (CloseType -> CloseType -> CloseType)
-> Ord 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
$cp1Ord :: Eq CloseType
Ord, CloseType -> CloseType -> Bool
(CloseType -> CloseType -> Bool)
-> (CloseType -> CloseType -> Bool) -> Eq CloseType
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
(Int -> AMQPException -> ShowS)
-> (AMQPException -> String)
-> ([AMQPException] -> ShowS)
-> Show AMQPException
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
Eq AMQPException
-> (AMQPException -> AMQPException -> Ordering)
-> (AMQPException -> AMQPException -> Bool)
-> (AMQPException -> AMQPException -> Bool)
-> (AMQPException -> AMQPException -> Bool)
-> (AMQPException -> AMQPException -> Bool)
-> (AMQPException -> AMQPException -> AMQPException)
-> (AMQPException -> AMQPException -> AMQPException)
-> Ord 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
$cp1Ord :: Eq AMQPException
Ord, AMQPException -> AMQPException -> Bool
(AMQPException -> AMQPException -> Bool)
-> (AMQPException -> AMQPException -> Bool) -> Eq AMQPException
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 :: ByteString -> [a]
readMany = Get [a] -> ByteString -> [a]
forall a. Get a -> ByteString -> a
runGet ([a] -> Int -> Get [a]
forall a. (Show a, Binary a) => [a] -> Int -> Get [a]
readMany' [] Int
0)

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

putMany :: Binary a => [a] -> PutM ()
putMany :: [a] -> PutM ()
putMany = (a -> PutM ()) -> [a] -> PutM ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ a -> PutM ()
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
(ShortString -> ShortString -> Bool)
-> (ShortString -> ShortString -> Bool) -> Eq ShortString
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
Eq ShortString
-> (ShortString -> ShortString -> Ordering)
-> (ShortString -> ShortString -> Bool)
-> (ShortString -> ShortString -> Bool)
-> (ShortString -> ShortString -> Bool)
-> (ShortString -> ShortString -> Bool)
-> (ShortString -> ShortString -> ShortString)
-> (ShortString -> ShortString -> ShortString)
-> Ord 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
$cp1Ord :: Eq ShortString
Ord, ReadPrec [ShortString]
ReadPrec ShortString
Int -> ReadS ShortString
ReadS [ShortString]
(Int -> ReadS ShortString)
-> ReadS [ShortString]
-> ReadPrec ShortString
-> ReadPrec [ShortString]
-> Read 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
(Int -> ShortString -> ShowS)
-> (ShortString -> String)
-> ([ShortString] -> ShowS)
-> Show ShortString
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 (Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
len)
        ShortString -> Get ShortString
forall (m :: * -> *) a. Monad m => a -> m a
return (ShortString -> Get ShortString) -> ShortString -> Get ShortString
forall a b. (a -> b) -> a -> b
$ Text -> ShortString
ShortString (Text -> ShortString) -> Text -> 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 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
255
            then String -> PutM ()
forall a. HasCallStack => String -> a
error String
"cannot encode ShortString with length > 255"
            else do
                Word8 -> PutM ()
putWord8 (Word8 -> PutM ()) -> Word8 -> PutM ()
forall a b. (a -> b) -> a -> b
$ Int -> Word8
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
(LongString -> LongString -> Bool)
-> (LongString -> LongString -> Bool) -> Eq LongString
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
Eq LongString
-> (LongString -> LongString -> Ordering)
-> (LongString -> LongString -> Bool)
-> (LongString -> LongString -> Bool)
-> (LongString -> LongString -> Bool)
-> (LongString -> LongString -> Bool)
-> (LongString -> LongString -> LongString)
-> (LongString -> LongString -> LongString)
-> Ord 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
$cp1Ord :: Eq LongString
Ord, ReadPrec [LongString]
ReadPrec LongString
Int -> ReadS LongString
ReadS [LongString]
(Int -> ReadS LongString)
-> ReadS [LongString]
-> ReadPrec LongString
-> ReadPrec [LongString]
-> Read 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
(Int -> LongString -> ShowS)
-> (LongString -> String)
-> ([LongString] -> ShowS)
-> Show LongString
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 (Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
len)
        LongString -> Get LongString
forall (m :: * -> *) a. Monad m => a -> m a
return (LongString -> Get LongString) -> LongString -> Get LongString
forall a b. (a -> b) -> a -> b
$ ByteString -> LongString
LongString ByteString
dat

    put :: LongString -> PutM ()
put (LongString ByteString
x) = do
        Word32 -> PutM ()
putWord32be (Word32 -> PutM ()) -> Word32 -> PutM ()
forall a b. (a -> b) -> a -> b
$ Int -> Word32
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
(FieldTable -> FieldTable -> Bool)
-> (FieldTable -> FieldTable -> Bool) -> Eq FieldTable
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
Eq FieldTable
-> (FieldTable -> FieldTable -> Ordering)
-> (FieldTable -> FieldTable -> Bool)
-> (FieldTable -> FieldTable -> Bool)
-> (FieldTable -> FieldTable -> Bool)
-> (FieldTable -> FieldTable -> Bool)
-> (FieldTable -> FieldTable -> FieldTable)
-> (FieldTable -> FieldTable -> FieldTable)
-> Ord 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
$cp1Ord :: Eq FieldTable
Ord, ReadPrec [FieldTable]
ReadPrec FieldTable
Int -> ReadS FieldTable
ReadS [FieldTable]
(Int -> ReadS FieldTable)
-> ReadS [FieldTable]
-> ReadPrec FieldTable
-> ReadPrec [FieldTable]
-> Read 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
(Int -> FieldTable -> ShowS)
-> (FieldTable -> String)
-> ([FieldTable] -> ShowS)
-> Show FieldTable
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 <- Get Word32
forall t. Binary t => Get t
get :: Get LongInt --length of fieldValuePairs in bytes

        if Word32
len Word32 -> Word32 -> Bool
forall a. Ord a => a -> a -> Bool
> Word32
0
            then do
                ByteString
fvp <- Int64 -> Get ByteString
getLazyByteString (Word32 -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
len)
                let !fields :: [(ShortString, FieldValue)]
fields = ByteString -> [(ShortString, FieldValue)]
forall a. (Show a, Binary a) => ByteString -> [a]
readMany ByteString
fvp
                FieldTable -> Get FieldTable
forall (m :: * -> *) a. Monad m => a -> m a
return (FieldTable -> Get FieldTable) -> FieldTable -> Get FieldTable
forall a b. (a -> b) -> a -> b
$ Map Text FieldValue -> FieldTable
FieldTable (Map Text FieldValue -> FieldTable)
-> Map Text FieldValue -> FieldTable
forall a b. (a -> b) -> a -> b
$ [(Text, FieldValue)] -> Map Text FieldValue
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList ([(Text, FieldValue)] -> Map Text FieldValue)
-> [(Text, FieldValue)] -> Map Text FieldValue
forall a b. (a -> b) -> a -> b
$ ((ShortString, FieldValue) -> (Text, FieldValue))
-> [(ShortString, FieldValue)] -> [(Text, FieldValue)]
forall a b. (a -> b) -> [a] -> [b]
map (\(ShortString Text
a, FieldValue
b) -> (Text
a,FieldValue
b)) [(ShortString, FieldValue)]
fields
            else FieldTable -> Get FieldTable
forall (m :: * -> *) a. Monad m => a -> m a
return (FieldTable -> Get FieldTable) -> FieldTable -> Get FieldTable
forall a b. (a -> b) -> a -> b
$ Map Text FieldValue -> FieldTable
FieldTable Map Text FieldValue
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 ([(ShortString, FieldValue)] -> PutM ()
forall a. Binary a => [a] -> PutM ()
putMany ([(ShortString, FieldValue)] -> PutM ())
-> [(ShortString, FieldValue)] -> PutM ()
forall a b. (a -> b) -> a -> b
$ ((Text, FieldValue) -> (ShortString, FieldValue))
-> [(Text, FieldValue)] -> [(ShortString, FieldValue)]
forall a b. (a -> b) -> [a] -> [b]
map (\(Text
a,FieldValue
b) -> (Text -> ShortString
ShortString Text
a, FieldValue
b)) ([(Text, FieldValue)] -> [(ShortString, FieldValue)])
-> [(Text, FieldValue)] -> [(ShortString, FieldValue)]
forall a b. (a -> b) -> a -> b
$ Map Text FieldValue -> [(Text, FieldValue)]
forall k a. Map k a -> [(k, a)]
M.toList Map Text FieldValue
fvp) :: BL.ByteString
        Word32 -> PutM ()
forall t. Binary t => t -> PutM ()
put ((Int64 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int64 -> Word32) -> Int64 -> Word32
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
(FieldValue -> FieldValue -> Bool)
-> (FieldValue -> FieldValue -> Bool) -> Eq FieldValue
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
Eq FieldValue
-> (FieldValue -> FieldValue -> Ordering)
-> (FieldValue -> FieldValue -> Bool)
-> (FieldValue -> FieldValue -> Bool)
-> (FieldValue -> FieldValue -> Bool)
-> (FieldValue -> FieldValue -> Bool)
-> (FieldValue -> FieldValue -> FieldValue)
-> (FieldValue -> FieldValue -> FieldValue)
-> Ord 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
$cp1Ord :: Eq FieldValue
Ord, ReadPrec [FieldValue]
ReadPrec FieldValue
Int -> ReadS FieldValue
ReadS [FieldValue]
(Int -> ReadS FieldValue)
-> ReadS [FieldValue]
-> ReadPrec FieldValue
-> ReadPrec [FieldValue]
-> Read 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
(Int -> FieldValue -> ShowS)
-> (FieldValue -> String)
-> ([FieldValue] -> ShowS)
-> Show FieldValue
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 (Int -> Char) -> Int -> Char
forall a b. (a -> b) -> a -> b
$ Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
fieldType of
            Char
't' -> Bool -> FieldValue
FVBool (Bool -> FieldValue) -> Get Bool -> Get FieldValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Bool
forall t. Binary t => Get t
get
            Char
'b' -> Int8 -> FieldValue
FVInt8 (Int8 -> FieldValue) -> Get Int8 -> Get FieldValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Int8
forall t. Binary t => Get t
get
            Char
's' -> Int16 -> FieldValue
FVInt16 (Int16 -> FieldValue) -> Get Int16 -> Get FieldValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Int16
forall t. Binary t => Get t
get
            Char
'I' -> Int32 -> FieldValue
FVInt32 (Int32 -> FieldValue) -> Get Int32 -> Get FieldValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Int32
forall t. Binary t => Get t
get
            Char
'l' -> Int64 -> FieldValue
FVInt64 (Int64 -> FieldValue) -> Get Int64 -> Get FieldValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Int64
forall t. Binary t => Get t
get
            Char
'f' -> Float -> FieldValue
FVFloat (Float -> FieldValue) -> Get Float -> Get FieldValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Float
getFloat32be
            Char
'd' -> Double -> FieldValue
FVDouble (Double -> FieldValue) -> Get Double -> Get FieldValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Double
getFloat64be
            Char
'D' -> DecimalValue -> FieldValue
FVDecimal (DecimalValue -> FieldValue) -> Get DecimalValue -> Get FieldValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get DecimalValue
forall t. Binary t => Get t
get
            Char
'S' -> do
                LongString ByteString
x <- Get LongString
forall t. Binary t => Get t
get :: Get LongString
                FieldValue -> Get FieldValue
forall (m :: * -> *) a. Monad m => a -> m a
return (FieldValue -> Get FieldValue) -> FieldValue -> Get FieldValue
forall a b. (a -> b) -> a -> b
$ ByteString -> FieldValue
FVString ByteString
x
            Char
'A' -> do
                Int32
len <- Get Int32
forall t. Binary t => Get t
get :: Get Int32
                if Int32
len Int32 -> Int32 -> Bool
forall a. Ord a => a -> a -> Bool
> Int32
0
                    then do
                        ByteString
fvp <- Int64 -> Get ByteString
getLazyByteString (Int32 -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int32
len)
                        let !fields :: [FieldValue]
fields = ByteString -> [FieldValue]
forall a. (Show a, Binary a) => ByteString -> [a]
readMany ByteString
fvp
                        FieldValue -> Get FieldValue
forall (m :: * -> *) a. Monad m => a -> m a
return (FieldValue -> Get FieldValue) -> FieldValue -> Get FieldValue
forall a b. (a -> b) -> a -> b
$ [FieldValue] -> FieldValue
FVFieldArray [FieldValue]
fields
                    else FieldValue -> Get FieldValue
forall (m :: * -> *) a. Monad m => a -> m a
return (FieldValue -> Get FieldValue) -> FieldValue -> Get FieldValue
forall a b. (a -> b) -> a -> b
$ [FieldValue] -> FieldValue
FVFieldArray []
            Char
'T' -> Timestamp -> FieldValue
FVTimestamp (Timestamp -> FieldValue) -> Get Timestamp -> Get FieldValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Timestamp
forall t. Binary t => Get t
get
            Char
'F' -> FieldTable -> FieldValue
FVFieldTable (FieldTable -> FieldValue) -> Get FieldTable -> Get FieldValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get FieldTable
forall t. Binary t => Get t
get
            Char
'V' -> FieldValue -> Get FieldValue
forall (m :: * -> *) a. Monad m => a -> m a
return FieldValue
FVVoid
            Char
'x' -> do
                Word32
len <- Get Word32
forall t. Binary t => Get t
get :: Get Word32
                ByteString -> FieldValue
FVByteArray (ByteString -> FieldValue) -> Get ByteString -> Get FieldValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Get ByteString
getByteString (Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
len)
            -- this should never happen:

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

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

data DecimalValue = DecimalValue Decimals LongInt
    deriving (DecimalValue -> DecimalValue -> Bool
(DecimalValue -> DecimalValue -> Bool)
-> (DecimalValue -> DecimalValue -> Bool) -> Eq DecimalValue
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
Eq DecimalValue
-> (DecimalValue -> DecimalValue -> Ordering)
-> (DecimalValue -> DecimalValue -> Bool)
-> (DecimalValue -> DecimalValue -> Bool)
-> (DecimalValue -> DecimalValue -> Bool)
-> (DecimalValue -> DecimalValue -> Bool)
-> (DecimalValue -> DecimalValue -> DecimalValue)
-> (DecimalValue -> DecimalValue -> DecimalValue)
-> Ord 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
$cp1Ord :: Eq DecimalValue
Ord, ReadPrec [DecimalValue]
ReadPrec DecimalValue
Int -> ReadS DecimalValue
ReadS [DecimalValue]
(Int -> ReadS DecimalValue)
-> ReadS [DecimalValue]
-> ReadPrec DecimalValue
-> ReadPrec [DecimalValue]
-> Read 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
(Int -> DecimalValue -> ShowS)
-> (DecimalValue -> String)
-> ([DecimalValue] -> ShowS)
-> Show DecimalValue
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 <- Get Word32
forall t. Binary t => Get t
get :: Get LongInt
      DecimalValue -> Get DecimalValue
forall (m :: * -> *) a. Monad m => a -> m a
return (DecimalValue -> Get DecimalValue)
-> DecimalValue -> Get DecimalValue
forall a b. (a -> b) -> a -> b
$ Word8 -> Word32 -> DecimalValue
DecimalValue Word8
a Word32
b

    put :: DecimalValue -> PutM ()
put (DecimalValue Word8
a Word32
b) = Word8 -> PutM ()
forall t. Binary t => t -> PutM ()
put Word8
a PutM () -> PutM () -> PutM ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Word32 -> PutM ()
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
(Int -> ConfirmationResult -> ShowS)
-> (ConfirmationResult -> String)
-> ([ConfirmationResult] -> ShowS)
-> Show ConfirmationResult
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