Host.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 CPP               #-}
{-# LANGUAGE OverloadedStrings #-}

module Database.CQL.IO.Cluster.Host where

import Control.Lens (Lens', (^.))
import Database.CQL.Protocol (Response (..))
import Database.CQL.IO.Cluster.Discovery hiding (broadcastAddr, rack, hostId)
import qualified Database.CQL.IO.Cluster.Discovery as Disco (broadcastAddr, rack, hostId)
import Data.IP
import Data.Text (Text, unpack)
import Network.Socket (SockAddr (..), PortNumber)
import Data.UUID (UUID, nil)

-- | A Cassandra host known to the client.
data Host = Host
    { _hostAddr   :: !InetAddr
    , _broadcastAddr :: !InetAddr
    , _hostId :: !UUID
    , _dataCentre :: !Text
    , _rack       :: !Text
    }

dummyHost :: InetAddr -> Host
dummyHost a = Host
    { _hostAddr = a
    , _broadcastAddr = a
    , _hostId = nil
    , _dataCentre = ""
    , _rack = ""
    }

instance Eq Host where
    a == b = _hostAddr a == _hostAddr b

instance Ord Host where
    compare a b = compare (_hostAddr a) (_hostAddr b)

peer2Host :: PortNumber -> Peer -> Host
peer2Host i p = Host
  { _hostAddr = ip2inet i (peerRPC p)
  , _broadcastAddr = ip2inet 7000 (peerAddr p)
  , _hostId = peerHostId p
  , _dataCentre = peerDC p
  , _rack = peerRack p
  }

peer2HostV2 :: PeerV2 -> Host
peer2HostV2 peer2 =
  let nativePortNum = fromIntegral . peerV2NativePort $ peer2
      broadcastPortNum = fromIntegral . peerV2Port $ peer2
   in Host
        { _hostAddr = ip2inet nativePortNum (peerV2NativeAddr peer2)
        , _broadcastAddr = ip2inet broadcastPortNum (peerV2Addr peer2)
        , _hostId = peerV2HostId peer2
        , _dataCentre = peerV2DC peer2
        , _rack = peerV2Rack peer2
        }

local2Host :: PortNumber -> Local -> Host
local2Host settingsPort curLocal =
  let rpcPortNum = case curLocal of
        LocalV3_ _ -> settingsPort
        LocalV4_ l4 -> fromIntegral $ l4 ^. rpcPort
      broadcastPortNum = case curLocal of
        LocalV3_ _ -> 7000
        LocalV4_ l4 -> fromIntegral $ l4 ^. broadcastPort
   in Host
        { _hostAddr = ip2inet rpcPortNum (curLocal^.rpcAddr)
        , _broadcastAddr = ip2inet broadcastPortNum (curLocal ^. Disco.broadcastAddr)
        , _hostId = curLocal ^. Disco.hostId
        , _dataCentre = curLocal^.dC
        , _rack = curLocal ^. Disco.rack
        }

updateHost :: Host -> Maybe (Text, Text) -> Host
updateHost h (Just (dc, rk)) = h { _dataCentre = dc, _rack = rk }
updateHost h Nothing         = h

-- | A response that is known to originate from a specific 'Host'.
data HostResponse k a b = HostResponse
    { hrHost     :: !Host
    , hrResponse :: !(Response k a b)
    } deriving (Show)

-- | This event will be passed to a 'Policy' to inform it about
-- cluster changes.
data HostEvent
    = HostNew  !Host     -- ^ a new host has been added to the cluster
    | HostGone !Host -- ^ a host has been removed from the cluster
    | HostUp   !Host -- ^ a host has been started
    | HostDown !Host -- ^ a host has been stopped
    | AddrDown !InetAddr -- ^ an address was reported down, we could not find the corresponding host.

-- | The IP address and port number of a host.
hostAddr :: Lens' Host InetAddr
hostAddr f h = fmap (\x -> h {_hostAddr = x}) (f (_hostAddr h))
{-# INLINE hostAddr #-}

-- | The IP address and port number that will be used for events about a host.
broadcastAddr :: Lens' Host InetAddr
broadcastAddr f h = fmap (\x -> h {_broadcastAddr = x}) (f (_broadcastAddr h))
{-# INLINE broadcastAddr #-}

-- | The UUID hostId of a host.
hostId :: Lens' Host UUID
hostId f h = fmap (\x -> h {_hostId = x}) (f (_hostId h))
{-# INLINE hostId #-}

-- | The data centre name (may be an empty string).
dataCentre :: Lens' Host Text
dataCentre f h = fmap (\x -> h {_dataCentre = x}) (f (_dataCentre h))
{-# INLINE dataCentre #-}

-- | The rack name (may be an empty string).
rack :: Lens' Host Text
rack f h = fmap (\x -> h {_rack = x}) (f (_rack h))
{-# INLINE rack #-}

instance Show Host where
    show h = showString (unpack (_dataCentre h))
           . showString ":"
           . showString (unpack (_rack h))
           . showString ":"
           . shows (_hostAddr h)
           . showString ":"
           . shows (_broadcastAddr h)
           $ ""

-----------------------------------------------------------------------------
-- InetAddr

newtype InetAddr = InetAddr { sockAddr :: SockAddr }
    deriving (Eq, Ord)

instance Show InetAddr where
    show (InetAddr (SockAddrInet p a)) =
        let i = fromIntegral p :: Int in
        shows (fromHostAddress a) . showString ":" . shows i $ ""
    show (InetAddr (SockAddrInet6 p _ a _)) =
        let i = fromIntegral p :: Int in
        shows (fromHostAddress6 a) . showString ":" . shows i $ ""
    show (InetAddr (SockAddrUnix unix)) = unix
#if MIN_VERSION_network(2,6,1) && !MIN_VERSION_network(3,0,0)
    show (InetAddr (SockAddrCan int32)) = show int32
#endif

-- | Map a 'SockAddr' into an 'InetAddr', using the given port number.
sock2inet :: PortNumber -> SockAddr -> InetAddr
sock2inet i (SockAddrInet _ a)      = InetAddr (SockAddrInet i a)
sock2inet i (SockAddrInet6 _ f a b) = InetAddr (SockAddrInet6 i f a b)
sock2inet _ unix                    = InetAddr unix

-- | Map an 'IP' into an 'InetAddr', using the given port number.
ip2inet :: PortNumber -> IP -> InetAddr
ip2inet p (IPv4 a) = InetAddr $ SockAddrInet p (toHostAddress a)
ip2inet p (IPv6 a) = InetAddr $ SockAddrInet6 p 0 (toHostAddress6 a) 0

inet2ip :: InetAddr -> IP
inet2ip (InetAddr (SockAddrInet _ a)) = IPv4 (fromHostAddress a)
inet2ip (InetAddr (SockAddrInet6 _ _ a6 _)) = IPv6 (fromHostAddress6 a6)
inet2ip x = error $ "inet2ip: expecting IPv4 or IPv6, got: " ++ show x

inet2ipPort :: InetAddr -> (IP, PortNumber)
inet2ipPort (InetAddr (SockAddrInet p a)) = (IPv4 (fromHostAddress a), p)
inet2ipPort (InetAddr (SockAddrInet6 p _ a6 _)) = (IPv6 (fromHostAddress6 a6), p)
inet2ipPort x = error $ "inet2ipPort: expecting IPv4 or IPv6, got: " ++ show x