module Database.InfluxDB.Ping
(
ping
, PingParams(..)
, pingParams
, Types.server
, Types.manager
, waitForLeader
, PingResult(..)
, roundtripTime
, influxdbVersion
) where
import Control.Lens
import qualified Data.ByteString as BS
import qualified Data.Text.Encoding as TE
import qualified Network.HTTP.Client.Compat as HC
import System.Clock
import Database.InfluxDB.Types as Types
data PingParams = PingParams
{ _server :: !Server
, _manager :: !(Either HC.ManagerSettings HC.Manager)
, _waitForLeader :: !(Maybe Int)
}
makeLensesWith (lensRules & generateSignatures .~ False) ''PingParams
server :: Lens' PingParams Server
instance HasServer PingParams where
server = Database.InfluxDB.Ping.server
manager :: Lens' PingParams (Either HC.ManagerSettings HC.Manager)
instance HasManager PingParams where
manager = Database.InfluxDB.Ping.manager
waitForLeader :: Lens' PingParams (Maybe Int)
pingParams :: PingParams
pingParams =
PingParams
{ _server = localServer
, _manager = Left HC.defaultManagerSettings
, _waitForLeader = Nothing
}
pingRequest :: PingParams -> HC.Request
pingRequest PingParams {..} = HC.defaultRequest
{ HC.host = TE.encodeUtf8 _host
, HC.port = fromIntegral _port
, HC.secure = _ssl
, HC.method = "GET"
, HC.path = "/ping"
}
where
Server {..} = _server
data PingResult = PingResult
{ _roundtripTime :: !TimeSpec
, _influxdbVersion :: !BS.ByteString
} deriving (Show, Eq, Ord)
makeLensesWith (lensRules & generateSignatures .~ False) ''PingResult
roundtripTime :: Lens' PingResult TimeSpec
influxdbVersion :: Lens' PingResult BS.ByteString
ping :: PingParams -> IO PingResult
ping params = do
manager' <- either HC.newManager return $ _manager params
startTime <- getTime'
HC.withResponse request manager' (\response -> do
endTime <- getTime'
let headers = HC.responseHeaders response
case lookup "X-Influxdb-Version" headers of
Just version -> pure (PingResult (diffTimeSpec endTime startTime) version)
Nothing -> error "A response by influxdb should always contain a version header.")
where
request = pingRequest params
getTime' = getTime Monotonic