{-# 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' <- (ManagerSettings -> IO Manager)
-> (Manager -> IO Manager)
-> Either ManagerSettings Manager
-> IO Manager
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either ManagerSettings -> IO Manager
HC.newManager Manager -> IO Manager
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either ManagerSettings Manager -> IO Manager)
-> Either ManagerSettings Manager -> IO Manager
forall a b. (a -> b) -> a -> b
$ QueryParams
paramsQueryParams
-> Getting
     (Either ManagerSettings Manager)
     QueryParams
     (Either ManagerSettings Manager)
-> Either ManagerSettings Manager
forall s a. s -> Getting a s a -> a
^.Getting
  (Either ManagerSettings Manager)
  QueryParams
  (Either ManagerSettings Manager)
forall a. HasManager a => Lens' a (Either ManagerSettings Manager)
Lens' QueryParams (Either ManagerSettings Manager)
manager
  Response ByteString
response <- Request -> Manager -> IO (Response ByteString)
HC.httpLbs Request
request Manager
manager' IO (Response ByteString)
-> (HttpException -> IO (Response ByteString))
-> IO (Response ByteString)
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
`catch` (InfluxException -> IO (Response ByteString)
forall e a. Exception e => e -> IO a
throwIO (InfluxException -> IO (Response ByteString))
-> (HttpException -> InfluxException)
-> HttpException
-> IO (Response ByteString)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HttpException -> InfluxException
HTTPException)
  let body :: ByteString
body = Response ByteString -> ByteString
forall body. Response body -> body
HC.responseBody Response ByteString
response
  case ByteString -> Either [Char] Value
forall a. FromJSON a => ByteString -> Either [Char] a
eitherDecode' ByteString
body of
    Left [Char]
message ->
      InfluxException -> IO ()
forall e a. Exception e => e -> IO a
throwIO (InfluxException -> IO ()) -> InfluxException -> IO ()
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 = Decoder
-> Precision 'QueryRequest -> Value -> Parser (Vector Empty)
forall a.
QueryResults a =>
Decoder -> Precision 'QueryRequest -> Value -> Parser (Vector a)
parseQueryResultsWith
            (QueryParams
params QueryParams -> Getting Decoder QueryParams Decoder -> Decoder
forall s a. s -> Getting a s a -> a
^. Getting Decoder QueryParams Decoder
Lens' QueryParams Decoder
decoder)
            (QueryParams
params QueryParams
-> Getting
     (Precision 'QueryRequest) QueryParams (Precision 'QueryRequest)
-> Precision 'QueryRequest
forall s a. s -> Getting a s a -> a
^. Getting
  (Precision 'QueryRequest) QueryParams (Precision 'QueryRequest)
forall (ty :: RequestType) a.
HasPrecision ty a =>
Lens' a (Precision ty)
Lens' QueryParams (Precision 'QueryRequest)
precision)
      case (Value -> Parser (Vector Empty)) -> Value -> Result (Vector Empty)
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) -> () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
        A.Error [Char]
message -> do
          let status :: Status
status = Response ByteString -> Status
forall body. Response body -> Status
HC.responseStatus Response ByteString
response
          Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Status -> Bool
HT.statusIsServerError Status
status) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
            InfluxException -> IO ()
forall e a. Exception e => e -> IO a
throwIO (InfluxException -> IO ()) -> InfluxException -> IO ()
forall a b. (a -> b) -> a -> b
$ [Char] -> InfluxException
ServerError [Char]
message
          Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Status -> Bool
HT.statusIsClientError Status
status) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
            InfluxException -> IO ()
forall e a. Exception e => e -> IO a
throwIO (InfluxException -> IO ()) -> InfluxException -> IO ()
forall a b. (a -> b) -> a -> b
$ [Char] -> Request -> InfluxException
ClientError [Char]
message Request
request
          InfluxException -> IO ()
forall e a. Exception e => e -> IO a
throwIO (InfluxException -> IO ()) -> InfluxException -> IO ()
forall a b. (a -> b) -> a -> b
$ [Char] -> Request -> ByteString -> InfluxException
UnexpectedResponse
            ([Char]
"BUG: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
message [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" in Database.InfluxDB.Manage.manage")
            Request
request
            (Value -> ByteString
forall a. ToJSON a => a -> ByteString
encode Value
val)
  where
    request :: Request
request = [(Method, Maybe Method)] -> Request -> Request
HC.setQueryString [(Method, Maybe Method)]
qs (Request -> Request) -> Request -> Request
forall a b. (a -> b) -> a -> b
$ QueryParams -> Request
manageRequest QueryParams
params
    qs :: [(Method, Maybe Method)]
qs =
      [ (Method
"q", Method -> Maybe Method
forall a. a -> Maybe a
Just (Method -> Maybe Method) -> Method -> Maybe Method
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
  { HC.host = TE.encodeUtf8 _host
  , HC.port = fromIntegral _port
  , HC.secure = _ssl
  , HC.method = "POST"
  , HC.path = "/query"
  }
  where
    Server {Bool
Int
Text
_host :: Text
_port :: Int
_ssl :: Bool
_host :: Server -> Text
_port :: Server -> Int
_ssl :: Server -> Bool
..} = QueryParams
paramsQueryParams -> Getting Server QueryParams Server -> Server
forall s a. s -> Getting a s a -> a
^.Getting Server QueryParams Server
forall a. HasServer a => Lens' a Server
Lens' QueryParams 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 =
    Parser ShowQuery
-> (ShowQuery -> Parser ShowQuery)
-> Maybe ShowQuery
-> Parser ShowQuery
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ([Char] -> Parser ShowQuery
forall a. [Char] -> Parser a
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail [Char]
"parseResults: parse error") ShowQuery -> Parser ShowQuery
forall a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe ShowQuery -> Parser ShowQuery)
-> Maybe ShowQuery -> Parser ShowQuery
forall a b. (a -> b) -> a -> b
$ do
      Number (Scientific -> Maybe Int
forall i. (Integral i, Bounded i) => Scientific -> Maybe i
toBoundedInteger -> Just Int
showQueryQid) <-
        Text -> Vector Text -> Array -> Maybe Value
forall (m :: * -> *).
MonadFail m =>
Text -> Vector Text -> Array -> m Value
getField Text
"qid" Vector Text
columns Array
fields
      String (Format Query (Text -> Query) -> Text -> Query
forall r. Format Query r -> r
F.formatQuery Format Query (Text -> Query)
forall r. Format r (Text -> r)
F.text -> Query
showQueryText) <-
        Text -> Vector Text -> Array -> Maybe Value
forall (m :: * -> *).
MonadFail m =>
Text -> Vector Text -> Array -> m Value
getField Text
"query" Vector Text
columns Array
fields
      String (Format Database (Text -> Database) -> Text -> Database
forall r. Format Database r -> r
F.formatDatabase Format Database (Text -> Database)
forall r. Format r (Text -> r)
F.text -> Database
showQueryDatabase) <-
        Text -> Vector Text -> Array -> Maybe Value
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) <-
        Text -> Vector Text -> Array -> Maybe Value
forall (m :: * -> *).
MonadFail m =>
Text -> Vector Text -> Array -> m Value
getField Text
"duration" Vector Text
columns Array
fields
      ShowQuery -> Maybe ShowQuery
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return ShowQuery {Int
NominalDiffTime
Query
Database
showQueryQid :: Int
showQueryText :: Query
showQueryDatabase :: Database
showQueryDuration :: NominalDiffTime
showQueryQid :: Int
showQueryText :: Query
showQueryDatabase :: Database
showQueryDuration :: NominalDiffTime
..}

parseDuration :: Text -> Either String NominalDiffTime
parseDuration :: Text -> Either [Char] NominalDiffTime
parseDuration = Parser NominalDiffTime -> Text -> Either [Char] NominalDiffTime
forall a. Parser a -> Text -> Either [Char] a
AT.parseOnly Parser NominalDiffTime
duration
  where
    duration :: Parser NominalDiffTime
duration = NominalDiffTime -> NominalDiffTime -> NominalDiffTime
forall a. Num a => a -> a -> a
(*)
      (NominalDiffTime -> NominalDiffTime -> NominalDiffTime)
-> Parser NominalDiffTime
-> Parser Text (NominalDiffTime -> NominalDiffTime)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Int -> NominalDiffTime)
-> Parser Text Int -> Parser NominalDiffTime
forall a b. (a -> b) -> Parser Text a -> Parser Text 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) Parser Text Int
forall a. Integral a => Parser a
AT.decimal
      Parser Text (NominalDiffTime -> NominalDiffTime)
-> Parser NominalDiffTime -> Parser NominalDiffTime
forall a b. Parser Text (a -> b) -> Parser Text a -> Parser Text b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser NominalDiffTime
unit
    unit :: Parser NominalDiffTime
unit = [Parser NominalDiffTime] -> Parser NominalDiffTime
forall (f :: * -> *) a. Alternative f => [f a] -> f a
AC.choice
      [ NominalDiffTime
10NominalDiffTime -> Int -> NominalDiffTime
forall a b. (Fractional a, Integral b) => a -> b -> a
^^(-Int
6 :: Int) NominalDiffTime -> Parser Text Text -> Parser NominalDiffTime
forall a b. a -> Parser Text b -> Parser Text a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Text -> Parser Text Text
AT.string Text
"µs"
      , NominalDiffTime
1 NominalDiffTime -> Parser Text Char -> Parser NominalDiffTime
forall a b. a -> Parser Text b -> Parser Text a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Char -> Parser Text Char
AT.char Char
's'
      , NominalDiffTime
60 NominalDiffTime -> Parser Text Char -> Parser NominalDiffTime
forall a b. a -> Parser Text b -> Parser Text a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Char -> Parser Text Char
AT.char Char
'm'
      , NominalDiffTime
3600 NominalDiffTime -> Parser Text Char -> Parser NominalDiffTime
forall a b. a -> Parser Text b -> Parser Text a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Char -> Parser Text 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 <- Text -> Vector Text -> Array -> Parser Value
forall (m :: * -> *).
MonadFail m =>
Text -> Vector Text -> Array -> m Value
getField Text
"key" Vector Text
columns Array
fields Parser Value -> (Value -> Parser Text) -> Parser Text
forall a b. Parser a -> (a -> Parser b) -> Parser b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Value -> Parser Text
forall a. FromJSON a => Value -> Parser a
parseJSON
    ShowSeries -> Parser ShowSeries
forall a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return (ShowSeries -> Parser ShowSeries)
-> ShowSeries -> Parser ShowSeries
forall a b. (a -> b) -> a -> b
$ Key -> ShowSeries
ShowSeries (Key -> ShowSeries) -> Key -> ShowSeries
forall a b. (a -> b) -> a -> b
$ Format Key (Text -> Key) -> Text -> Key
forall r. Format Key r -> r
F.formatKey Format Key (Text -> Key)
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 = (Database -> f Database) -> ShowQuery -> f ShowQuery
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