cql-io-1.0.1: Cassandra CQL client.

Safe HaskellNone
LanguageHaskell2010

Database.CQL.IO

Contents

Description

This driver operates on some state which must be initialised prior to executing client operations and terminated eventually. The library uses tinylog for its logging output and expects a Logger.

For example (here using the OverloadedStrings extension) :

> import Data.Text (Text)
> import Data.Functor.Identity
> import Database.CQL.IO as Client
> import qualified System.Logger as Logger
>
> g <- Logger.new Logger.defSettings
> c <- Client.init g defSettings
> let q = "SELECT cql_version from system.local" :: QueryString R () (Identity Text)
> let p = defQueryParams One ()
> runClient c (query q p)
[Identity "3.4.4"]
> shutdown c

Note on prepared statements

Prepared statements are fully supported but imply certain complexities which lead to some assumptions beyond the scope of the CQL binary protocol specification (spec):

  1. The spec scopes the QueryId to the node the query has been prepared with. The spec does not state anything about the format of the QueryId, however it seems that at least the official Java driver assumes that any given QueryString yields the same QueryId on every node. We make the same assumption.
  2. In case a node does not know a given QueryId an Unprepared error is returned. We assume that it is always safe to then transparently re-prepare the corresponding QueryString and to re-execute the original request against the same node.

Besides these assumptions there is also a potential tradeoff in regards to eager vs. lazy query preparation. We understand eager to mean preparation against all current nodes of a cluster and lazy to mean preparation against a single node if required, i.e. after an Unprepared error response. Which strategy to choose depends on the scope of query reuse and the size of the cluster. The global default can be changed through the Settings module and per action using withPrepareStrategy.

Synopsis

Client Settings

defSettings :: Settings Source #

Default settings:

  • contact point is "localhost" port 9042
  • load-balancing policy is random
  • binary protocol version is 3
  • connection idle timeout is 60s
  • the connection pool uses 4 stripes to mitigate thread contention
  • connections use a connect timeout of 5s, a send timeout of 3s and a receive timeout of 10s
  • 128 streams per connection are used
  • 16k receive buffer size
  • no compression is applied to frame bodies
  • no default keyspace is used.
  • no retries are done
  • lazy prepare strategy

addContact :: String -> Settings -> Settings Source #

Add an additional host to the contact list.

setCompression :: Compression -> Settings -> Settings Source #

Set the compression to use for frame body compression.

setConnectTimeout :: NominalDiffTime -> Settings -> Settings Source #

Set the connect timeout of a connection.

setContacts :: String -> [String] -> Settings -> Settings Source #

Set the initial contact points (hosts) from which node discovery will start.

setIdleTimeout :: NominalDiffTime -> Settings -> Settings Source #

Set the connection idle timeout. Connections in a pool will be closed if not in use for longer than this timeout.

setKeyspace :: Keyspace -> Settings -> Settings Source #

Set the default keyspace to use. Every new connection will be initialised to use this keyspace.

setMaxConnections :: Int -> Settings -> Settings Source #

Maximum connections per pool stripe.

setMaxStreams :: Int -> Settings -> Settings Source #

Set the maximum number of streams per connection. In version 2 of the binary protocol at most 128 streams can be used. Version 3 supports up to 32768 streams.

setMaxTimeouts :: Int -> Settings -> Settings Source #

When receiving a response times out, we can no longer use the stream of the connection that was used to make the request as it is uncertain if a response will arrive later. Thus the bandwith of a connection will be decreased. This settings defines a threshold after which we close the connection to get a new one with all streams available.

setPolicy :: IO Policy -> Settings -> Settings Source #

Set the load-balancing policy.

setPoolStripes :: Int -> Settings -> Settings Source #

Set the number of pool stripes to use. A good setting is equal to the number of CPU cores this codes is running on.

setPortNumber :: PortNumber -> Settings -> Settings Source #

Set the portnumber to use to connect on every node of the cluster.

setPrepareStrategy :: PrepareStrategy -> Settings -> Settings Source #

Set strategy to use for preparing statements.

setProtocolVersion :: Version -> Settings -> Settings Source #

Set the binary protocol version to use.

setResponseTimeout :: NominalDiffTime -> Settings -> Settings Source #

Set the receive timeout of a connection. Requests exceeding the receive timeout will fail with a Timeout exception.

setSendTimeout :: NominalDiffTime -> Settings -> Settings Source #

Set the send timeout of a connection. Request exceeding the send will cause the connection to be closed and fail with ConnectionClosed exception.

setRetrySettings :: RetrySettings -> Settings -> Settings Source #

Set default retry settings to use.

setMaxRecvBuffer :: Int -> Settings -> Settings Source #

Set maximum receive buffer size.

The actual buffer size used will be the minimum of the CQL response size and the value set here.

setSSLContext :: SSLContext -> Settings -> Settings Source #

Set a fully configured SSL context.

This will make client server queries use TLS.

Authentication

setAuthentication :: [Authenticator] -> Settings -> Settings Source #

Set the supported authentication mechanisms.

When a Cassandra server requests authentication on a connection, it specifies the requested AuthMechanism. The client Authenticator is chosen based that name. If no authenticator with a matching name is configured, an AuthenticationError is thrown.

data Authenticator Source #

A client authentication handler.

The fields of an Authenticator must implement the client-side of an (SASL) authentication mechanism as follows:

  • When a Cassandra server requests authentication on a new connection, authOnRequest is called with the AuthContext of the connection.
  • If additional challenges are posed by the server, authOnChallenge is called, if available, otherwise an AuthenticationError is thrown, i.e. every challenge must be answered.
  • Upon successful authentication authOnSuccess is called.

The existential type s is chosen by an implementation and can be used to thread arbitrary state through the sequence of callback invocations during an authentication exchange.

See also: RFC4422 Authentication

Constructors

Authenticator 

Fields

data AuthContext Source #

Context information given to Authenticators when the server requests authentication on a connection. See authOnRequest.

newtype AuthMechanism Source #

The (unique) name of a SASL authentication mechanism.

In the case of Cassandra, this is currently always the fully-qualified Java class name of the configured server-side IAuthenticator implementation.

Constructors

AuthMechanism Text 

newtype AuthUser Source #

Constructors

AuthUser Text 

newtype AuthPass Source #

Constructors

AuthPass Text 

passwordAuthenticator :: AuthUser -> AuthPass -> Authenticator Source #

A password authentication handler for use with Cassandra's PasswordAuthenticator.

See: Configuring Authentication

Retry Settings

noRetry :: RetrySettings Source #

Never retry.

retryForever :: RetrySettings Source #

Forever retry immediately.

maxRetries :: Word -> RetrySettings -> RetrySettings Source #

Limit number of retries.

adjustConsistency :: Consistency -> RetrySettings -> RetrySettings Source #

When retrying a (batch-) query, change consistency to the given value.

constDelay :: NominalDiffTime -> RetrySettings -> RetrySettings Source #

Wait a constant time between retries.

expBackoff Source #

Arguments

:: NominalDiffTime

Initial delay.

-> NominalDiffTime

Maximum delay.

-> RetrySettings 
-> RetrySettings 

Delay retries with exponential backoff.

fibBackoff Source #

Arguments

:: NominalDiffTime

Initial delay.

-> NominalDiffTime

Maximum delay.

-> RetrySettings 
-> RetrySettings 

Delay retries using Fibonacci sequence as backoff.

adjustSendTimeout :: NominalDiffTime -> RetrySettings -> RetrySettings Source #

On retry adjust the send timeout.

adjustResponseTimeout :: NominalDiffTime -> RetrySettings -> RetrySettings Source #

On retry adjust the response timeout.

Load-balancing

data Policy Source #

A policy defines a load-balancing strategy and generally handles host visibility.

Constructors

Policy 

Fields

  • setup :: [Host] -> [Host] -> IO ()

    Initialise the policy with two sets of hosts. The first parameter are hosts known to be available, the second are other nodes. Please note that a policy may be re-initialised at any point through this method.

  • onEvent :: HostEvent -> IO ()

    Event handler. Policies will be informed about cluster changes through this function.

  • select :: IO (Maybe Host)

    Host selection. The driver will ask for a host to use in a query through this function. A policy which has no available nodes may return Nothing.

  • current :: IO [Host]

    Return all currently alive hosts.

  • acceptable :: Host -> IO Bool

    During startup and node discovery, the driver will ask the policy if a dicovered host should be ignored.

  • hostCount :: IO Word

    During query processing, the driver will ask the policy for a rough esitimate of alive hosts. The number is used to repeatedly invoke select (with the underlying assumption that the policy returns mostly different hosts).

  • display :: IO String

    Like having an effectful Show instance for this policy.

random :: IO Policy Source #

Return hosts in random order.

roundRobin :: IO Policy Source #

Iterate over hosts one by one.

Hosts

data Host Source #

Host representation.

Instances

Eq Host Source # 

Methods

(==) :: Host -> Host -> Bool #

(/=) :: Host -> Host -> Bool #

Ord Host Source # 

Methods

compare :: Host -> Host -> Ordering #

(<) :: Host -> Host -> Bool #

(<=) :: Host -> Host -> Bool #

(>) :: Host -> Host -> Bool #

(>=) :: Host -> Host -> Bool #

max :: Host -> Host -> Host #

min :: Host -> Host -> Host #

Show Host Source # 

Methods

showsPrec :: Int -> Host -> ShowS #

show :: Host -> String #

showList :: [Host] -> ShowS #

ToBytes Host Source # 

Methods

bytes :: Host -> Builder #

data HostEvent Source #

This event will be passed to a Policy to inform it about cluster changes.

Constructors

HostNew !Host

a new host has been added to the cluster

HostGone !InetAddr

a host has been removed from the cluster

HostUp !InetAddr

a host has been started

HostDown !InetAddr

a host has been stopped

hostAddr :: Lens' Host InetAddr Source #

The IP address and port number of this host.

dataCentre :: Lens' Host Text Source #

The data centre name (may be an empty string).

rack :: Lens' Host Text Source #

The rack name (may be an empty string).

Client Monad

data Client a Source #

The Client monad.

A simple reader monad around some internal state. Prior to executing this monad via runClient, its state must be initialised through init and after finishing operation it should be terminated with shutdown.

To lift Client actions into another monad, see MonadClient.

Instances

Monad Client Source # 

Methods

(>>=) :: Client a -> (a -> Client b) -> Client b #

(>>) :: Client a -> Client b -> Client b #

return :: a -> Client a #

fail :: String -> Client a #

Functor Client Source # 

Methods

fmap :: (a -> b) -> Client a -> Client b #

(<$) :: a -> Client b -> Client a #

Applicative Client Source # 

Methods

pure :: a -> Client a #

(<*>) :: Client (a -> b) -> Client a -> Client b #

liftA2 :: (a -> b -> c) -> Client a -> Client b -> Client c #

(*>) :: Client a -> Client b -> Client b #

(<*) :: Client a -> Client b -> Client a #

MonadIO Client Source # 

Methods

liftIO :: IO a -> Client a #

MonadThrow Client Source # 

Methods

throwM :: Exception e => e -> Client a #

MonadCatch Client Source # 

Methods

catch :: Exception e => Client a -> (e -> Client a) -> Client a #

MonadMask Client Source # 

Methods

mask :: ((forall a. Client a -> Client a) -> Client b) -> Client b #

uninterruptibleMask :: ((forall a. Client a -> Client a) -> Client b) -> Client b #

generalBracket :: Client a -> (a -> ExitCase b -> Client c) -> (a -> Client b) -> Client (b, c) #

MonadLogger Client Source # 

Methods

log :: Level -> (Msg -> Msg) -> Client () #

MonadClient Client Source # 
MonadReader ClientState Client Source # 
MonadBase IO Client Source # 

Methods

liftBase :: IO α -> Client α #

MonadBaseControl IO Client Source # 

Associated Types

type StM (Client :: * -> *) a :: * #

Methods

liftBaseWith :: (RunInBase Client IO -> IO a) -> Client a #

restoreM :: StM Client a -> Client a #

type StM Client a Source # 

class (Functor m, Applicative m, Monad m, MonadIO m, MonadCatch m) => MonadClient m where Source #

Monads in which Client actions may be embedded.

Minimal complete definition

liftClient, localState

Methods

liftClient :: Client a -> m a Source #

Lift a computation from the Client monad.

localState :: (ClientState -> ClientState) -> m a -> m a Source #

Execute an action with a modified ClientState.

data ClientState Source #

Opaque client state/environment.

data DebugInfo Source #

Constructors

DebugInfo 

Fields

init :: MonadIO m => Logger -> Settings -> m ClientState Source #

Initialise client state with the given Settings using the provided Logger for all it's logging output.

runClient :: MonadIO m => ClientState -> Client a -> m a Source #

Execute the client monad.

shutdown :: MonadIO m => ClientState -> m () Source #

Terminate client state, i.e. end all running background checks and shutdown all connection pools. Once this is entered, the client will eventually be shut down, though an asynchronous exception can interrupt the wait for that to occur.

Queries

data R :: * #

Type tag for read queries, i.e. 'QueryString R a b'.

data W :: * #

Type tag for write queries, i.e. 'QueryString W a b'.

data S :: * #

Type tag for schema queries, i.e. 'QueryString S a b'.

data QueryParams a :: * -> * #

Query parameters.

Constructors

QueryParams 

Fields

  • consistency :: !Consistency

    (Regular) consistency level to use.

  • 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.

  • values :: a

    The bound parameters of the query.

  • pageSize :: Maybe Int32

    The desired maximum result set size.

  • queryPagingState :: Maybe PagingState

    The current paging state that determines the "offset" of the results to return for a read query.

  • serialConsistency :: Maybe SerialConsistency

    Serial consistency level to use for conditional updates (aka "lightweight transactions"). Irrelevant for any other queries.

  • enableTracing :: Maybe Bool

    Whether tracing should be enabled for the query, in which case the Response will carry a traceId.

Instances

defQueryParams :: Consistency -> a -> QueryParams a Source #

Construct default QueryParams for the given consistency and bound values. In particular, no page size, paging state or serial consistency will be set.

data Consistency :: * #

Consistency level.

See: Consistency

Constructors

Any 
One 
LocalOne 
Two 
Three 
Quorum 
LocalQuorum 
All 
EachQuorum

Only for write queries.

Serial

Only for read queries.

LocalSerial

Only for read queries.

data SerialConsistency :: * #

Consistency level for the serial phase of conditional updates (aka "lightweight transactions").

See: SerialConsistency

Constructors

SerialConsistency

Default. Quorum-based linearizable consistency.

LocalSerialConsistency

Like SerialConsistency except confined to a single (logical) data center.

newtype QueryString k a b :: * -> * -> * -> * #

Constructors

QueryString 

Fields

Instances

RunQ QueryString Source # 

Methods

runQ :: (MonadClient m, Tuple a, Tuple b) => QueryString k a b -> QueryParams a -> m (Response k a b) Source #

Eq (QueryString k a b) 

Methods

(==) :: QueryString k a b -> QueryString k a b -> Bool #

(/=) :: QueryString k a b -> QueryString k a b -> Bool #

Show (QueryString k a b) 

Methods

showsPrec :: Int -> QueryString k a b -> ShowS #

show :: QueryString k a b -> String #

showList :: [QueryString k a b] -> ShowS #

IsString (QueryString k a b) 

Methods

fromString :: String -> QueryString k a b #

Basic Queries

query :: (MonadClient m, Tuple a, Tuple b, RunQ q) => q R a b -> QueryParams a -> m [b] Source #

Run a CQL read-only query returning a list of results.

query1 :: (MonadClient m, Tuple a, Tuple b, RunQ q) => q R a b -> QueryParams a -> m (Maybe b) Source #

Run a CQL read-only query returning a single result.

write :: (MonadClient m, Tuple a, RunQ q) => q W a () -> QueryParams a -> m () Source #

Run a CQL write-only query (e.g. insert/update/delete), returning no result.

/Note: If the write operation is conditional, i.e. is in fact a "lightweight transaction" returning a result, trans must be used instead./

schema :: (MonadClient m, Tuple a, RunQ q) => q S a () -> QueryParams a -> m (Maybe SchemaChange) Source #

Run a CQL schema query, returning SchemaChange information, if any.

Prepared Queries

data PrepQuery k a b Source #

Representation of a prepared query. Actual preparation is handled transparently by the driver.

Instances

RunQ PrepQuery Source # 

Methods

runQ :: (MonadClient m, Tuple a, Tuple b) => PrepQuery k a b -> QueryParams a -> m (Response k a b) Source #

IsString (PrepQuery k a b) Source # 

Methods

fromString :: String -> PrepQuery k a b #

Paging

data Page a Source #

Return value of paginate. Contains the actual result values as well as an indication of whether there is more data available and the actual action to fetch the next page.

Constructors

Page 

Fields

Instances

Functor Page Source # 

Methods

fmap :: (a -> b) -> Page a -> Page b #

(<$) :: a -> Page b -> Page a #

emptyPage :: Page a Source #

A page with an empty result list.

paginate :: (MonadClient m, Tuple a, Tuple b, RunQ q) => q R a b -> QueryParams a -> m (Page b) Source #

Run a CQL read-only query against a Cassandra node.

This function is like query, but limits the result size to 10000 (default) unless there is an explicit size restriction given in QueryParams. The returned Page can be used to continue the query.

Please note that -- as of Cassandra 2.1.0 -- if your requested page size is equal to the result size, hasMore might be true and a subsequent nextPage will return an empty list in result.

Lightweight Transactions

data Row :: * #

A row is a vector of Values.

Instances

Eq Row 

Methods

(==) :: Row -> Row -> Bool #

(/=) :: Row -> Row -> Bool #

Show Row 

Methods

showsPrec :: Int -> Row -> ShowS #

show :: Row -> String #

showList :: [Row] -> ShowS #

PrivateTuple Row 
Tuple Row 

fromRow :: Cql a => Int -> Row -> Either String a #

Convert a row element.

trans :: (MonadClient m, Tuple a, RunQ q) => q W a Row -> QueryParams a -> m [Row] Source #

Run a CQL conditional write query (e.g. insert/update/delete) as a "lightweight transaction", returning the result Rows describing the outcome.

Batch Queries

data BatchM a Source #

Batch construction monad.

Instances

Monad BatchM Source # 

Methods

(>>=) :: BatchM a -> (a -> BatchM b) -> BatchM b #

(>>) :: BatchM a -> BatchM b -> BatchM b #

return :: a -> BatchM a #

fail :: String -> BatchM a #

Functor BatchM Source # 

Methods

fmap :: (a -> b) -> BatchM a -> BatchM b #

(<$) :: a -> BatchM b -> BatchM a #

Applicative BatchM Source # 

Methods

pure :: a -> BatchM a #

(<*>) :: BatchM (a -> b) -> BatchM a -> BatchM b #

liftA2 :: (a -> b -> c) -> BatchM a -> BatchM b -> BatchM c #

(*>) :: BatchM a -> BatchM b -> BatchM b #

(<*) :: BatchM a -> BatchM b -> BatchM a #

addQuery :: (Show a, Tuple a, Tuple b) => QueryString W a b -> a -> BatchM () Source #

Add a query to this batch.

addPrepQuery :: (Show a, Tuple a, Tuple b) => PrepQuery W a b -> a -> BatchM () Source #

Add a prepared query to this batch.

setType :: BatchType -> BatchM () Source #

Set the type of this batch.

setConsistency :: Consistency -> BatchM () Source #

Set Batch consistency level.

setSerialConsistency :: SerialConsistency -> BatchM () Source #

Set Batch serial consistency.

batch :: MonadClient m => BatchM () -> m () Source #

Run a batch query against a Cassandra node.

Retries

retry :: MonadClient m => RetrySettings -> m a -> m a Source #

Use given RetrySettings during execution of some client action.

once :: MonadClient m => m a -> m a Source #

Execute a client action once, without retries, i.e.

once action = retry noRetry action.

Primarily for use in applications where global RetrySettings are configured and need to be selectively disabled for individual queries.

Low-Level Queries

Note: Use of these low-level functions may require additional imports from Database.CQL.Protocol or its submodules in order to construct Requests and evaluate Responses.

class RunQ q where Source #

A type which can be run as a query.

Minimal complete definition

runQ

Methods

runQ :: (MonadClient m, Tuple a, Tuple b) => q k a b -> QueryParams a -> m (Response k a b) Source #

Instances

RunQ QueryString Source # 

Methods

runQ :: (MonadClient m, Tuple a, Tuple b) => QueryString k a b -> QueryParams a -> m (Response k a b) Source #

RunQ PrepQuery Source # 

Methods

runQ :: (MonadClient m, Tuple a, Tuple b) => PrepQuery k a b -> QueryParams a -> m (Response k a b) Source #

request :: (MonadClient m, Tuple a, Tuple b) => Request k a b -> m (Response k a b) Source #

Send a Request to the server and return a Response.

This function will first ask the clients load-balancing Policy for some host and use its connection pool to acquire a connection for request transmission.

If all available hosts are busy (i.e. their connection pools are fully utilised), the function will block until a connection becomes available or the maximum wait-queue length has been reached.

The request is retried according to the configured RetrySettings.

Exceptions