{-# LANGUAGE CPP #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE TemplateHaskell #-}
#if __GLASGOW_HASKELL__ >= 800
{-# OPTIONS_GHC -Wno-missing-signatures #-}
#else
{-# OPTIONS_GHC -fno-warn-missing-signatures #-}
#endif
module Database.InfluxDB.Ping
  ( -- * Ping interface
    ping

  -- * Ping parameters
  , PingParams
  , pingParams
  , server
  , manager
  , timeout

  -- * Pong
  , Pong
  , roundtripTime
  , influxdbVersion
  ) where
import Control.Exception

import Control.Lens
import Data.Time.Clock (NominalDiffTime)
import System.Clock
import qualified Data.ByteString as BS
import qualified Data.Text.Encoding as TE
import qualified Network.HTTP.Client as HC

import Database.InfluxDB.Types as Types

-- $setup
-- >>> import Database.InfluxDB.Ping

-- Ping requests do not require authentication
-- | The full set of parameters for the ping API
--
-- Following lenses are available to access its fields:
--
-- * 'server'
-- * 'manager'
-- * 'timeout'
data PingParams = PingParams
  { PingParams -> Server
pingServer :: !Server
  , PingParams -> Either ManagerSettings Manager
pingManager :: !(Either HC.ManagerSettings HC.Manager)
  -- ^ HTTP connection manager
  , PingParams -> Maybe NominalDiffTime
pingTimeout :: !(Maybe NominalDiffTime)
  -- ^ Timeout
  }

-- | Smart constructor for 'PingParams'
--
-- Default parameters:
--
--   ['server'] 'defaultServer'
--   ['manager'] @'Left' 'HC.defaultManagerSettings'@
--   ['timeout'] 'Nothing'
pingParams :: PingParams
pingParams :: PingParams
pingParams = PingParams
  { pingServer :: Server
pingServer = Server
defaultServer
  , pingManager :: Either ManagerSettings Manager
pingManager = forall a b. a -> Either a b
Left ManagerSettings
HC.defaultManagerSettings
  , pingTimeout :: Maybe NominalDiffTime
pingTimeout = forall a. Maybe a
Nothing
  }

makeLensesWith
  ( lensRules
    & generateSignatures .~ False
    & lensField .~ lookingupNamer
      [ ("pingServer", "_server")
      , ("pingManager", "_manager")
      , ("pingTimeout", "timeout")
      ]
    )
  ''PingParams

-- |
-- >>> pingParams ^. server.host
-- "localhost"
instance HasServer PingParams where
  server :: Lens' PingParams Server
server = Lens' PingParams Server
_server

-- |
-- >>> let p = pingParams & manager .~ Left HC.defaultManagerSettings
instance HasManager PingParams where
  manager :: Lens' PingParams (Either ManagerSettings Manager)
manager = Lens' PingParams (Either ManagerSettings Manager)
_manager

-- | The number of seconds to wait before returning a response
--
-- >>> pingParams ^. timeout
-- Nothing
-- >>> let p = pingParams & timeout ?~ 1
timeout :: Lens' PingParams (Maybe NominalDiffTime)

pingRequest :: PingParams -> HC.Request
pingRequest :: PingParams -> Request
pingRequest PingParams {Maybe NominalDiffTime
Either ManagerSettings Manager
Server
pingTimeout :: Maybe NominalDiffTime
pingManager :: Either ManagerSettings Manager
pingServer :: Server
pingTimeout :: PingParams -> Maybe NominalDiffTime
pingManager :: PingParams -> Either ManagerSettings Manager
pingServer :: PingParams -> Server
..} = Request
HC.defaultRequest
  { host :: Method
HC.host = Text -> Method
TE.encodeUtf8 Text
_host
  , port :: Int
HC.port = forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
_port
  , secure :: Bool
HC.secure = Bool
_ssl
  , method :: Method
HC.method = Method
"GET"
  , path :: Method
HC.path = Method
"/ping"
  }
  where
    Server {Bool
Int
Text
_ssl :: Server -> Bool
_port :: Server -> Int
_host :: Server -> Text
_ssl :: Bool
_port :: Int
_host :: Text
..} = Server
pingServer

-- | Response of a ping request
data Pong = Pong
  { Pong -> TimeSpec
_roundtripTime :: !TimeSpec
  -- ^ Round-trip time of the ping
  , Pong -> Method
_influxdbVersion :: !BS.ByteString
  -- ^ Version string returned by InfluxDB
  } deriving (Int -> Pong -> ShowS
[Pong] -> ShowS
Pong -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Pong] -> ShowS
$cshowList :: [Pong] -> ShowS
show :: Pong -> String
$cshow :: Pong -> String
showsPrec :: Int -> Pong -> ShowS
$cshowsPrec :: Int -> Pong -> ShowS
Show, Pong -> Pong -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Pong -> Pong -> Bool
$c/= :: Pong -> Pong -> Bool
== :: Pong -> Pong -> Bool
$c== :: Pong -> Pong -> Bool
Eq, Eq Pong
Pong -> Pong -> Bool
Pong -> Pong -> Ordering
Pong -> Pong -> Pong
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Pong -> Pong -> Pong
$cmin :: Pong -> Pong -> Pong
max :: Pong -> Pong -> Pong
$cmax :: Pong -> Pong -> Pong
>= :: Pong -> Pong -> Bool
$c>= :: Pong -> Pong -> Bool
> :: Pong -> Pong -> Bool
$c> :: Pong -> Pong -> Bool
<= :: Pong -> Pong -> Bool
$c<= :: Pong -> Pong -> Bool
< :: Pong -> Pong -> Bool
$c< :: Pong -> Pong -> Bool
compare :: Pong -> Pong -> Ordering
$ccompare :: Pong -> Pong -> Ordering
Ord)

makeLensesWith (lensRules & generateSignatures .~ False) ''Pong

-- | Round-trip time of the ping
roundtripTime :: Lens' Pong TimeSpec

-- | Version string returned by InfluxDB
influxdbVersion :: Lens' Pong BS.ByteString

-- | Send a ping to InfluxDB.
--
-- It may throw an 'InfluxException'.
ping :: PingParams -> IO Pong
ping :: PingParams -> IO Pong
ping PingParams
params = do
  Manager
manager' <- forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either ManagerSettings -> IO Manager
HC.newManager forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ PingParams -> Either ManagerSettings Manager
pingManager PingParams
params
  TimeSpec
startTime <- IO TimeSpec
getTimeMonotonic
  forall a.
Request -> Manager -> (Response BodyReader -> IO a) -> IO a
HC.withResponse Request
request Manager
manager' forall a b. (a -> b) -> a -> b
$ \Response BodyReader
response -> do
    TimeSpec
endTime <- IO TimeSpec
getTimeMonotonic
    case forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup HeaderName
"X-Influxdb-Version" (forall body. Response body -> ResponseHeaders
HC.responseHeaders Response BodyReader
response) of
      Just Method
version ->
        forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! TimeSpec -> Method -> Pong
Pong (TimeSpec -> TimeSpec -> TimeSpec
diffTimeSpec TimeSpec
endTime TimeSpec
startTime) Method
version
      Maybe Method
Nothing ->
        forall e a. Exception e => e -> IO a
throwIO forall a b. (a -> b) -> a -> b
$ String -> Request -> ByteString -> InfluxException
UnexpectedResponse
          String
"The X-Influxdb-Version header was missing in the response."
          Request
request
          ByteString
""
  forall e a. Exception e => IO a -> (e -> IO a) -> IO a
`catch` (forall e a. Exception e => e -> IO a
throwIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. HttpException -> InfluxException
HTTPException)
  where
    request :: Request
request = (PingParams -> Request
pingRequest PingParams
params)
      { responseTimeout :: ResponseTimeout
HC.responseTimeout = case PingParams -> Maybe NominalDiffTime
pingTimeout PingParams
params of
        Maybe NominalDiffTime
Nothing -> ResponseTimeout
HC.responseTimeoutNone
        Just NominalDiffTime
sec -> Int -> ResponseTimeout
HC.responseTimeoutMicro forall a b. (a -> b) -> a -> b
$
          forall a b. (RealFrac a, Integral b) => a -> b
round forall a b. (a -> b) -> a -> b
$ forall a b. (Real a, Fractional b) => a -> b
realToFrac NominalDiffTime
sec forall a. Fractional a => a -> a -> a
/ (Double
10forall a. Floating a => a -> a -> a
**(-Double
6) :: Double)
      }
    getTimeMonotonic :: IO TimeSpec
getTimeMonotonic = Clock -> IO TimeSpec
getTime Clock
Monotonic