-- This Source Code Form is subject to the terms of the Mozilla Public
-- License, v. 2.0. If a copy of the MPL was not distributed with this
-- file, You can obtain one at http://mozilla.org/MPL/2.0/.

-- | This driver operates on some state which must be initialised prior to
-- executing client operations and terminated eventually. The library uses
-- <http://hackage.haskell.org/package/tinylog 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
-- @
--

{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE LambdaCase    #-}

module Database.CQL.IO
    ( -- * Client Settings
      Settings
    , S.defSettings
    , addContact
    , setCompression
    , setConnectTimeout
    , setContacts
    , setIdleTimeout
    , setKeyspace
    , setMaxConnections
    , setMaxStreams
    , setMaxTimeouts
    , setPolicy
    , setPoolStripes
    , setPortNumber
    , PrepareStrategy (..)
    , setPrepareStrategy
    , setProtocolVersion
    , setResponseTimeout
    , setSendTimeout
    , setRetrySettings
    , setMaxRecvBuffer
    , setSSLContext

      -- ** Logging
    , Logger (..)
    , LogLevel (..)
    , setLogger
    , nullLogger
    , stdoutLogger

      -- ** Authentication
    , setAuthentication
    , Authenticator (..)
    , AuthContext
    , ConnId
    , authConnId
    , authHost
    , AuthMechanism (..)
    , AuthUser      (..)
    , AuthPass      (..)
    , passwordAuthenticator

      -- ** Retry Settings
    , RetrySettings
    , noRetry
      -- *** Default
    , defRetrySettings
    , defRetryPolicy
    , defRetryHandlers
      -- *** Eager
    , eagerRetrySettings
    , eagerRetryPolicy
    , eagerRetryHandlers
      -- *** Configuration
    , setRetryPolicy
    , setRetryHandlers
    , adjustConsistency
    , adjustSendTimeout
    , adjustResponseTimeout

      -- ** Load-balancing
    , Policy (..)
    , random
    , roundRobin

      -- *** Hosts
    , Host
    , HostEvent (..)
    , InetAddr  (..)
    , hostAddr
    , dataCentre
    , rack

      -- * Client Monad
    , Client
    , MonadClient (..)
    , ClientState
    , DebugInfo   (..)
    , init
    , runClient
    , shutdown
    , debugInfo

      -- * Queries
      -- $queries
    , R, W, S
    , QueryParams       (..)
    , defQueryParams
    , Consistency       (..)
    , SerialConsistency (..)
    , Identity          (..)

      -- ** Basic Queries
    , QueryString (..)
    , query
    , query1
    , write
    , schema

      -- ** Prepared Queries
    , PrepQuery
    , prepared
    , queryString

      -- ** Paging
    , Page (..)
    , emptyPage
    , paginate

      -- ** Lightweight Transactions
    , Row
    , fromRow
    , trans

      -- ** Batch Queries
    , BatchM
    , addQuery
    , addPrepQuery
    , setType
    , setConsistency
    , setSerialConsistency
    , batch

      -- ** Retries
    , retry
    , once

      -- ** Low-Level Queries
      -- $low-level-queries
    , RunQ (..)
    , HostResponse (..)
    , request
    , getResult

      -- * Exceptions
    , ProtocolError       (..)
    , HostError           (..)
    , ConnectionError     (..)
    , ResponseError       (..)
    , AuthenticationError (..)
    , HashCollision       (..)
    ) where

import Control.Applicative
import Data.Functor.Identity
import Data.Maybe (isJust, listToMaybe)
import Database.CQL.Protocol
import Database.CQL.IO.Batch hiding (batch)
import Database.CQL.IO.Client
import Database.CQL.IO.Cluster.Host
import Database.CQL.IO.Cluster.Policies
import Database.CQL.IO.Connection.Settings as C
import Database.CQL.IO.Exception
import Database.CQL.IO.Log
import Database.CQL.IO.PrepQuery
import Database.CQL.IO.Settings as S
import Prelude hiding (init)

import qualified Database.CQL.IO.Batch as B

-- $queries
--
-- Queries are defined either as 'QueryString's or 'PrepQuery's.
-- Both types carry three phantom type parameters used to describe
-- the query, input and output types, respectively, as follows:
--
--   * @__k__@ is one of 'R'ead, 'W'rite or 'S'chema.
--   * @__a__@ is the tuple type for the input, i.e. for the
--     parameters bound by positional (@?@) or named (@:foo@) placeholders.
--   * @__b__@ is the tuple type for the outputs, i.e. for the
--     columns selected in a query.
--
-- Thereby every type used in an input or output tuple must be an instance
-- of the 'Cql' typeclass. It is the responsibility of user code
-- that the type ascription of a query matches the order, number and types of
-- the parameters. For example:
--
-- @
-- myQuery :: QueryString R (Identity UUID) (Text, Int, Maybe UTCTime)
-- myQuery = "select name, age, birthday from user where id = ?"
-- @
--
-- In this example, the query is declared as a 'R'ead with a single
-- input (id) and three outputs (name, age and birthday).
--
-- Note that a single input or output type needs to be wrapped
-- in the 'Identity' newtype, for which there is a `Cql` instance,
-- in order to avoid overlapping instances.
--
-- It is a common strategy to use additional @newtype@s with derived
-- @Cql@ instances for additional type safety, e.g.
--
-- @
-- newtype UserId = UserId UUID deriving (Eq, Show, Cql)
-- @
--
-- The input and output tuples can further be automatically
-- converted from and to records via the 'Database.CQL.Protocol.Record'
-- typeclass, whose instances can be generated via @TemplateHaskell@,
-- if desired.
--
-- __Note on null values__
--
-- In principle, any column in Cassandra is /nullable/, i.e. may be
-- be set to @null@ as a result of row operations. It is therefore
-- important that any output type of a query that may be null
-- is wrapped in the 'Maybe' type constructor.
-- It is a common pitfall that a column is assumed to never contain
-- null values, when in fact partial updates or deletions on a row,
-- including via the use of TTLs, may result in null values and thus
-- runtime errors when processing the responses.

-- $low-level-queries
--
-- /Note/: Use of the these 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.
class RunQ q where
    runQ :: (MonadClient m, Tuple a, Tuple b)
         => q k a b
         -> QueryParams a
         -> m (HostResponse k a b)

instance RunQ QueryString where
    runQ :: forall (m :: * -> *) a b k.
(MonadClient m, Tuple a, Tuple b) =>
QueryString k a b -> QueryParams a -> m (HostResponse k a b)
runQ QueryString k a b
q QueryParams a
p = Request k a b -> m (HostResponse k a b)
forall (m :: * -> *) a b k.
(MonadClient m, Tuple a, Tuple b) =>
Request k a b -> m (HostResponse k a b)
request (Query k a b -> Request k a b
forall k a b. Query k a b -> Request k a b
RqQuery (QueryString k a b -> QueryParams a -> Query k a b
forall k a b. QueryString k a b -> QueryParams a -> Query k a b
Query QueryString k a b
q QueryParams a
p))

instance RunQ PrepQuery where
    runQ :: forall (m :: * -> *) a b k.
(MonadClient m, Tuple a, Tuple b) =>
PrepQuery k a b -> QueryParams a -> m (HostResponse k a b)
runQ PrepQuery k a b
q = Client (HostResponse k a b) -> m (HostResponse k a b)
forall a. Client a -> m a
forall (m :: * -> *) a. MonadClient m => Client a -> m a
liftClient (Client (HostResponse k a b) -> m (HostResponse k a b))
-> (QueryParams a -> Client (HostResponse k a b))
-> QueryParams a
-> m (HostResponse k a b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PrepQuery k a b -> QueryParams a -> Client (HostResponse k a b)
forall b a k.
(Tuple b, Tuple a) =>
PrepQuery k a b -> QueryParams a -> Client (HostResponse k a b)
execute PrepQuery k a b
q

-- | Run a CQL read-only query returning a list of results.
query :: (MonadClient m, Tuple a, Tuple b, RunQ q) => q R a b -> QueryParams a -> m [b]
query :: forall (m :: * -> *) a b (q :: * -> * -> * -> *).
(MonadClient m, Tuple a, Tuple b, RunQ q) =>
q R a b -> QueryParams a -> m [b]
query q R a b
q QueryParams a
p = do
    HostResponse R a b
r <- q R a b -> QueryParams a -> m (HostResponse R a b)
forall (m :: * -> *) a b k.
(MonadClient m, Tuple a, Tuple b) =>
q k a b -> QueryParams a -> m (HostResponse k a b)
forall (q :: * -> * -> * -> *) (m :: * -> *) a b k.
(RunQ q, MonadClient m, Tuple a, Tuple b) =>
q k a b -> QueryParams a -> m (HostResponse k a b)
runQ q R a b
q QueryParams a
p
    HostResponse R a b -> m (Result R a b)
forall (m :: * -> *) k a b.
MonadThrow m =>
HostResponse k a b -> m (Result k a b)
getResult HostResponse R a b
r m (Result R a b) -> (Result R a b -> m [b]) -> m [b]
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
        RowsResult MetaData
_ [b]
b -> [b] -> m [b]
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return [b]
b
        Result R a b
_              -> HostResponse R a b -> m [b]
forall (m :: * -> *) k a b c.
MonadThrow m =>
HostResponse k a b -> m c
unexpected HostResponse R a b
r

-- | Run a CQL read-only query returning a single result.
query1 :: (MonadClient m, Tuple a, Tuple b, RunQ q) => q R a b -> QueryParams a -> m (Maybe b)
query1 :: forall (m :: * -> *) a b (q :: * -> * -> * -> *).
(MonadClient m, Tuple a, Tuple b, RunQ q) =>
q R a b -> QueryParams a -> m (Maybe b)
query1 q R a b
q QueryParams a
p = [b] -> Maybe b
forall a. [a] -> Maybe a
listToMaybe ([b] -> Maybe b) -> m [b] -> m (Maybe b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> q R a b -> QueryParams a -> m [b]
forall (m :: * -> *) a b (q :: * -> * -> * -> *).
(MonadClient m, Tuple a, Tuple b, RunQ q) =>
q R a b -> QueryParams a -> m [b]
query q R a b
q QueryParams a
p

-- | 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./
write :: (MonadClient m, Tuple a, RunQ q) => q W a () -> QueryParams a -> m ()
write :: forall (m :: * -> *) a (q :: * -> * -> * -> *).
(MonadClient m, Tuple a, RunQ q) =>
q W a () -> QueryParams a -> m ()
write q W a ()
q QueryParams a
p = do
    HostResponse W a ()
r <- q W a () -> QueryParams a -> m (HostResponse W a ())
forall (m :: * -> *) a b k.
(MonadClient m, Tuple a, Tuple b) =>
q k a b -> QueryParams a -> m (HostResponse k a b)
forall (q :: * -> * -> * -> *) (m :: * -> *) a b k.
(RunQ q, MonadClient m, Tuple a, Tuple b) =>
q k a b -> QueryParams a -> m (HostResponse k a b)
runQ q W a ()
q QueryParams a
p
    HostResponse W a () -> m (Result W a ())
forall (m :: * -> *) k a b.
MonadThrow m =>
HostResponse k a b -> m (Result k a b)
getResult HostResponse W a ()
r m (Result W a ()) -> (Result W a () -> m ()) -> m ()
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
        Result W a ()
VoidResult -> () -> m ()
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
        Result W a ()
_          -> HostResponse W a () -> m ()
forall (m :: * -> *) k a b c.
MonadThrow m =>
HostResponse k a b -> m c
unexpected HostResponse W a ()
r

-- | Run a CQL conditional write query (e.g. insert\/update\/delete) as a
-- "lightweight transaction", returning the result 'Row's describing the
-- outcome.
trans :: (MonadClient m, Tuple a, RunQ q) => q W a Row -> QueryParams a -> m [Row]
trans :: forall (m :: * -> *) a (q :: * -> * -> * -> *).
(MonadClient m, Tuple a, RunQ q) =>
q W a Row -> QueryParams a -> m [Row]
trans q W a Row
q QueryParams a
p = do
    HostResponse W a Row
r <- q W a Row -> QueryParams a -> m (HostResponse W a Row)
forall (m :: * -> *) a b k.
(MonadClient m, Tuple a, Tuple b) =>
q k a b -> QueryParams a -> m (HostResponse k a b)
forall (q :: * -> * -> * -> *) (m :: * -> *) a b k.
(RunQ q, MonadClient m, Tuple a, Tuple b) =>
q k a b -> QueryParams a -> m (HostResponse k a b)
runQ q W a Row
q QueryParams a
p
    HostResponse W a Row -> m (Result W a Row)
forall (m :: * -> *) k a b.
MonadThrow m =>
HostResponse k a b -> m (Result k a b)
getResult HostResponse W a Row
r m (Result W a Row) -> (Result W a Row -> m [Row]) -> m [Row]
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
        RowsResult MetaData
_ [Row]
b -> [Row] -> m [Row]
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return [Row]
b
        Result W a Row
_              -> HostResponse W a Row -> m [Row]
forall (m :: * -> *) k a b c.
MonadThrow m =>
HostResponse k a b -> m c
unexpected HostResponse W a Row
r

-- | Run a CQL schema query, returning 'SchemaChange' information, if any.
schema :: (MonadClient m, Tuple a, RunQ q) => q S a () -> QueryParams a -> m (Maybe SchemaChange)
schema :: forall (m :: * -> *) a (q :: * -> * -> * -> *).
(MonadClient m, Tuple a, RunQ q) =>
q S a () -> QueryParams a -> m (Maybe SchemaChange)
schema q S a ()
q QueryParams a
p = do
    HostResponse S a ()
r <- q S a () -> QueryParams a -> m (HostResponse S a ())
forall (m :: * -> *) a b k.
(MonadClient m, Tuple a, Tuple b) =>
q k a b -> QueryParams a -> m (HostResponse k a b)
forall (q :: * -> * -> * -> *) (m :: * -> *) a b k.
(RunQ q, MonadClient m, Tuple a, Tuple b) =>
q k a b -> QueryParams a -> m (HostResponse k a b)
runQ q S a ()
q QueryParams a
p
    HostResponse S a () -> m (Result S a ())
forall (m :: * -> *) k a b.
MonadThrow m =>
HostResponse k a b -> m (Result k a b)
getResult HostResponse S a ()
r m (Result S a ())
-> (Result S a () -> m (Maybe SchemaChange))
-> m (Maybe SchemaChange)
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
        SchemaChangeResult SchemaChange
s -> Maybe SchemaChange -> m (Maybe SchemaChange)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe SchemaChange -> m (Maybe SchemaChange))
-> Maybe SchemaChange -> m (Maybe SchemaChange)
forall a b. (a -> b) -> a -> b
$ SchemaChange -> Maybe SchemaChange
forall a. a -> Maybe a
Just SchemaChange
s
        Result S a ()
VoidResult           -> Maybe SchemaChange -> m (Maybe SchemaChange)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe SchemaChange
forall a. Maybe a
Nothing
        Result S a ()
_                    -> HostResponse S a () -> m (Maybe SchemaChange)
forall (m :: * -> *) k a b c.
MonadThrow m =>
HostResponse k a b -> m c
unexpected HostResponse S a ()
r

-- | Run a batch query against a Cassandra node.
batch :: MonadClient m => BatchM () -> m ()
batch :: forall (m :: * -> *). MonadClient m => BatchM () -> m ()
batch = Client () -> m ()
forall a. Client a -> m a
forall (m :: * -> *) a. MonadClient m => Client a -> m a
liftClient (Client () -> m ())
-> (BatchM () -> Client ()) -> BatchM () -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BatchM () -> Client ()
forall a. BatchM a -> Client ()
B.batch

-- | 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.
data Page a = Page
    { forall a. Page a -> Bool
hasMore  :: !Bool
    , forall a. Page a -> [a]
result   :: [a]
    , forall a. Page a -> Client (Page a)
nextPage :: Client (Page a)
    } deriving ((forall a b. (a -> b) -> Page a -> Page b)
-> (forall a b. a -> Page b -> Page a) -> Functor Page
forall a b. a -> Page b -> Page a
forall a b. (a -> b) -> Page a -> Page b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall a b. (a -> b) -> Page a -> Page b
fmap :: forall a b. (a -> b) -> Page a -> Page b
$c<$ :: forall a b. a -> Page b -> Page a
<$ :: forall a b. a -> Page b -> Page a
Functor)

-- | A page with an empty result list.
emptyPage :: Page a
emptyPage :: forall a. Page a
emptyPage = Bool -> [a] -> Client (Page a) -> Page a
forall a. Bool -> [a] -> Client (Page a) -> Page a
Page Bool
False [] (Page a -> Client (Page a)
forall a. a -> Client a
forall (m :: * -> *) a. Monad m => a -> m a
return Page a
forall a. Page a
emptyPage)

-- | 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'.
paginate :: (MonadClient m, Tuple a, Tuple b, RunQ q) => q R a b -> QueryParams a -> m (Page b)
paginate :: forall (m :: * -> *) a b (q :: * -> * -> * -> *).
(MonadClient m, Tuple a, Tuple b, RunQ q) =>
q R a b -> QueryParams a -> m (Page b)
paginate q R a b
q QueryParams a
p = do
    let p' :: QueryParams a
p' = QueryParams a
p { pageSize = pageSize p <|> Just 10000 }
    HostResponse R a b
r <- q R a b -> QueryParams a -> m (HostResponse R a b)
forall (m :: * -> *) a b k.
(MonadClient m, Tuple a, Tuple b) =>
q k a b -> QueryParams a -> m (HostResponse k a b)
forall (q :: * -> * -> * -> *) (m :: * -> *) a b k.
(RunQ q, MonadClient m, Tuple a, Tuple b) =>
q k a b -> QueryParams a -> m (HostResponse k a b)
runQ q R a b
q QueryParams a
p'
    HostResponse R a b -> m (Result R a b)
forall (m :: * -> *) k a b.
MonadThrow m =>
HostResponse k a b -> m (Result k a b)
getResult HostResponse R a b
r m (Result R a b) -> (Result R a b -> m (Page b)) -> m (Page b)
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
        RowsResult MetaData
m [b]
b ->
            if Maybe PagingState -> Bool
forall a. Maybe a -> Bool
isJust (MetaData -> Maybe PagingState
pagingState MetaData
m) then
                Page b -> m (Page b)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Page b -> m (Page b)) -> Page b -> m (Page b)
forall a b. (a -> b) -> a -> b
$ Bool -> [b] -> Client (Page b) -> Page b
forall a. Bool -> [a] -> Client (Page a) -> Page a
Page Bool
True [b]
b (q R a b -> QueryParams a -> Client (Page b)
forall (m :: * -> *) a b (q :: * -> * -> * -> *).
(MonadClient m, Tuple a, Tuple b, RunQ q) =>
q R a b -> QueryParams a -> m (Page b)
paginate q R a b
q QueryParams a
p' { queryPagingState = pagingState m })
            else
                Page b -> m (Page b)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Page b -> m (Page b)) -> Page b -> m (Page b)
forall a b. (a -> b) -> a -> b
$ Bool -> [b] -> Client (Page b) -> Page b
forall a. Bool -> [a] -> Client (Page a) -> Page a
Page Bool
False [b]
b (Page b -> Client (Page b)
forall a. a -> Client a
forall (m :: * -> *) a. Monad m => a -> m a
return Page b
forall a. Page a
emptyPage)
        Result R a b
_ -> HostResponse R a b -> m (Page b)
forall (m :: * -> *) k a b c.
MonadThrow m =>
HostResponse k a b -> m c
unexpected HostResponse R a b
r