{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE ViewPatterns #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
#if __GLASGOW_HASKELL__ >= 800
{-# OPTIONS_GHC -Wno-missing-signatures #-}
#else
{-# OPTIONS_GHC -fno-warn-missing-signatures #-}
#endif
module Database.InfluxDB.Manage
  ( -- * Management query interface
    Query
  , manage

  -- * Query parameters
  , QueryParams
  , queryParams
  , server
  , database
  , precision
  , manager

  -- * Management query results
  -- ** SHOW QUERIES
  , ShowQuery
  , qid
  , queryText
  , duration

  -- ** SHOW SERIES
  , ShowSeries
  , key
  ) where
import Control.Exception
import Control.Monad

import Control.Lens
import Data.Aeson (Value(..), eitherDecode', encode, parseJSON)
import Data.Scientific (toBoundedInteger)
import Data.Text (Text)
import Data.Time.Clock
import qualified Data.Aeson.Types as A
import qualified Data.Attoparsec.Combinator as AC
import qualified Data.Attoparsec.Text as AT
import qualified Data.Text.Encoding as TE
import qualified Data.Vector as V
import qualified Network.HTTP.Client as HC
import qualified Network.HTTP.Types as HT

import Database.InfluxDB.JSON (getField)
import Database.InfluxDB.Types as Types
import Database.InfluxDB.Query hiding (query)
import qualified Database.InfluxDB.Format as F

-- $setup
-- >>> :set -XOverloadedStrings
-- >>> import Database.InfluxDB.Query
-- >>> import Database.InfluxDB.Format ((%))
-- >>> import Database.InfluxDB.Manage

-- | Send a database management query to InfluxDB.
--
-- >>> let db = "manage-test"
-- >>> let p = queryParams db
-- >>> manage p $ F.formatQuery ("CREATE DATABASE "%F.database) db
manage :: QueryParams -> Query -> IO ()
manage :: QueryParams -> Query -> IO ()
manage QueryParams
params Query
q = 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
$ QueryParams
paramsforall s a. s -> Getting a s a -> a
^.forall a. HasManager a => Lens' a (Either ManagerSettings Manager)
manager
  Response ByteString
response <- Request -> Manager -> IO (Response ByteString)
HC.httpLbs Request
request Manager
manager' 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)
  let body :: ByteString
body = forall body. Response body -> body
HC.responseBody Response ByteString
response
  case forall a. FromJSON a => ByteString -> Either [Char] a
eitherDecode' ByteString
body of
    Left [Char]
message ->
      forall e a. Exception e => e -> IO a
throwIO forall a b. (a -> b) -> a -> b
$ [Char] -> Request -> ByteString -> InfluxException
UnexpectedResponse [Char]
message Request
request ByteString
body
    Right Value
val -> do
      let parser :: Value -> Parser (Vector Empty)
parser = forall a.
QueryResults a =>
Decoder -> Precision 'QueryRequest -> Value -> Parser (Vector a)
parseQueryResultsWith
            (QueryParams
params forall s a. s -> Getting a s a -> a
^. Lens' QueryParams Decoder
decoder)
            (QueryParams
params forall s a. s -> Getting a s a -> a
^. forall (ty :: RequestType) a.
HasPrecision ty a =>
Lens' a (Precision ty)
precision)
      case forall a b. (a -> Parser b) -> a -> Result b
A.parse Value -> Parser (Vector Empty)
parser Value
val of
        A.Success (Vector Empty
_ :: V.Vector Empty) -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
        A.Error [Char]
message -> do
          let status :: Status
status = forall body. Response body -> Status
HC.responseStatus Response ByteString
response
          forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Status -> Bool
HT.statusIsServerError Status
status) forall a b. (a -> b) -> a -> b
$
            forall e a. Exception e => e -> IO a
throwIO forall a b. (a -> b) -> a -> b
$ [Char] -> InfluxException
ServerError [Char]
message
          forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Status -> Bool
HT.statusIsClientError Status
status) forall a b. (a -> b) -> a -> b
$
            forall e a. Exception e => e -> IO a
throwIO forall a b. (a -> b) -> a -> b
$ [Char] -> Request -> InfluxException
ClientError [Char]
message Request
request
          forall e a. Exception e => e -> IO a
throwIO forall a b. (a -> b) -> a -> b
$ [Char] -> Request -> ByteString -> InfluxException
UnexpectedResponse
            ([Char]
"BUG: " forall a. [a] -> [a] -> [a]
++ [Char]
message forall a. [a] -> [a] -> [a]
++ [Char]
" in Database.InfluxDB.Manage.manage")
            Request
request
            (forall a. ToJSON a => a -> ByteString
encode Value
val)
  where
    request :: Request
request = [(Method, Maybe Method)] -> Request -> Request
HC.setQueryString [(Method, Maybe Method)]
qs forall a b. (a -> b) -> a -> b
$ QueryParams -> Request
manageRequest QueryParams
params
    qs :: [(Method, Maybe Method)]
qs =
      [ (Method
"q", forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Query -> Method
F.fromQuery Query
q)
      ]

manageRequest :: QueryParams -> HC.Request
manageRequest :: QueryParams -> Request
manageRequest QueryParams
params = 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
"POST"
  , path :: Method
HC.path = Method
"/query"
  }
  where
    Server {Bool
Int
Text
_ssl :: Server -> Bool
_port :: Server -> Int
_host :: Server -> Text
_ssl :: Bool
_port :: Int
_host :: Text
..} = QueryParams
paramsforall s a. s -> Getting a s a -> a
^.forall a. HasServer a => Lens' a Server
server

-- |
-- >>> v <- query @ShowQuery (queryParams "_internal") "SHOW QUERIES"
data ShowQuery = ShowQuery
  { ShowQuery -> Int
showQueryQid :: !Int
  , ShowQuery -> Query
showQueryText :: !Query
  , ShowQuery -> Database
showQueryDatabase :: !Database
  , ShowQuery -> NominalDiffTime
showQueryDuration :: !NominalDiffTime
  }

instance QueryResults ShowQuery where
  parseMeasurement :: Precision 'QueryRequest
-> Maybe Text
-> HashMap Text Text
-> Vector Text
-> Array
-> Parser ShowQuery
parseMeasurement Precision 'QueryRequest
_ Maybe Text
_ HashMap Text Text
_ Vector Text
columns Array
fields =
    forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail [Char]
"parseResults: parse error") forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ do
      Number (forall i. (Integral i, Bounded i) => Scientific -> Maybe i
toBoundedInteger -> Just Int
showQueryQid) <-
        forall (m :: * -> *).
MonadFail m =>
Text -> Vector Text -> Array -> m Value
getField Text
"qid" Vector Text
columns Array
fields
      String (forall r. Format Query r -> r
F.formatQuery forall r. Format r (Text -> r)
F.text -> Query
showQueryText) <-
        forall (m :: * -> *).
MonadFail m =>
Text -> Vector Text -> Array -> m Value
getField Text
"query" Vector Text
columns Array
fields
      String (forall r. Format Database r -> r
F.formatDatabase forall r. Format r (Text -> r)
F.text -> Database
showQueryDatabase) <-
        forall (m :: * -> *).
MonadFail m =>
Text -> Vector Text -> Array -> m Value
getField Text
"database" Vector Text
columns Array
fields
      String (Text -> Either [Char] NominalDiffTime
parseDuration -> Right NominalDiffTime
showQueryDuration) <-
        forall (m :: * -> *).
MonadFail m =>
Text -> Vector Text -> Array -> m Value
getField Text
"duration" Vector Text
columns Array
fields
      forall (m :: * -> *) a. Monad m => a -> m a
return ShowQuery {Int
NominalDiffTime
Query
Database
showQueryDuration :: NominalDiffTime
showQueryDatabase :: Database
showQueryText :: Query
showQueryQid :: Int
showQueryDuration :: NominalDiffTime
showQueryDatabase :: Database
showQueryText :: Query
showQueryQid :: Int
..}

parseDuration :: Text -> Either String NominalDiffTime
parseDuration :: Text -> Either [Char] NominalDiffTime
parseDuration = forall a. Parser a -> Text -> Either [Char] a
AT.parseOnly Parser Text NominalDiffTime
duration
  where
    duration :: Parser Text NominalDiffTime
duration = forall a. Num a => a -> a -> a
(*)
      forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a b. (Integral a, Num b) => a -> b
fromIntegral @Int) forall a. Integral a => Parser a
AT.decimal
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Text NominalDiffTime
unit
    unit :: Parser Text NominalDiffTime
unit = forall (f :: * -> *) a. Alternative f => [f a] -> f a
AC.choice
      [ NominalDiffTime
10forall a b. (Fractional a, Integral b) => a -> b -> a
^^(-Int
6 :: Int) forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Text -> Parser Text
AT.string Text
"µs"
      , NominalDiffTime
1 forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Char -> Parser Char
AT.char Char
's'
      , NominalDiffTime
60 forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Char -> Parser Char
AT.char Char
'm'
      , NominalDiffTime
3600 forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Char -> Parser Char
AT.char Char
'h'
      ]

newtype ShowSeries = ShowSeries
  { ShowSeries -> Key
_key :: Key
  }

instance QueryResults ShowSeries where
  parseMeasurement :: Precision 'QueryRequest
-> Maybe Text
-> HashMap Text Text
-> Vector Text
-> Array
-> Parser ShowSeries
parseMeasurement Precision 'QueryRequest
_ Maybe Text
_ HashMap Text Text
_ Vector Text
columns Array
fields = do
    Text
name <- forall (m :: * -> *).
MonadFail m =>
Text -> Vector Text -> Array -> m Value
getField Text
"key" Vector Text
columns Array
fields forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a. FromJSON a => Value -> Parser a
parseJSON
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Key -> ShowSeries
ShowSeries forall a b. (a -> b) -> a -> b
$ forall r. Format Key r -> r
F.formatKey forall r. Format r (Text -> r)
F.text Text
name

makeLensesWith
  ( lensRules
    & generateSignatures .~ False
    & lensField .~ lookingupNamer
      [ ("showQueryQid", "qid")
      , ("showQueryText", "queryText")
      , ("showQueryDatabase", "_database")
      , ("showQueryDuration", "duration")
      ]
  ) ''ShowQuery

-- | Query ID
--
-- >>> v <- query @ShowQuery (queryParams "_internal") "SHOW QUERIES"
-- >>> v ^.. each.qid
-- ...
qid :: Lens' ShowQuery Int

-- | Query text
--
-- >>> v <- query @ShowQuery (queryParams "_internal") "SHOW QUERIES"
-- >>> v ^.. each.queryText
-- ...
queryText :: Lens' ShowQuery Query

-- |
-- >>> v <- query @ShowQuery (queryParams "_internal") "SHOW QUERIES"
-- >>> v ^.. each.database
-- ...
instance HasDatabase ShowQuery where
  database :: Lens' ShowQuery Database
database = Lens' ShowQuery Database
_database

-- | Duration of the query
--
-- >>> v <- query @ShowQuery (queryParams "_internal") "SHOW QUERIES"
-- >>> v ^.. each.duration
-- ...
duration :: Lens' ShowQuery NominalDiffTime

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

-- | Series name
--
-- >>> v <- query @ShowSeries (queryParams "_internal") "SHOW SERIES"
-- >>> length $ v ^.. each.key
-- ...
key :: Lens' ShowSeries Key