{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
-- for ReplicationStrategy
{-# OPTIONS_GHC -Wno-partial-fields #-}

-- This file is part of the Wire Server implementation.
--
-- Copyright (C) 2022 Wire Swiss GmbH <opensource@wire.com>
--
-- This program is free software: you can redistribute it and/or modify it under
-- the terms of the GNU Affero General Public License as published by the Free
-- Software Foundation, either version 3 of the License, or (at your option) any
-- later version.
--
-- This program is distributed in the hope that it will be useful, but WITHOUT
-- ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
-- FOR A PARTICULAR PURPOSE. See the GNU Affero General Public License for more
-- details.
--
-- You should have received a copy of the GNU Affero General Public License along
-- with this program. If not, see <https://www.gnu.org/licenses/>.

-- Additional functionality on top of our cassandra library. Used by brig, brig's schema definitions, Spar, Spar's schema definitions, Galley, Galley's schema definitions, Gundeck, and Gundeck's schema definitions.

module Cassandra.Schema
  ( Migration (..),
    MigrationOpts (..),
    ReplicationStrategy (..),
    ReplicationFactor (..),
    ReplicationMap (..),
    schemaVersion,
    versionCheck,
    createKeyspace,
    useKeyspace,
    migrationOptsParser,
    schema',
  )
where

import Cassandra (Client, Consistency (All, One), Keyspace (Keyspace), QueryParams (QueryParams), QueryString (QueryString), params, query1, retry, x5)
import Control.Monad.Catch
import Data.Aeson
import Data.List.Split (splitOn)
import Data.Text (intercalate, pack)
import Data.Text.Lazy (fromStrict)
import Data.Text.Lazy qualified as LT
import Data.Text.Lazy.Builder (fromString, fromText, toLazyText)
import Database.CQL.IO (HostResponse, getResult, request, schema)
import Database.CQL.Protocol (Query (Query), Request (RqQuery))
import Imports hiding (All, fromString, init, intercalate, log)
import Options.Applicative hiding (info)

data Migration = Migration
  { Migration -> Int32
migVersion :: Int32,
    Migration -> Text
migText :: Text,
    Migration -> Client ()
migAction :: Client ()
  }

data MigrationOpts = MigrationOpts
  { MigrationOpts -> String
migHost :: String,
    MigrationOpts -> Word16
migPort :: Word16,
    MigrationOpts -> Text
migKeyspace :: Text,
    MigrationOpts -> ReplicationStrategy
migRepl :: ReplicationStrategy,
    MigrationOpts -> Bool
migReset :: Bool,
    MigrationOpts -> Maybe String
migTlsCa :: Maybe FilePath
  }
  deriving (MigrationOpts -> MigrationOpts -> Bool
(MigrationOpts -> MigrationOpts -> Bool)
-> (MigrationOpts -> MigrationOpts -> Bool) -> Eq MigrationOpts
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: MigrationOpts -> MigrationOpts -> Bool
== :: MigrationOpts -> MigrationOpts -> Bool
$c/= :: MigrationOpts -> MigrationOpts -> Bool
/= :: MigrationOpts -> MigrationOpts -> Bool
Eq, Int -> MigrationOpts -> ShowS
[MigrationOpts] -> ShowS
MigrationOpts -> String
(Int -> MigrationOpts -> ShowS)
-> (MigrationOpts -> String)
-> ([MigrationOpts] -> ShowS)
-> Show MigrationOpts
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> MigrationOpts -> ShowS
showsPrec :: Int -> MigrationOpts -> ShowS
$cshow :: MigrationOpts -> String
show :: MigrationOpts -> String
$cshowList :: [MigrationOpts] -> ShowS
showList :: [MigrationOpts] -> ShowS
Show, (forall x. MigrationOpts -> Rep MigrationOpts x)
-> (forall x. Rep MigrationOpts x -> MigrationOpts)
-> Generic MigrationOpts
forall x. Rep MigrationOpts x -> MigrationOpts
forall x. MigrationOpts -> Rep MigrationOpts x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. MigrationOpts -> Rep MigrationOpts x
from :: forall x. MigrationOpts -> Rep MigrationOpts x
$cto :: forall x. Rep MigrationOpts x -> MigrationOpts
to :: forall x. Rep MigrationOpts x -> MigrationOpts
Generic)

data ReplicationStrategy
  = SimpleStrategy {ReplicationStrategy -> ReplicationFactor
replicationFactor :: ReplicationFactor}
  | NetworkTopologyStrategy {ReplicationStrategy -> ReplicationMap
dataCenters :: ReplicationMap}
  deriving (ReplicationStrategy -> ReplicationStrategy -> Bool
(ReplicationStrategy -> ReplicationStrategy -> Bool)
-> (ReplicationStrategy -> ReplicationStrategy -> Bool)
-> Eq ReplicationStrategy
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ReplicationStrategy -> ReplicationStrategy -> Bool
== :: ReplicationStrategy -> ReplicationStrategy -> Bool
$c/= :: ReplicationStrategy -> ReplicationStrategy -> Bool
/= :: ReplicationStrategy -> ReplicationStrategy -> Bool
Eq, Int -> ReplicationStrategy -> ShowS
[ReplicationStrategy] -> ShowS
ReplicationStrategy -> String
(Int -> ReplicationStrategy -> ShowS)
-> (ReplicationStrategy -> String)
-> ([ReplicationStrategy] -> ShowS)
-> Show ReplicationStrategy
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ReplicationStrategy -> ShowS
showsPrec :: Int -> ReplicationStrategy -> ShowS
$cshow :: ReplicationStrategy -> String
show :: ReplicationStrategy -> String
$cshowList :: [ReplicationStrategy] -> ShowS
showList :: [ReplicationStrategy] -> ShowS
Show, (forall x. ReplicationStrategy -> Rep ReplicationStrategy x)
-> (forall x. Rep ReplicationStrategy x -> ReplicationStrategy)
-> Generic ReplicationStrategy
forall x. Rep ReplicationStrategy x -> ReplicationStrategy
forall x. ReplicationStrategy -> Rep ReplicationStrategy x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ReplicationStrategy -> Rep ReplicationStrategy x
from :: forall x. ReplicationStrategy -> Rep ReplicationStrategy x
$cto :: forall x. Rep ReplicationStrategy x -> ReplicationStrategy
to :: forall x. Rep ReplicationStrategy x -> ReplicationStrategy
Generic)

newtype ReplicationFactor = ReplicationFactor Word16
  deriving (ReplicationFactor -> ReplicationFactor -> Bool
(ReplicationFactor -> ReplicationFactor -> Bool)
-> (ReplicationFactor -> ReplicationFactor -> Bool)
-> Eq ReplicationFactor
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ReplicationFactor -> ReplicationFactor -> Bool
== :: ReplicationFactor -> ReplicationFactor -> Bool
$c/= :: ReplicationFactor -> ReplicationFactor -> Bool
/= :: ReplicationFactor -> ReplicationFactor -> Bool
Eq, Int -> ReplicationFactor -> ShowS
[ReplicationFactor] -> ShowS
ReplicationFactor -> String
(Int -> ReplicationFactor -> ShowS)
-> (ReplicationFactor -> String)
-> ([ReplicationFactor] -> ShowS)
-> Show ReplicationFactor
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ReplicationFactor -> ShowS
showsPrec :: Int -> ReplicationFactor -> ShowS
$cshow :: ReplicationFactor -> String
show :: ReplicationFactor -> String
$cshowList :: [ReplicationFactor] -> ShowS
showList :: [ReplicationFactor] -> ShowS
Show, (forall x. ReplicationFactor -> Rep ReplicationFactor x)
-> (forall x. Rep ReplicationFactor x -> ReplicationFactor)
-> Generic ReplicationFactor
forall x. Rep ReplicationFactor x -> ReplicationFactor
forall x. ReplicationFactor -> Rep ReplicationFactor x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ReplicationFactor -> Rep ReplicationFactor x
from :: forall x. ReplicationFactor -> Rep ReplicationFactor x
$cto :: forall x. Rep ReplicationFactor x -> ReplicationFactor
to :: forall x. Rep ReplicationFactor x -> ReplicationFactor
Generic)

newtype ReplicationMap = ReplicationMap [(Text, ReplicationFactor)]
  deriving (ReplicationMap -> ReplicationMap -> Bool
(ReplicationMap -> ReplicationMap -> Bool)
-> (ReplicationMap -> ReplicationMap -> Bool) -> Eq ReplicationMap
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ReplicationMap -> ReplicationMap -> Bool
== :: ReplicationMap -> ReplicationMap -> Bool
$c/= :: ReplicationMap -> ReplicationMap -> Bool
/= :: ReplicationMap -> ReplicationMap -> Bool
Eq, Int -> ReplicationMap -> ShowS
[ReplicationMap] -> ShowS
ReplicationMap -> String
(Int -> ReplicationMap -> ShowS)
-> (ReplicationMap -> String)
-> ([ReplicationMap] -> ShowS)
-> Show ReplicationMap
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ReplicationMap -> ShowS
showsPrec :: Int -> ReplicationMap -> ShowS
$cshow :: ReplicationMap -> String
show :: ReplicationMap -> String
$cshowList :: [ReplicationMap] -> ShowS
showList :: [ReplicationMap] -> ShowS
Show, (forall x. ReplicationMap -> Rep ReplicationMap x)
-> (forall x. Rep ReplicationMap x -> ReplicationMap)
-> Generic ReplicationMap
forall x. Rep ReplicationMap x -> ReplicationMap
forall x. ReplicationMap -> Rep ReplicationMap x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ReplicationMap -> Rep ReplicationMap x
from :: forall x. ReplicationMap -> Rep ReplicationMap x
$cto :: forall x. Rep ReplicationMap x -> ReplicationMap
to :: forall x. Rep ReplicationMap x -> ReplicationMap
Generic)

instance FromJSON ReplicationMap

instance FromJSON ReplicationFactor

instance FromJSON ReplicationStrategy

instance FromJSON MigrationOpts

instance Read ReplicationMap where
  -- ReplicationMap ::= DataCenter [("," DataCenter)*]
  -- DataCenter     ::= Name ":" ReplFactor
  -- Name           ::= Text
  -- ReplFactor     ::= Word16
  readsPrec :: Int -> ReadS ReplicationMap
readsPrec Int
_ String
s = [([(Text, ReplicationFactor)] -> ReplicationMap
ReplicationMap (String -> [(Text, ReplicationFactor)]
dcMap String
s), String
"")]
    where
      dcMap :: String -> [(Text, ReplicationFactor)]
dcMap = (String -> (Text, ReplicationFactor))
-> [String] -> [(Text, ReplicationFactor)]
forall a b. (a -> b) -> [a] -> [b]
map String -> (Text, ReplicationFactor)
dcEntry ([String] -> [(Text, ReplicationFactor)])
-> (String -> [String]) -> String -> [(Text, ReplicationFactor)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> [String]
forall a. Eq a => [a] -> [a] -> [[a]]
splitOn String
","
      dcEntry :: String -> (Text, ReplicationFactor)
dcEntry String
e = case String -> String -> [String]
forall a. Eq a => [a] -> [a] -> [[a]]
splitOn String
":" String
e of
        [String
k, String
v] -> (String -> Text
pack String
k, Word16 -> ReplicationFactor
ReplicationFactor (String -> Word16
forall a. Read a => String -> a
read String
v))
        [String]
_ -> String -> (Text, ReplicationFactor)
forall a. HasCallStack => String -> a
error (String -> (Text, ReplicationFactor))
-> String -> (Text, ReplicationFactor)
forall a b. (a -> b) -> a -> b
$ String
"Failed reading: Invalid data center entry: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
e

schema' :: LT.Text -> Client ()
schema' :: Text -> Client ()
schema' Text
q = Client (Maybe SchemaChange) -> Client ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Client (Maybe SchemaChange) -> Client ())
-> Client (Maybe SchemaChange) -> Client ()
forall a b. (a -> b) -> a -> b
$ QueryString S () ()
-> QueryParams () -> Client (Maybe SchemaChange)
forall (m :: * -> *) a (q :: * -> * -> * -> *).
(MonadClient m, Tuple a, RunQ q) =>
q S a () -> QueryParams a -> m (Maybe SchemaChange)
schema (Text -> QueryString S () ()
forall k a b. Text -> QueryString k a b
QueryString Text
q) (Consistency -> () -> QueryParams ()
forall a. Consistency -> a -> QueryParams a
params Consistency
All ())

schemaVersion :: Client (Maybe Int32)
schemaVersion :: Client (Maybe Int32)
schemaVersion = Client (Maybe Int32)
-> (SomeException -> Client (Maybe Int32)) -> Client (Maybe Int32)
forall e a.
(HasCallStack, Exception e) =>
Client a -> (e -> Client a) -> Client a
forall (m :: * -> *) e a.
(MonadCatch m, HasCallStack, Exception e) =>
m a -> (e -> m a) -> m a
catch ((Identity Int32 -> Int32) -> Maybe (Identity Int32) -> Maybe Int32
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Identity Int32 -> Int32
forall a. Identity a -> a
runIdentity (Maybe (Identity Int32) -> Maybe Int32)
-> Client (Maybe (Identity Int32)) -> Client (Maybe Int32)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Client (Maybe (Identity Int32))
qry) SomeException -> Client (Maybe Int32)
forall a. SomeException -> a
h
  where
    qry :: Client (Maybe (Identity Int32))
qry = RetrySettings
-> Client (Maybe (Identity Int32))
-> Client (Maybe (Identity Int32))
forall (m :: * -> *) a.
MonadClient m =>
RetrySettings -> m a -> m a
retry RetrySettings
x5 (Client (Maybe (Identity Int32))
 -> Client (Maybe (Identity Int32)))
-> Client (Maybe (Identity Int32))
-> Client (Maybe (Identity Int32))
forall a b. (a -> b) -> a -> b
$ QueryString R () (Identity Int32)
-> QueryParams () -> Client (Maybe (Identity Int32))
forall (m :: * -> *) a b (q :: * -> * -> * -> *).
(MonadClient m, Tuple a, Tuple b, RunQ q) =>
q R a b -> QueryParams a -> m (Maybe b)
query1 QueryString R () (Identity Int32)
forall {k} {a} {b}. QueryString k a b
q (Consistency -> () -> QueryParams ()
forall a. Consistency -> a -> QueryParams a
params Consistency
One ())
    q :: QueryString k a b
q = Text -> QueryString k a b
forall k a b. Text -> QueryString k a b
QueryString Text
"select version from meta where id=1 order by version desc limit 1"
    h :: SomeException -> a
    h :: forall a. SomeException -> a
h SomeException
e =
      String -> a
forall a. HasCallStack => String -> a
error (String -> a) -> String -> a
forall a b. (a -> b) -> a -> b
$
        String
"Failed to read schema version from meta table. Error was: "
          String -> ShowS
forall a. Semigroup a => a -> a -> a
<> SomeException -> String
forall a. Show a => a -> String
show SomeException
e

versionCheck :: Int32 -> Client ()
versionCheck :: Int32 -> Client ()
versionCheck Int32
v = do
  Maybe Int32
v' <- Client (Maybe Int32)
schemaVersion
  Bool -> Client () -> Client ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Int32 -> Maybe Int32
forall a. a -> Maybe a
Just Int32
v Maybe Int32 -> Maybe Int32 -> Bool
forall a. Ord a => a -> a -> Bool
<= Maybe Int32
v') (Client () -> Client ()) -> Client () -> Client ()
forall a b. (a -> b) -> a -> b
$
    String -> Client ()
forall a. HasCallStack => String -> a
error (String -> Client ()) -> String -> Client ()
forall a b. (a -> b) -> a -> b
$
      String
"Schema Version too old! Expecting at least: "
        String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Int32 -> String
forall a. Show a => a -> String
show Int32
v
        String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
", but got: "
        String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String -> (Int32 -> String) -> Maybe Int32 -> String
forall b a. b -> (a -> b) -> Maybe a -> b
maybe String
"" Int32 -> String
forall a. Show a => a -> String
show Maybe Int32
v'

createKeyspace :: Keyspace -> ReplicationStrategy -> Client ()
createKeyspace :: Keyspace -> ReplicationStrategy -> Client ()
createKeyspace (Keyspace Text
k) ReplicationStrategy
rs = Client (Maybe SchemaChange) -> Client ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Client (Maybe SchemaChange) -> Client ())
-> Client (Maybe SchemaChange) -> Client ()
forall a b. (a -> b) -> a -> b
$ QueryString S () ()
-> QueryParams () -> Client (Maybe SchemaChange)
forall (m :: * -> *) a (q :: * -> * -> * -> *).
(MonadClient m, Tuple a, RunQ q) =>
q S a () -> QueryParams a -> m (Maybe SchemaChange)
schema (ReplicationStrategy -> QueryString S () ()
cql ReplicationStrategy
rs) (Consistency -> () -> QueryParams ()
forall a. Consistency -> a -> QueryParams a
params Consistency
All ())
  where
    cql :: ReplicationStrategy -> QueryString S () ()
cql (SimpleStrategy (ReplicationFactor Word16
n)) =
      Text -> QueryString S () ()
forall k a b. Text -> QueryString k a b
QueryString (Text -> QueryString S () ())
-> (Builder -> Text) -> Builder -> QueryString S () ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> Text
toLazyText (Builder -> QueryString S () ()) -> Builder -> QueryString S () ()
forall a b. (a -> b) -> a -> b
$
        Text -> Builder
fromText Text
"create keyspace if not exists "
          Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Text -> Builder
fromText Text
k
          Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Text -> Builder
fromText Text
" with replication = { "
          Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Text -> Builder
fromText Text
"    'class': 'SimpleStrategy' "
          Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Text -> Builder
fromText Text
"  , 'replication_factor': '"
          Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> String -> Builder
fromString (Word16 -> String
forall a. Show a => a -> String
show Word16
n)
          Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
"'"
          Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Text -> Builder
fromText Text
"};"
    cql (NetworkTopologyStrategy (ReplicationMap [(Text, ReplicationFactor)]
dcs)) =
      Text -> QueryString S () ()
forall k a b. Text -> QueryString k a b
QueryString (Text -> QueryString S () ())
-> (Builder -> Text) -> Builder -> QueryString S () ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> Text
toLazyText (Builder -> QueryString S () ()) -> Builder -> QueryString S () ()
forall a b. (a -> b) -> a -> b
$
        Text -> Builder
fromText Text
"create keyspace if not exists "
          Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Text -> Builder
fromText Text
k
          Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Text -> Builder
fromText Text
" with replication = { "
          Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Text -> Builder
fromText Text
"    'class': 'NetworkTopologyStrategy' "
          Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Text -> Builder
fromText Text
"  , "
          Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Text -> Builder
fromText (Text -> [Text] -> Text
intercalate Text
"," (((Text, ReplicationFactor) -> Text)
-> [(Text, ReplicationFactor)] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (Text, ReplicationFactor) -> Text
pair [(Text, ReplicationFactor)]
dcs))
          Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Text -> Builder
fromText Text
"};"
    pair :: (Text, ReplicationFactor) -> Text
pair (Text
dc, ReplicationFactor Word16
n) = Text
"'" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
dc Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"': " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
pack (Word16 -> String
forall a. Show a => a -> String
show Word16
n)

useKeyspace :: Keyspace -> Client ()
useKeyspace :: Keyspace -> Client ()
useKeyspace (Keyspace Text
k) = Client (Result () () ()) -> Client ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Client (Result () () ()) -> Client ())
-> (HostResponse () () () -> Client (Result () () ()))
-> HostResponse () () ()
-> Client ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HostResponse () () () -> Client (Result () () ())
forall (m :: * -> *) k a b.
MonadThrow m =>
HostResponse k a b -> m (Result k a b)
getResult (HostResponse () () () -> Client ())
-> Client (HostResponse () () ()) -> Client ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Client (HostResponse () () ())
qry
  where
    qry :: Client (HostResponse () () ())
qry = Request () () () -> Client (HostResponse () () ())
forall (m :: * -> *) a b k.
(MonadClient m, Tuple a, Tuple b) =>
Request k a b -> m (HostResponse k a b)
request (Query () () () -> Request () () ()
forall k a b. Query k a b -> Request k a b
RqQuery (QueryString () () () -> QueryParams () -> Query () () ()
forall k a b. QueryString k a b -> QueryParams a -> Query k a b
Query QueryString () () ()
cql QueryParams ()
prms)) :: Client (HostResponse () () ())
    prms :: QueryParams ()
prms = Consistency
-> Bool
-> ()
-> Maybe Int32
-> Maybe PagingState
-> Maybe SerialConsistency
-> Maybe Bool
-> QueryParams ()
forall a.
Consistency
-> Bool
-> a
-> Maybe Int32
-> Maybe PagingState
-> Maybe SerialConsistency
-> Maybe Bool
-> QueryParams a
QueryParams Consistency
One Bool
False () Maybe Int32
forall a. Maybe a
Nothing Maybe PagingState
forall a. Maybe a
Nothing Maybe SerialConsistency
forall a. Maybe a
Nothing Maybe Bool
forall a. Maybe a
Nothing
    cql :: QueryString () () ()
cql = Text -> QueryString () () ()
forall k a b. Text -> QueryString k a b
QueryString (Text -> QueryString () () ()) -> Text -> QueryString () () ()
forall a b. (a -> b) -> a -> b
$ Text
"use \"" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
fromStrict Text
k Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\""

migrationOptsParser :: Parser MigrationOpts
migrationOptsParser :: Parser MigrationOpts
migrationOptsParser =
  String
-> Word16
-> Text
-> ReplicationStrategy
-> Bool
-> Maybe String
-> MigrationOpts
MigrationOpts
    (String
 -> Word16
 -> Text
 -> ReplicationStrategy
 -> Bool
 -> Maybe String
 -> MigrationOpts)
-> Parser String
-> Parser
     (Word16
      -> Text
      -> ReplicationStrategy
      -> Bool
      -> Maybe String
      -> MigrationOpts)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Mod OptionFields String -> Parser String
forall s. IsString s => Mod OptionFields s -> Parser s
strOption
      ( String -> Mod OptionFields String
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"host"
          Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields String
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar String
"HOST"
          Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields String
forall (f :: * -> *) a. HasValue f => a -> Mod f a
value String
"localhost"
          Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields String
forall (f :: * -> *) a. String -> Mod f a
help String
"Cassandra host"
      )
    Parser
  (Word16
   -> Text
   -> ReplicationStrategy
   -> Bool
   -> Maybe String
   -> MigrationOpts)
-> Parser Word16
-> Parser
     (Text
      -> ReplicationStrategy -> Bool -> Maybe String -> MigrationOpts)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ReadM Word16 -> Mod OptionFields Word16 -> Parser Word16
forall a. ReadM a -> Mod OptionFields a -> Parser a
option
      ReadM Word16
forall a. Read a => ReadM a
auto
      ( String -> Mod OptionFields Word16
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"port"
          Mod OptionFields Word16
-> Mod OptionFields Word16 -> Mod OptionFields Word16
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields Word16
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar String
"PORT"
          Mod OptionFields Word16
-> Mod OptionFields Word16 -> Mod OptionFields Word16
forall a. Semigroup a => a -> a -> a
<> Word16 -> Mod OptionFields Word16
forall (f :: * -> *) a. HasValue f => a -> Mod f a
value Word16
9042
          Mod OptionFields Word16
-> Mod OptionFields Word16 -> Mod OptionFields Word16
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields Word16
forall (f :: * -> *) a. String -> Mod f a
help String
"Cassandra port"
      )
    Parser
  (Text
   -> ReplicationStrategy -> Bool -> Maybe String -> MigrationOpts)
-> Parser Text
-> Parser
     (ReplicationStrategy -> Bool -> Maybe String -> MigrationOpts)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ( (String -> Text) -> Parser String -> Parser Text
forall a b. (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap String -> Text
pack (Parser String -> Parser Text)
-> (Mod OptionFields String -> Parser String)
-> Mod OptionFields String
-> Parser Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Mod OptionFields String -> Parser String
forall s. IsString s => Mod OptionFields s -> Parser s
strOption (Mod OptionFields String -> Parser Text)
-> Mod OptionFields String -> Parser Text
forall a b. (a -> b) -> a -> b
$
            String -> Mod OptionFields String
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"keyspace"
              Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields String
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar String
"STRING"
              Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields String
forall (f :: * -> *) a. String -> Mod f a
help String
"Cassandra Keyspace"
        )
    Parser
  (ReplicationStrategy -> Bool -> Maybe String -> MigrationOpts)
-> Parser ReplicationStrategy
-> Parser (Bool -> Maybe String -> MigrationOpts)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ( ( (Word16 -> ReplicationStrategy)
-> Parser Word16 -> Parser ReplicationStrategy
forall a b. (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (ReplicationFactor -> ReplicationStrategy
SimpleStrategy (ReplicationFactor -> ReplicationStrategy)
-> (Word16 -> ReplicationFactor) -> Word16 -> ReplicationStrategy
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word16 -> ReplicationFactor
ReplicationFactor) (Parser Word16 -> Parser ReplicationStrategy)
-> (Mod OptionFields Word16 -> Parser Word16)
-> Mod OptionFields Word16
-> Parser ReplicationStrategy
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ReadM Word16 -> Mod OptionFields Word16 -> Parser Word16
forall a. ReadM a -> Mod OptionFields a -> Parser a
option ReadM Word16
forall a. Read a => ReadM a
auto (Mod OptionFields Word16 -> Parser ReplicationStrategy)
-> Mod OptionFields Word16 -> Parser ReplicationStrategy
forall a b. (a -> b) -> a -> b
$
              String -> Mod OptionFields Word16
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"replication-factor"
                Mod OptionFields Word16
-> Mod OptionFields Word16 -> Mod OptionFields Word16
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields Word16
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar String
"INT"
                Mod OptionFields Word16
-> Mod OptionFields Word16 -> Mod OptionFields Word16
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields Word16
forall (f :: * -> *) a. String -> Mod f a
help String
"Replication Factor"
          )
            Parser ReplicationStrategy
-> Parser ReplicationStrategy -> Parser ReplicationStrategy
forall a. Parser a -> Parser a -> Parser a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ( (ReplicationMap -> ReplicationStrategy)
-> Parser ReplicationMap -> Parser ReplicationStrategy
forall a b. (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ReplicationMap -> ReplicationStrategy
NetworkTopologyStrategy (Parser ReplicationMap -> Parser ReplicationStrategy)
-> (Mod OptionFields ReplicationMap -> Parser ReplicationMap)
-> Mod OptionFields ReplicationMap
-> Parser ReplicationStrategy
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ReadM ReplicationMap
-> Mod OptionFields ReplicationMap -> Parser ReplicationMap
forall a. ReadM a -> Mod OptionFields a -> Parser a
option ReadM ReplicationMap
forall a. Read a => ReadM a
auto (Mod OptionFields ReplicationMap -> Parser ReplicationStrategy)
-> Mod OptionFields ReplicationMap -> Parser ReplicationStrategy
forall a b. (a -> b) -> a -> b
$
                    String -> Mod OptionFields ReplicationMap
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"replication-map"
                      Mod OptionFields ReplicationMap
-> Mod OptionFields ReplicationMap
-> Mod OptionFields ReplicationMap
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields ReplicationMap
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar String
"STRING"
                      Mod OptionFields ReplicationMap
-> Mod OptionFields ReplicationMap
-> Mod OptionFields ReplicationMap
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields ReplicationMap
forall (f :: * -> *) a. String -> Mod f a
help String
"Replication Map (i.e. \"eu-west:3,us-east:3\")"
                )
        )
    Parser (Bool -> Maybe String -> MigrationOpts)
-> Parser Bool -> Parser (Maybe String -> MigrationOpts)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Mod FlagFields Bool -> Parser Bool
switch
      ( String -> Mod FlagFields Bool
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"reset"
          Mod FlagFields Bool -> Mod FlagFields Bool -> Mod FlagFields Bool
forall a. Semigroup a => a -> a -> a
<> String -> Mod FlagFields Bool
forall (f :: * -> *) a. String -> Mod f a
help String
"Reset the keyspace before running migrations"
      )
    Parser (Maybe String -> MigrationOpts)
-> Parser (Maybe String) -> Parser MigrationOpts
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ( (Parser String -> Parser (Maybe String)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Parser String -> Parser (Maybe String))
-> (Mod OptionFields String -> Parser String)
-> Mod OptionFields String
-> Parser (Maybe String)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Mod OptionFields String -> Parser String
forall s. IsString s => Mod OptionFields s -> Parser s
strOption)
            ( String -> Mod OptionFields String
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"tls-ca-certificate-file"
                Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields String
forall (f :: * -> *) a. String -> Mod f a
help String
"Location of a PEM encoded list of CA certificates to be used when verifying the Cassandra server's certificate"
            )
        )