Discovery.hs

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

{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TemplateHaskell   #-}
{-# LANGUAGE TypeApplications  #-}
{-# LANGUAGE TypeFamilies      #-}

module Database.CQL.IO.Cluster.Discovery where

import Control.Lens (makeFields) 
import Data.Functor.Identity (Identity)
import Data.Int (Int32)
import Data.IP
import Data.Text (Text)
import Data.UUID (UUID, nil)
import Data.Word (Word32)
import Database.CQL.Protocol hiding (Keyspace)
import qualified Database.CQL.Protocol as CQL

data Peer = Peer
    { peerAddr        :: !IP
    , peerDC          :: !Text
    , peerHostId      :: !UUID
    , peerPreferredIp :: !(Maybe IP)
    , peerRack        :: !Text
    , peerReleaseVer  :: !Text
    , peerRPC         :: !IP
        -- ^ The address for the client to connect to.
    , peerSchemaVer   :: !UUID
    , peerTokens      :: !(CQL.Set Text)
    } deriving Show

recordInstance ''Peer
makeFields ''Peer

data PeerV2 = PeerV2
    { peerV2Addr          :: !IP
    , peerV2Port          :: !Word32
    , peerV2DC            :: !Text
    , peerV2HostId        :: !UUID
    , peerV2NativeAddr    :: !IP
    -- ^ The address for the client to connect to.
    , peerV2NativePort    :: !Word32
    -- ^ The port for the client to connect to.
    , peerV2PreferredIp   :: !(Maybe IP)
    , peerV2PreferredPort :: !(Maybe Word32)
    , peerV2Rack          :: !Text
    , peerV2ReleaseVer    :: !Text
    , peerV2SchemaVer     :: !UUID
    , peerV2Tokens        :: !(CQL.Set Text)
    } deriving Show

recordInstance ''PeerV2
makeFields ''PeerV2

data LocalV3 = LocalV3
    { localV3Bootstrapped :: !Text
    , localV3BroadcastAddr :: !IP
    , localV3ClusterName :: !Text
    , localV3CqlVer :: !Text
    , localV3DC :: !Text
    , localV3GossipGeneration :: !Int32
    , localV3HostId :: !UUID
    , localV3ListenAddr :: !IP
    , localV3NativeProtocolVer :: !Text
    , localV3Partitioner :: !Text
    , localV3Rack :: !Text
    , localV3ReleaseVer :: !Text
    , localV3RpcAddr :: !IP
    , localV3SchemaVer :: !UUID
    , localV3Tokens :: !(CQL.Set Text)
    }
  deriving (Eq, Show)
recordInstance ''LocalV3
makeFields ''LocalV3

data LocalV4 = LocalV4
    { localV4Bootstrapped :: !Text
    , localV4BroadcastAddr :: !IP
    , localV4BroadcastPort :: !Word32
    , localV4ClusterName :: !Text
    , localV4CqlVer :: !Text
    , localV4DC :: !Text
    , localV4GossipGeneration :: !Int32
    , localV4HostId :: !UUID
    , localV4ListenAddr :: !IP
    , localV4ListenPort :: !Word32
    , localV4NativeProtocolVer :: !Text
    , localV4Partitioner :: !Text
    , localV4Rack :: !Text
    , localV4ReleaseVer :: !Text
    , localV4RpcAddr :: !IP
    , localV4RpcPort :: !Word32
    , localV4SchemaVer :: !UUID
    , localV4Tokens :: !(CQL.Set Text)
    }
  deriving (Eq, Show)

recordInstance ''LocalV4
makeFields ''LocalV4

data Local = LocalV3_ !LocalV3 | LocalV4_ !LocalV4
  deriving (Eq, Show)

data Keyspace = Keyspace
    { keyspaceName :: !CQL.Keyspace
    , keyspaceDurableWrites :: !Bool
    , keyspaceReplication :: !(CQL.Map Text Text)
    }
  deriving (Eq, Show)

recordInstance ''Keyspace
makeFields ''Keyspace

dummyLocal :: Local
dummyLocal = LocalV4_ LocalV4
  { localV4Bootstrapped = "COMPLETED"
  , localV4BroadcastAddr = IPv4 $ toIPv4 [127,0,0,1]
  , localV4BroadcastPort = 7000
  , localV4ClusterName = "Test Cluster"
  , localV4CqlVer = "3.4.5"
  , localV4GossipGeneration = 0
  , localV4DC = "DC1"
  , localV4HostId = nil
  , localV4ListenAddr = IPv4 $ toIPv4 [127,0,0,1]
  , localV4ListenPort = 7000
  , localV4NativeProtocolVer = "4"
  , localV4Partitioner = "org.apache.cassandra.dht.Murmur3Partitioner"
  , localV4Rack = "RAC1"
  , localV4ReleaseVer = "4.0.17"
  , localV4RpcAddr = IPv4 $ toIPv4 [127,0,0,1]
  , localV4RpcPort = 9042
  , localV4SchemaVer = nil
  , localV4Tokens = CQL.Set []
  }

instance HasBroadcastAddr Local IP where
  broadcastAddr f l = case l of
    LocalV3_ l3 -> LocalV3_ <$> broadcastAddr f l3
    LocalV4_ l4 -> LocalV4_ <$> broadcastAddr f l4

instance HasCqlVer Local Text where
  cqlVer f l = case l of
    LocalV3_ l3 -> LocalV3_ <$> cqlVer f l3
    LocalV4_ l4 -> LocalV4_ <$> cqlVer f l4

instance HasDC Local Text where
  dC f l = case l of
    LocalV3_ l3 -> LocalV3_ <$> dC f l3
    LocalV4_ l4 -> LocalV4_ <$> dC f l4

instance HasHostId Local UUID where
  hostId f l = case l of
    LocalV3_ l3 -> LocalV3_ <$> hostId f l3
    LocalV4_ l4 -> LocalV4_ <$> hostId f l4

instance HasNativeProtocolVer Local Text where
  nativeProtocolVer f l = case l of
    LocalV3_ l3 -> LocalV3_ <$> nativeProtocolVer f l3
    LocalV4_ l4 -> LocalV4_ <$> nativeProtocolVer f l4

instance HasPartitioner Local Text where
  partitioner f l = case l of
    LocalV3_ l3 -> LocalV3_ <$> partitioner f l3
    LocalV4_ l4 -> LocalV4_ <$> partitioner f l4

instance HasRack Local Text where
  rack f l = case l of
    LocalV3_ l3 -> LocalV3_ <$> rack f l3
    LocalV4_ l4 -> LocalV4_ <$> rack f l4


instance HasReleaseVer Local Text where
  releaseVer f l = case l of
    LocalV3_ l3 -> LocalV3_ <$> releaseVer f l3
    LocalV4_ l4 -> LocalV4_ <$> releaseVer f l4

instance HasRpcAddr Local IP where
  rpcAddr f l = case l of
    LocalV3_ l3 -> LocalV3_ <$> rpcAddr f l3
    LocalV4_ l4 -> LocalV4_ <$> rpcAddr f l4

instance HasTokens Local (CQL.Set Text) where
  tokens f l = case l of
    LocalV3_ l3 -> LocalV3_ <$> tokens f l3
    LocalV4_ l4 -> LocalV4_ <$> tokens f l4

mURMUR3_PARTITIONER :: Text
mURMUR3_PARTITIONER = "org.apache.cassandra.dht.Murmur3Partitioner"

peers :: QueryString R () (IP, Text, UUID, Maybe IP, Text, Text, IP, UUID, CQL.Set Text)
peers = "SELECT peer, data_center, host_id, preferred_ip, rack, \
         \release_version, rpc_address, schema_version, tokens FROM \
         \system.peers"

peer :: QueryString R (Identity IP) (IP, Text, UUID, Maybe IP, Text, Text, IP, UUID, CQL.Set Text)
peer = "SELECT peer, data_center, host_id, preferred_ip, rack, \
        \release_version, rpc_address, schema_version, tokens FROM \
        \system.peers WHERE peer = ?"

peersV2 :: QueryString R () (IP, Word32, Text, UUID, IP, Word32, Maybe IP, Maybe Word32, Text, Text, UUID, CQL.Set Text)
peersV2 = "SELECT peer, peer_port, data_center, host_id, native_address, \
          \native_port, preferred_ip, preferred_port, rack, release_version, \
          \schema_version, tokens FROM system.peers_v2"

peerV2 :: QueryString R (Identity IP) (IP, Word32, Text, UUID, IP, Word32, Maybe IP, Maybe Word32, Text, Text, UUID, CQL.Set Text)
peerV2 = "SELECT peer, peer_port, data_center, host_id, native_address, \
          \native_port, preferred_ip, preferred_port, rack, release_version, \
          \schema_version, tokens FROM system.peers_v2 WHERE peer = ?"

localV4 :: QueryString R () (Text, IP, Word32, Text, Text, Text, Int32, UUID, IP, Word32, Text, Text, Text, Text, IP, Word32, UUID, CQL.Set Text)
localV4 = "SELECT bootstrapped, broadcast_address, broadcast_port, cluster_name, \
          \cql_version, data_center, gossip_generation, host_id, listen_address, \
          \listen_port, native_protocol_version, partitioner, rack, \
          \release_version, rpc_address, rpc_port, schema_version, tokens \
          \FROM system.local WHERE key = 'local'"

localV3 :: QueryString R () (Text, IP, Text, Text, Text, Int32, UUID, IP, Text, Text, Text, Text, IP, UUID, CQL.Set Text)
localV3 = "SELECT bootstrapped, broadcast_address, cluster_name, \
          \cql_version, data_center, gossip_generation, host_id, listen_address, \
          \native_protocol_version, partitioner, rack, \
          \release_version, rpc_address, schema_version, tokens \
          \FROM system.local WHERE key = 'local'"

keyspaces :: QueryString R () (CQL.Keyspace, Bool, CQL.Map Text Text)
keyspaces = "SELECT keyspace_name, durable_writes, replication FROM \
            \system_schema.keyspaces"

keyspace :: QueryString R (Identity CQL.Keyspace) (CQL.Keyspace, Bool, CQL.Map Text Text)
keyspace = "SELECT keyspace_name, durable_writes, replication FROM \
            \system_schema.keyspaces WHERE keyspace_name = ?"