Safe Haskell | None |
---|---|
Language | Haskell2010 |
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):
- The spec scopes the
QueryId
to the node the query has been prepared with. The spec does not state anything about the format of theQueryId
, however it seems that at least the official Java driver assumes that any givenQueryString
yields the sameQueryId
on every node. We make the same assumption. - In case a node does not know a given
QueryId
anUnprepared
error is returned. We assume that it is always safe to then transparently re-prepare the correspondingQueryString
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
.
- data Settings
- defSettings :: Settings
- addContact :: String -> Settings -> Settings
- setCompression :: Compression -> Settings -> Settings
- setConnectTimeout :: NominalDiffTime -> Settings -> Settings
- setContacts :: String -> [String] -> Settings -> Settings
- setIdleTimeout :: NominalDiffTime -> Settings -> Settings
- setKeyspace :: Keyspace -> Settings -> Settings
- setMaxConnections :: Int -> Settings -> Settings
- setMaxStreams :: Int -> Settings -> Settings
- setMaxTimeouts :: Int -> Settings -> Settings
- setPolicy :: IO Policy -> Settings -> Settings
- setPoolStripes :: Int -> Settings -> Settings
- setPortNumber :: PortNumber -> Settings -> Settings
- data PrepareStrategy
- setPrepareStrategy :: PrepareStrategy -> Settings -> Settings
- setProtocolVersion :: Version -> Settings -> Settings
- setResponseTimeout :: NominalDiffTime -> Settings -> Settings
- setSendTimeout :: NominalDiffTime -> Settings -> Settings
- setRetrySettings :: RetrySettings -> Settings -> Settings
- setMaxRecvBuffer :: Int -> Settings -> Settings
- setSSLContext :: SSLContext -> Settings -> Settings
- setAuthentication :: [Authenticator] -> Settings -> Settings
- data Authenticator = Authenticator {
- authMechanism :: !AuthMechanism
- authOnRequest :: AuthContext -> IO (AuthResponse, s)
- authOnChallenge :: Maybe (s -> AuthChallenge -> IO (AuthResponse, s))
- authOnSuccess :: s -> AuthSuccess -> IO ()
- data AuthContext
- data ConnId
- authConnId :: Lens' AuthContext ConnId
- authHost :: Lens' AuthContext InetAddr
- newtype AuthMechanism = AuthMechanism Text
- newtype AuthUser = AuthUser Text
- newtype AuthPass = AuthPass Text
- passwordAuthenticator :: AuthUser -> AuthPass -> Authenticator
- data RetrySettings
- noRetry :: RetrySettings
- retryForever :: RetrySettings
- maxRetries :: Word -> RetrySettings -> RetrySettings
- adjustConsistency :: Consistency -> RetrySettings -> RetrySettings
- constDelay :: NominalDiffTime -> RetrySettings -> RetrySettings
- expBackoff :: NominalDiffTime -> NominalDiffTime -> RetrySettings -> RetrySettings
- fibBackoff :: NominalDiffTime -> NominalDiffTime -> RetrySettings -> RetrySettings
- adjustSendTimeout :: NominalDiffTime -> RetrySettings -> RetrySettings
- adjustResponseTimeout :: NominalDiffTime -> RetrySettings -> RetrySettings
- data Policy = Policy {}
- random :: IO Policy
- roundRobin :: IO Policy
- data Host
- data HostEvent
- newtype InetAddr = InetAddr {}
- hostAddr :: Lens' Host InetAddr
- dataCentre :: Lens' Host Text
- rack :: Lens' Host Text
- data Client a
- class (Functor m, Applicative m, Monad m, MonadIO m, MonadCatch m) => MonadClient m where
- data ClientState
- data DebugInfo = DebugInfo {}
- init :: MonadIO m => Logger -> Settings -> m ClientState
- runClient :: MonadIO m => ClientState -> Client a -> m a
- shutdown :: MonadIO m => ClientState -> m ()
- debugInfo :: MonadClient m => m DebugInfo
- data R :: *
- data W :: *
- data S :: *
- data QueryParams a :: * -> * = QueryParams {}
- defQueryParams :: Consistency -> a -> QueryParams a
- data Consistency :: *
- = Any
- | One
- | LocalOne
- | Two
- | Three
- | Quorum
- | LocalQuorum
- | All
- | EachQuorum
- | Serial
- | LocalSerial
- data SerialConsistency :: *
- newtype QueryString k a b :: * -> * -> * -> * = QueryString {}
- query :: (MonadClient m, Tuple a, Tuple b, RunQ q) => q R a b -> QueryParams a -> m [b]
- query1 :: (MonadClient m, Tuple a, Tuple b, RunQ q) => q R a b -> QueryParams a -> m (Maybe b)
- write :: (MonadClient m, Tuple a, RunQ q) => q W a () -> QueryParams a -> m ()
- schema :: (MonadClient m, Tuple a, RunQ q) => q S a () -> QueryParams a -> m (Maybe SchemaChange)
- data PrepQuery k a b
- prepared :: QueryString k a b -> PrepQuery k a b
- queryString :: PrepQuery k a b -> QueryString k a b
- data Page a = Page {}
- emptyPage :: Page a
- paginate :: (MonadClient m, Tuple a, Tuple b, RunQ q) => q R a b -> QueryParams a -> m (Page b)
- data Row :: *
- fromRow :: Cql a => Int -> Row -> Either String a
- trans :: (MonadClient m, Tuple a, RunQ q) => q W a Row -> QueryParams a -> m [Row]
- data BatchM a
- addQuery :: (Show a, Tuple a, Tuple b) => QueryString W a b -> a -> BatchM ()
- addPrepQuery :: (Show a, Tuple a, Tuple b) => PrepQuery W a b -> a -> BatchM ()
- setType :: BatchType -> BatchM ()
- setConsistency :: Consistency -> BatchM ()
- setSerialConsistency :: SerialConsistency -> BatchM ()
- batch :: MonadClient m => BatchM () -> m ()
- retry :: MonadClient m => RetrySettings -> m a -> m a
- once :: MonadClient m => m a -> m a
- class RunQ q where
- request :: (MonadClient m, Tuple a, Tuple b) => Request k a b -> m (Response k a b)
- data InvalidSettings
- newtype InternalError = InternalError String
- data HostError
- data ConnectionError
- data UnexpectedResponse where
- UnexpectedResponse :: !(Response k a b) -> UnexpectedResponse
- UnexpectedResponse' :: Show b => !(Response k a b) -> UnexpectedResponse
- newtype Timeout = TimeoutRead String
- data HashCollision = HashCollision !Text !Text
- data AuthenticationError
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
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.
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.
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.
data PrepareStrategy Source #
EagerPrepare | cluster-wide preparation |
LazyPrepare | on-demand per node preparation |
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 theAuthContext
of the connection. - If additional challenges are posed by the server,
authOnChallenge
is called, if available, otherwise anAuthenticationError
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
Authenticator | |
|
data AuthContext Source #
Context information given to Authenticator
s 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.
passwordAuthenticator :: AuthUser -> AuthPass -> Authenticator Source #
A password authentication handler for use with Cassandra's
PasswordAuthenticator
.
Retry Settings
data RetrySettings Source #
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.
:: NominalDiffTime | Initial delay. |
-> NominalDiffTime | Maximum delay. |
-> RetrySettings | |
-> RetrySettings |
Delay retries with exponential backoff.
:: 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
A policy defines a load-balancing strategy and generally handles host visibility.
Policy | |
|
roundRobin :: IO Policy Source #
Iterate over hosts one by one.
Hosts
Host representation.
This event will be passed to a Policy
to inform it about
cluster changes.
Client Monad
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
.
class (Functor m, Applicative m, Monad m, MonadIO m, MonadCatch m) => MonadClient m where Source #
Monads in which Client
actions may be embedded.
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
.
MonadClient Client Source # | |
MonadClient m => MonadClient (ExceptT e m) Source # | |
MonadClient m => MonadClient (StateT s m) Source # | |
MonadClient m => MonadClient (StateT s m) Source # | |
MonadClient m => MonadClient (ReaderT * r m) Source # | |
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.
debugInfo :: MonadClient m => m DebugInfo Source #
Queries
data QueryParams a :: * -> * #
Query parameters.
QueryParams | |
|
Show a => Show (QueryParams a) | |
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
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
SerialConsistency | Default. Quorum-based linearizable consistency. |
LocalSerialConsistency | Like |
newtype QueryString k a b :: * -> * -> * -> * #
RunQ QueryString Source # | |
Eq (QueryString k a b) | |
Show (QueryString k a b) | |
IsString (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
Representation of a prepared query. Actual preparation is handled transparently by the driver.
prepared :: QueryString k a b -> PrepQuery k a b Source #
queryString :: PrepQuery k a b -> QueryString k a b Source #
Paging
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.
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
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 Row
s describing the
outcome.
Batch Queries
Batch
construction monad.
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.
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
Request
s and evaluate Response
s.
A type which can be run as a query.
runQ :: (MonadClient m, Tuple a, Tuple b) => q 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
data InvalidSettings Source #
newtype InternalError Source #
data ConnectionError Source #
data UnexpectedResponse where Source #
UnexpectedResponse :: !(Response k a b) -> UnexpectedResponse | |
UnexpectedResponse' :: Show b => !(Response k a b) -> UnexpectedResponse |
data HashCollision Source #