{-# LANGUAGE GADTs               #-}
{-# LANGUAGE OverloadedStrings   #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StandaloneDeriving  #-}

module Database.CQL.Protocol.Request
    ( Request           (..)
    , pack
    , encodeRequest
    , getOpCode

      -- ** Options
    , Options           (..)
    , encodeOptions

      -- ** Startup
    , Startup           (..)
    , encodeStartup

      -- ** Auth Response
    , AuthResponse      (..)
    , encodeAuthResponse

      -- ** Register
    , Register          (..)
    , EventType         (..)
    , encodeRegister
    , encodeEventType

      -- ** Query
    , Query             (..)
    , QueryParams       (..)
    , SerialConsistency (..)
    , encodeQuery
    , encodeQueryParams

      -- ** Batch
    , Batch             (..)
    , BatchQuery        (..)
    , BatchType         (..)
    , encodeBatch
    , encodeBatchType
    , encodeBatchQuery

      -- ** Prepare
    , Prepare           (..)
    , encodePrepare

      -- ** Execute
    , Execute           (..)
    , encodeExecute
    ) where

import Control.Applicative
import Data.Bits
import Data.ByteString.Lazy (ByteString)
import Data.Foldable (traverse_)
import Data.Int
import Data.Text (Text)
import Data.Maybe (isJust)
import Data.Monoid
import Data.Serialize hiding (decode, encode)
import Data.Word
import Database.CQL.Protocol.Tuple
import Database.CQL.Protocol.Codec
import Database.CQL.Protocol.Types
import Database.CQL.Protocol.Header
import Prelude

import qualified Data.ByteString.Lazy as LB

------------------------------------------------------------------------------
-- Request

-- | The type corresponding to the protocol request frame.
--
-- The type parameter 'k' denotes the kind of request. It is present to allow
-- distinguishing read operations from write operations. Use 'R' for read,
-- 'W' for write and 'S' for schema related operations.
--
-- 'a' represents the argument type and 'b' the return type of this request.
data Request k a b
    = RqStartup  !Startup
    | RqOptions  !Options
    | RqRegister !Register
    | RqBatch    !Batch
    | RqAuthResp !AuthResponse
    | RqPrepare  !(Prepare k a b)
    | RqQuery    !(Query k a b)
    | RqExecute  !(Execute k a b)
    deriving Int -> Request k a b -> ShowS
[Request k a b] -> ShowS
Request k a b -> String
(Int -> Request k a b -> ShowS)
-> (Request k a b -> String)
-> ([Request k a b] -> ShowS)
-> Show (Request k a b)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall k a b. Show a => Int -> Request k a b -> ShowS
forall k a b. Show a => [Request k a b] -> ShowS
forall k a b. Show a => Request k a b -> String
showList :: [Request k a b] -> ShowS
$cshowList :: forall k a b. Show a => [Request k a b] -> ShowS
show :: Request k a b -> String
$cshow :: forall k a b. Show a => Request k a b -> String
showsPrec :: Int -> Request k a b -> ShowS
$cshowsPrec :: forall k a b. Show a => Int -> Request k a b -> ShowS
Show

encodeRequest :: Tuple a => Version -> Putter (Request k a b)
encodeRequest :: Version -> Putter (Request k a b)
encodeRequest Version
_ (RqStartup  Startup
r) = Putter Startup
encodeStartup Startup
r
encodeRequest Version
_ (RqOptions  Options
r) = Putter Options
encodeOptions Options
r
encodeRequest Version
_ (RqRegister Register
r) = Putter Register
encodeRegister Register
r
encodeRequest Version
v (RqBatch    Batch
r) = Version -> Putter Batch
encodeBatch Version
v Batch
r
encodeRequest Version
_ (RqAuthResp AuthResponse
r) = Putter AuthResponse
encodeAuthResponse AuthResponse
r
encodeRequest Version
_ (RqPrepare  Prepare k a b
r) = Putter (Prepare k a b)
forall k a b. Putter (Prepare k a b)
encodePrepare Prepare k a b
r
encodeRequest Version
v (RqQuery    Query k a b
r) = Version -> Putter (Query k a b)
forall a k b. Tuple a => Version -> Putter (Query k a b)
encodeQuery Version
v Query k a b
r
encodeRequest Version
v (RqExecute  Execute k a b
r) = Version -> Putter (Execute k a b)
forall a k b. Tuple a => Version -> Putter (Execute k a b)
encodeExecute Version
v Execute k a b
r

-- | Serialise the given request, optionally using compression.
-- The result is either an error description in case of failure or a binary
-- protocol frame, including 'Header', 'Length' and body.
pack :: Tuple a
     => Version       -- ^ protocol version, which determines the encoding
     -> Compression   -- ^ compression to use
     -> Bool          -- ^ enable/disable tracing
     -> StreamId      -- ^ the stream Id to use
     -> Request k a b -- ^ the actual request to serialise
     -> Either String ByteString
pack :: Version
-> Compression
-> Bool
-> StreamId
-> Request k a b
-> Either String ByteString
pack Version
v Compression
c Bool
t StreamId
i Request k a b
r = do
    ByteString
body <- Compression -> ByteString -> Either String ByteString
runCompression Compression
c (Put -> ByteString
runPutLazy (Put -> ByteString) -> Put -> ByteString
forall a b. (a -> b) -> a -> b
$ Version -> Putter (Request k a b)
forall a k b. Tuple a => Version -> Putter (Request k a b)
encodeRequest Version
v Request k a b
r)
    let len :: Length
len = Int32 -> Length
Length (Int32 -> Length) -> (Int64 -> Int32) -> Int64 -> Length
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int64 -> Int32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int64 -> Length) -> Int64 -> Length
forall a b. (a -> b) -> a -> b
$ ByteString -> Int64
LB.length ByteString
body
    ByteString -> Either String ByteString
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString -> Either String ByteString)
-> (Put -> ByteString) -> Put -> Either String ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Put -> ByteString
runPutLazy (Put -> Either String ByteString)
-> Put -> Either String ByteString
forall a b. (a -> b) -> a -> b
$ do
        Version
-> HeaderType -> Flags -> StreamId -> OpCode -> Length -> Put
encodeHeader Version
v HeaderType
RqHeader Flags
mkFlags StreamId
i (Request k a b -> OpCode
forall k a b. Request k a b -> OpCode
getOpCode Request k a b
r) Length
len
        Putter ByteString
putLazyByteString ByteString
body
  where
    runCompression :: Compression -> ByteString -> Either String ByteString
runCompression Compression
f ByteString
x = Either String ByteString
-> (ByteString -> Either String ByteString)
-> Maybe ByteString
-> Either String ByteString
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Either String ByteString
forall b. Either String b
compressError ByteString -> Either String ByteString
forall (m :: * -> *) a. Monad m => a -> m a
return (Compression -> ByteString -> Maybe ByteString
shrink Compression
f (ByteString -> Maybe ByteString) -> ByteString -> Maybe ByteString
forall a b. (a -> b) -> a -> b
$ ByteString
x)
    compressError :: Either String b
compressError      = String -> Either String b
forall a b. a -> Either a b
Left String
"pack: compression failure"

    mkFlags :: Flags
mkFlags = (if Bool
t then Flags
tracing else Flags
forall a. Monoid a => a
mempty)
        Flags -> Flags -> Flags
forall a. Semigroup a => a -> a -> a
<> (if Compression -> CompressionAlgorithm
algorithm Compression
c CompressionAlgorithm -> CompressionAlgorithm -> Bool
forall a. Eq a => a -> a -> Bool
/= CompressionAlgorithm
None then Flags
compress else Flags
forall a. Monoid a => a
mempty)

-- | Get the protocol 'OpCode' corresponding to the given 'Request'.
getOpCode :: Request k a b -> OpCode
getOpCode :: Request k a b -> OpCode
getOpCode (RqQuery Query k a b
_)    = OpCode
OcQuery
getOpCode (RqExecute Execute k a b
_)  = OpCode
OcExecute
getOpCode (RqPrepare Prepare k a b
_)  = OpCode
OcPrepare
getOpCode (RqBatch Batch
_)    = OpCode
OcBatch
getOpCode (RqRegister Register
_) = OpCode
OcRegister
getOpCode (RqOptions Options
_)  = OpCode
OcOptions
getOpCode (RqStartup Startup
_)  = OpCode
OcStartup
getOpCode (RqAuthResp AuthResponse
_) = OpCode
OcAuthResponse

------------------------------------------------------------------------------
-- STARTUP

-- | A startup request which is used when initialising a connection to the
-- server. It specifies the CQL version to use and optionally the
-- compression algorithm.
data Startup = Startup !CqlVersion !CompressionAlgorithm deriving Int -> Startup -> ShowS
[Startup] -> ShowS
Startup -> String
(Int -> Startup -> ShowS)
-> (Startup -> String) -> ([Startup] -> ShowS) -> Show Startup
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Startup] -> ShowS
$cshowList :: [Startup] -> ShowS
show :: Startup -> String
$cshow :: Startup -> String
showsPrec :: Int -> Startup -> ShowS
$cshowsPrec :: Int -> Startup -> ShowS
Show

encodeStartup :: Putter Startup
encodeStartup :: Putter Startup
encodeStartup (Startup CqlVersion
v CompressionAlgorithm
c) =
    Putter [(Text, Text)]
encodeMap Putter [(Text, Text)] -> Putter [(Text, Text)]
forall a b. (a -> b) -> a -> b
$ (Text
"CQL_VERSION", CqlVersion -> Text
mapVersion CqlVersion
v) (Text, Text) -> [(Text, Text)] -> [(Text, Text)]
forall a. a -> [a] -> [a]
: CompressionAlgorithm -> [(Text, Text)]
mapCompression CompressionAlgorithm
c
  where
    mapVersion :: CqlVersion -> Text
    mapVersion :: CqlVersion -> Text
mapVersion CqlVersion
Cqlv300        = Text
"3.0.0"
    mapVersion (CqlVersion Text
s) = Text
s

    mapCompression :: CompressionAlgorithm -> [(Text, Text)]
    mapCompression :: CompressionAlgorithm -> [(Text, Text)]
mapCompression CompressionAlgorithm
Snappy = [(Text
"COMPRESSION", Text
"snappy")]
    mapCompression CompressionAlgorithm
LZ4    = [(Text
"COMPRESSION", Text
"lz4")]
    mapCompression CompressionAlgorithm
None   = []

------------------------------------------------------------------------------
-- AUTH_RESPONSE

-- | A request send in response to a previous authentication challenge.
newtype AuthResponse = AuthResponse LB.ByteString deriving Int -> AuthResponse -> ShowS
[AuthResponse] -> ShowS
AuthResponse -> String
(Int -> AuthResponse -> ShowS)
-> (AuthResponse -> String)
-> ([AuthResponse] -> ShowS)
-> Show AuthResponse
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AuthResponse] -> ShowS
$cshowList :: [AuthResponse] -> ShowS
show :: AuthResponse -> String
$cshow :: AuthResponse -> String
showsPrec :: Int -> AuthResponse -> ShowS
$cshowsPrec :: Int -> AuthResponse -> ShowS
Show

encodeAuthResponse :: Putter AuthResponse
encodeAuthResponse :: Putter AuthResponse
encodeAuthResponse (AuthResponse ByteString
b) = Putter ByteString
encodeBytes ByteString
b

------------------------------------------------------------------------------
-- OPTIONS

-- | An options request, send prior to 'Startup' to request the server's
-- startup options.
data Options = Options deriving Int -> Options -> ShowS
[Options] -> ShowS
Options -> String
(Int -> Options -> ShowS)
-> (Options -> String) -> ([Options] -> ShowS) -> Show Options
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Options] -> ShowS
$cshowList :: [Options] -> ShowS
show :: Options -> String
$cshow :: Options -> String
showsPrec :: Int -> Options -> ShowS
$cshowsPrec :: Int -> Options -> ShowS
Show

encodeOptions :: Putter Options
encodeOptions :: Putter Options
encodeOptions Options
_ = () -> Put
forall (m :: * -> *) a. Monad m => a -> m a
return ()

------------------------------------------------------------------------------
-- QUERY

-- | A CQL query (select, insert, etc.).
data Query k a b = Query !(QueryString k a b) !(QueryParams a) deriving Int -> Query k a b -> ShowS
[Query k a b] -> ShowS
Query k a b -> String
(Int -> Query k a b -> ShowS)
-> (Query k a b -> String)
-> ([Query k a b] -> ShowS)
-> Show (Query k a b)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall k a b. Show a => Int -> Query k a b -> ShowS
forall k a b. Show a => [Query k a b] -> ShowS
forall k a b. Show a => Query k a b -> String
showList :: [Query k a b] -> ShowS
$cshowList :: forall k a b. Show a => [Query k a b] -> ShowS
show :: Query k a b -> String
$cshow :: forall k a b. Show a => Query k a b -> String
showsPrec :: Int -> Query k a b -> ShowS
$cshowsPrec :: forall k a b. Show a => Int -> Query k a b -> ShowS
Show

encodeQuery :: Tuple a => Version -> Putter (Query k a b)
encodeQuery :: Version -> Putter (Query k a b)
encodeQuery Version
v (Query (QueryString Text
s) QueryParams a
p) =
    Putter Text
encodeLongString Text
s Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Version -> Putter (QueryParams a)
forall a. Tuple a => Version -> Putter (QueryParams a)
encodeQueryParams Version
v QueryParams a
p

------------------------------------------------------------------------------
-- EXECUTE

-- | Executes a prepared query.
data Execute k a b = Execute !(QueryId k a b) !(QueryParams a) deriving Int -> Execute k a b -> ShowS
[Execute k a b] -> ShowS
Execute k a b -> String
(Int -> Execute k a b -> ShowS)
-> (Execute k a b -> String)
-> ([Execute k a b] -> ShowS)
-> Show (Execute k a b)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall k a b. Show a => Int -> Execute k a b -> ShowS
forall k a b. Show a => [Execute k a b] -> ShowS
forall k a b. Show a => Execute k a b -> String
showList :: [Execute k a b] -> ShowS
$cshowList :: forall k a b. Show a => [Execute k a b] -> ShowS
show :: Execute k a b -> String
$cshow :: forall k a b. Show a => Execute k a b -> String
showsPrec :: Int -> Execute k a b -> ShowS
$cshowsPrec :: forall k a b. Show a => Int -> Execute k a b -> ShowS
Show

encodeExecute :: Tuple a => Version -> Putter (Execute k a b)
encodeExecute :: Version -> Putter (Execute k a b)
encodeExecute Version
v (Execute (QueryId ByteString
q) QueryParams a
p) =
    Putter ByteString
encodeShortBytes ByteString
q Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Version -> Putter (QueryParams a)
forall a. Tuple a => Version -> Putter (QueryParams a)
encodeQueryParams Version
v QueryParams a
p

------------------------------------------------------------------------------
-- PREPARE

-- | Prepare a query for later execution (cf. 'Execute').
newtype Prepare k a b = Prepare (QueryString k a b) deriving Int -> Prepare k a b -> ShowS
[Prepare k a b] -> ShowS
Prepare k a b -> String
(Int -> Prepare k a b -> ShowS)
-> (Prepare k a b -> String)
-> ([Prepare k a b] -> ShowS)
-> Show (Prepare k a b)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall k a b. Int -> Prepare k a b -> ShowS
forall k a b. [Prepare k a b] -> ShowS
forall k a b. Prepare k a b -> String
showList :: [Prepare k a b] -> ShowS
$cshowList :: forall k a b. [Prepare k a b] -> ShowS
show :: Prepare k a b -> String
$cshow :: forall k a b. Prepare k a b -> String
showsPrec :: Int -> Prepare k a b -> ShowS
$cshowsPrec :: forall k a b. Int -> Prepare k a b -> ShowS
Show

encodePrepare :: Putter (Prepare k a b)
encodePrepare :: Putter (Prepare k a b)
encodePrepare (Prepare (QueryString Text
p)) = Putter Text
encodeLongString Text
p

------------------------------------------------------------------------------
-- REGISTER

-- | Register's the connection this request is made through, to receive
-- server events.
newtype Register = Register [EventType] deriving Int -> Register -> ShowS
[Register] -> ShowS
Register -> String
(Int -> Register -> ShowS)
-> (Register -> String) -> ([Register] -> ShowS) -> Show Register
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Register] -> ShowS
$cshowList :: [Register] -> ShowS
show :: Register -> String
$cshow :: Register -> String
showsPrec :: Int -> Register -> ShowS
$cshowsPrec :: Int -> Register -> ShowS
Show

encodeRegister :: Putter Register
encodeRegister :: Putter Register
encodeRegister (Register [EventType]
t) = do
    Putter Word16
encodeShort (Int -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral ([EventType] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [EventType]
t))
    (EventType -> Put) -> [EventType] -> Put
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ EventType -> Put
encodeEventType [EventType]
t

-- | Event types to register.
data EventType
    = TopologyChangeEvent -- ^ events related to change in the cluster topology
    | StatusChangeEvent   -- ^ events related to change of node status
    | SchemaChangeEvent   -- ^ events related to schema change
    deriving Int -> EventType -> ShowS
[EventType] -> ShowS
EventType -> String
(Int -> EventType -> ShowS)
-> (EventType -> String)
-> ([EventType] -> ShowS)
-> Show EventType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [EventType] -> ShowS
$cshowList :: [EventType] -> ShowS
show :: EventType -> String
$cshow :: EventType -> String
showsPrec :: Int -> EventType -> ShowS
$cshowsPrec :: Int -> EventType -> ShowS
Show

encodeEventType :: Putter EventType
encodeEventType :: EventType -> Put
encodeEventType EventType
TopologyChangeEvent = Putter Text
encodeString Text
"TOPOLOGY_CHANGE"
encodeEventType EventType
StatusChangeEvent   = Putter Text
encodeString Text
"STATUS_CHANGE"
encodeEventType EventType
SchemaChangeEvent   = Putter Text
encodeString Text
"SCHEMA_CHANGE"

------------------------------------------------------------------------------
-- BATCH

-- | Allows executing a list of queries (prepared or not) as a batch.
data Batch = Batch
    { Batch -> BatchType
batchType              :: !BatchType
    , Batch -> [BatchQuery]
batchQuery             :: [BatchQuery]
    , Batch -> Consistency
batchConsistency       :: !Consistency
    , Batch -> Maybe SerialConsistency
batchSerialConsistency :: Maybe SerialConsistency
    } deriving Int -> Batch -> ShowS
[Batch] -> ShowS
Batch -> String
(Int -> Batch -> ShowS)
-> (Batch -> String) -> ([Batch] -> ShowS) -> Show Batch
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Batch] -> ShowS
$cshowList :: [Batch] -> ShowS
show :: Batch -> String
$cshow :: Batch -> String
showsPrec :: Int -> Batch -> ShowS
$cshowsPrec :: Int -> Batch -> ShowS
Show

data BatchType
    = BatchLogged   -- ^ default, uses a batch log for atomic application
    | BatchUnLogged -- ^ skip the batch log
    | BatchCounter  -- ^ used for batched counter updates
    deriving (Int -> BatchType -> ShowS
[BatchType] -> ShowS
BatchType -> String
(Int -> BatchType -> ShowS)
-> (BatchType -> String)
-> ([BatchType] -> ShowS)
-> Show BatchType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [BatchType] -> ShowS
$cshowList :: [BatchType] -> ShowS
show :: BatchType -> String
$cshow :: BatchType -> String
showsPrec :: Int -> BatchType -> ShowS
$cshowsPrec :: Int -> BatchType -> ShowS
Show)

encodeBatch :: Version -> Putter Batch
encodeBatch :: Version -> Putter Batch
encodeBatch Version
v (Batch BatchType
t [BatchQuery]
q Consistency
c Maybe SerialConsistency
s) = do
    Putter BatchType
encodeBatchType BatchType
t
    Putter Word16
encodeShort (Int -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral ([BatchQuery] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [BatchQuery]
q))
    (BatchQuery -> Put) -> [BatchQuery] -> Put
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (Version -> BatchQuery -> Put
encodeBatchQuery Version
v) [BatchQuery]
q
    Putter Consistency
encodeConsistency Consistency
c
    Putter Word8
forall t. Serialize t => Putter t
put Word8
batchFlags
    Putter Consistency -> Maybe Consistency -> Put
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ Putter Consistency
encodeConsistency (SerialConsistency -> Consistency
mapCons (SerialConsistency -> Consistency)
-> Maybe SerialConsistency -> Maybe Consistency
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe SerialConsistency
s)
  where
    batchFlags :: Word8
    batchFlags :: Word8
batchFlags = if Maybe SerialConsistency -> Bool
forall a. Maybe a -> Bool
isJust Maybe SerialConsistency
s then Word8
0x10 else Word8
0x0

encodeBatchType :: Putter BatchType
encodeBatchType :: Putter BatchType
encodeBatchType BatchType
BatchLogged   = Putter Word8
putWord8 Word8
0
encodeBatchType BatchType
BatchUnLogged = Putter Word8
putWord8 Word8
1
encodeBatchType BatchType
BatchCounter  = Putter Word8
putWord8 Word8
2

-- | A GADT to unify queries and prepared queries both of which can be used
-- in batch requests.
data BatchQuery where
    BatchQuery :: (Show a, Tuple a, Tuple b)
               => !(QueryString W a b)
               -> !a
               -> BatchQuery

    BatchPrepared :: (Show a, Tuple a, Tuple b)
                  => !(QueryId W a b)
                  -> !a
                  -> BatchQuery

deriving instance Show BatchQuery

encodeBatchQuery :: Version -> Putter BatchQuery
encodeBatchQuery :: Version -> BatchQuery -> Put
encodeBatchQuery Version
n (BatchQuery (QueryString Text
q) a
v) = do
    Putter Word8
putWord8 Word8
0
    Putter Text
encodeLongString Text
q
    Version -> Putter a
forall a. PrivateTuple a => Version -> Putter a
store Version
n a
v
encodeBatchQuery Version
n (BatchPrepared (QueryId ByteString
i) a
v)  = do
    Putter Word8
putWord8 Word8
1
    Putter ByteString
encodeShortBytes ByteString
i
    Version -> Putter a
forall a. PrivateTuple a => Version -> Putter a
store Version
n a
v

------------------------------------------------------------------------------
-- Query Parameters

-- | Query parameters.
data QueryParams a = QueryParams
    { QueryParams a -> Consistency
consistency :: !Consistency
        -- ^ (Regular) consistency level to use.
    , QueryParams a -> Bool
skipMetaData :: !Bool
        -- ^ Whether to omit the metadata in the 'Response'
        -- of the query. This is an optimisation only relevant for
        -- use with prepared queries, for which the metadata obtained
        -- from the 'PreparedResult' may be reused.
    , QueryParams a -> a
values :: a
        -- ^ The bound parameters of the query.
    , QueryParams a -> Maybe Int32
pageSize :: Maybe Int32
        -- ^ The desired maximum result set size.
    , QueryParams a -> Maybe PagingState
queryPagingState :: Maybe PagingState
        -- ^ The current paging state that determines the "offset"
        -- of the results to return for a read query.
    , QueryParams a -> Maybe SerialConsistency
serialConsistency :: Maybe SerialConsistency
        -- ^ Serial consistency level to use for conditional updates
        -- (aka "lightweight transactions"). Irrelevant for any other queries.
    , QueryParams a -> Maybe Bool
enableTracing :: Maybe Bool
        -- ^ Whether tracing should be enabled for the query, in which case the
        -- 'Response' will carry a 'traceId'.
    } deriving Int -> QueryParams a -> ShowS
[QueryParams a] -> ShowS
QueryParams a -> String
(Int -> QueryParams a -> ShowS)
-> (QueryParams a -> String)
-> ([QueryParams a] -> ShowS)
-> Show (QueryParams a)
forall a. Show a => Int -> QueryParams a -> ShowS
forall a. Show a => [QueryParams a] -> ShowS
forall a. Show a => QueryParams a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [QueryParams a] -> ShowS
$cshowList :: forall a. Show a => [QueryParams a] -> ShowS
show :: QueryParams a -> String
$cshow :: forall a. Show a => QueryParams a -> String
showsPrec :: Int -> QueryParams a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> QueryParams a -> ShowS
Show

-- | Consistency level for the serial phase of conditional updates
-- (aka "lightweight transactions").
--
-- See: <https://docs.datastax.com/en/cassandra/latest/cassandra/dml/dmlConfigSerialConsistency.html SerialConsistency>
data SerialConsistency
    = SerialConsistency
        -- ^ Default. Quorum-based linearizable consistency.
    | LocalSerialConsistency
        -- ^ Like 'SerialConsistency' except confined to a single (logical)
        -- data center.
    deriving Int -> SerialConsistency -> ShowS
[SerialConsistency] -> ShowS
SerialConsistency -> String
(Int -> SerialConsistency -> ShowS)
-> (SerialConsistency -> String)
-> ([SerialConsistency] -> ShowS)
-> Show SerialConsistency
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SerialConsistency] -> ShowS
$cshowList :: [SerialConsistency] -> ShowS
show :: SerialConsistency -> String
$cshow :: SerialConsistency -> String
showsPrec :: Int -> SerialConsistency -> ShowS
$cshowsPrec :: Int -> SerialConsistency -> ShowS
Show

encodeQueryParams :: forall a. Tuple a => Version -> Putter (QueryParams a)
encodeQueryParams :: Version -> Putter (QueryParams a)
encodeQueryParams Version
v QueryParams a
p = do
    Putter Consistency
encodeConsistency (QueryParams a -> Consistency
forall a. QueryParams a -> Consistency
consistency QueryParams a
p)
    Putter Word8
forall t. Serialize t => Putter t
put Word8
queryFlags
    Version -> Putter a
forall a. PrivateTuple a => Version -> Putter a
store Version
v (QueryParams a -> a
forall a. QueryParams a -> a
values QueryParams a
p)
    (Int32 -> Put) -> Maybe Int32 -> Put
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ Int32 -> Put
encodeInt         (QueryParams a -> Maybe Int32
forall a. QueryParams a -> Maybe Int32
pageSize QueryParams a
p)
    (PagingState -> Put) -> Maybe PagingState -> Put
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ PagingState -> Put
encodePagingState (QueryParams a -> Maybe PagingState
forall a. QueryParams a -> Maybe PagingState
queryPagingState QueryParams a
p)
    Putter Consistency -> Maybe Consistency -> Put
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ Putter Consistency
encodeConsistency (SerialConsistency -> Consistency
mapCons (SerialConsistency -> Consistency)
-> Maybe SerialConsistency -> Maybe Consistency
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> QueryParams a -> Maybe SerialConsistency
forall a. QueryParams a -> Maybe SerialConsistency
serialConsistency QueryParams a
p)
  where
    queryFlags :: Word8
    queryFlags :: Word8
queryFlags =
            (if Bool
hasValues                    then Word8
0x01 else Word8
0x0)
        Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.|. (if QueryParams a -> Bool
forall a. QueryParams a -> Bool
skipMetaData QueryParams a
p               then Word8
0x02 else Word8
0x0)
        Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.|. (if Maybe Int32 -> Bool
forall a. Maybe a -> Bool
isJust (QueryParams a -> Maybe Int32
forall a. QueryParams a -> Maybe Int32
pageSize QueryParams a
p)          then Word8
0x04 else Word8
0x0)
        Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.|. (if Maybe PagingState -> Bool
forall a. Maybe a -> Bool
isJust (QueryParams a -> Maybe PagingState
forall a. QueryParams a -> Maybe PagingState
queryPagingState QueryParams a
p)  then Word8
0x08 else Word8
0x0)
        Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.|. (if Maybe SerialConsistency -> Bool
forall a. Maybe a -> Bool
isJust (QueryParams a -> Maybe SerialConsistency
forall a. QueryParams a -> Maybe SerialConsistency
serialConsistency QueryParams a
p) then Word8
0x10 else Word8
0x0)

    hasValues :: Bool
hasValues = Tagged a Int -> Int
forall a b. Tagged a b -> b
untag (Tagged a Int
forall a. PrivateTuple a => Tagged a Int
count :: Tagged a Int) Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
0

mapCons :: SerialConsistency -> Consistency
mapCons :: SerialConsistency -> Consistency
mapCons SerialConsistency
SerialConsistency      = Consistency
Serial
mapCons SerialConsistency
LocalSerialConsistency = Consistency
LocalSerial