{-# 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 (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)
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 String Value
forall a. FromJSON a => ByteString -> Either String a
eitherDecode' ByteString
body of
    Left String
message ->
      InfluxException -> IO ()
forall e a. Exception e => e -> IO a
throwIO (InfluxException -> IO ()) -> InfluxException -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> Request -> ByteString -> InfluxException
UnexpectedResponse String
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)
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 (m :: * -> *) a. Monad m => a -> m a
return ()
        A.Error String
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
$ String -> InfluxException
ServerError String
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
$ String -> Request -> InfluxException
ClientError String
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
$ String -> Request -> ByteString -> InfluxException
UnexpectedResponse
            (String
"BUG: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
message String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" in Database.InfluxDB.Manage.manage")
            Request
request
            (Value -> ByteString
forall a. ToJSON a => a -> ByteString
encode Value
val)
  where
    request :: Request
request = [(ByteString, Maybe ByteString)] -> Request -> Request
HC.setQueryString [(ByteString, Maybe ByteString)]
qs (Request -> Request) -> Request -> Request
forall a b. (a -> b) -> a -> b
$ QueryParams -> Request
manageRequest QueryParams
params
    qs :: [(ByteString, Maybe ByteString)]
qs =
      [ (ByteString
"q", ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just (ByteString -> Maybe ByteString) -> ByteString -> Maybe ByteString
forall a b. (a -> b) -> a -> b
$ Query -> ByteString
F.fromQuery Query
q)
      ]

manageRequest :: QueryParams -> HC.Request
manageRequest :: QueryParams -> Request
manageRequest QueryParams
params = Request
HC.defaultRequest
  { host :: ByteString
HC.host = Text -> ByteString
TE.encodeUtf8 Text
_host
  , port :: Int
HC.port = Int -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
_port
  , secure :: Bool
HC.secure = Bool
_ssl
  , method :: ByteString
HC.method = ByteString
"POST"
  , path :: ByteString
HC.path = ByteString
"/query"
  }
  where
    Server {Bool
Int
Text
_ssl :: Server -> Bool
_port :: Server -> Int
_host :: Server -> Text
_ssl :: Bool
_port :: Int
_host :: Text
..} = 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
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 (String -> Parser ShowQuery
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"parseResults: parse error") ShowQuery -> Parser ShowQuery
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 String 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 (m :: * -> *) a. Monad m => a -> m a
return ShowQuery :: Int -> Query -> Database -> NominalDiffTime -> ShowQuery
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 String NominalDiffTime
parseDuration = Parser NominalDiffTime -> Text -> Either String NominalDiffTime
forall a. Parser a -> Text -> Either String 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 (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall b. (Integral Int, Num b) => Int -> b
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 (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 (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 (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 (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 (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 (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 (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 :: (Database -> f Database) -> ShowQuery -> f ShowQuery
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