{-# 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 params q = do
  manager' <- either HC.newManager return $ params^.manager
  response <- HC.httpLbs request manager' `catch` (throwIO . HTTPException)
  let body = HC.responseBody response
  case eitherDecode' body of
    Left message ->
      throwIO $ UnexpectedResponse message request body
    Right val -> do
      let parser = parseQueryResultsWith
            (params ^. decoder)
            (params ^. precision)
      case A.parse parser val of
        A.Success (_ :: V.Vector Empty) -> return ()
        A.Error message -> do
          let status = HC.responseStatus response
          when (HT.statusIsServerError status) $
            throwIO $ ServerError message
          when (HT.statusIsClientError status) $
            throwIO $ ClientError message request
          throwIO $ UnexpectedResponse
            ("BUG: " ++ message ++ " in Database.InfluxDB.Manage.manage")
            request
            (encode val)
  where
    request = HC.setQueryString qs $ manageRequest params
    qs =
      [ ("q", Just $ F.fromQuery q)
      ]

manageRequest :: QueryParams -> HC.Request
manageRequest params = HC.defaultRequest
  { HC.host = TE.encodeUtf8 _host
  , HC.port = fromIntegral _port
  , HC.secure = _ssl
  , HC.method = "POST"
  , HC.path = "/query"
  }
  where
    Server {..} = params^.server

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

instance QueryResults ShowQuery where
  parseMeasurement _ _ _ columns fields =
    maybe (fail "parseResults: parse error") return $ do
      Number (toBoundedInteger -> Just showQueryQid) <-
        getField "qid" columns fields
      String (F.formatQuery F.text -> showQueryText) <-
        getField "query" columns fields
      String (F.formatDatabase F.text -> showQueryDatabase) <-
        getField "database" columns fields
      String (parseDuration -> Right showQueryDuration) <-
        getField "duration" columns fields
      return ShowQuery {..}

parseDuration :: Text -> Either String NominalDiffTime
parseDuration = AT.parseOnly duration
  where
    duration = (*)
      <$> fmap (fromIntegral @Int) AT.decimal
      <*> unit
    unit = AC.choice
      [ 10^^(-6 :: Int) <$ AT.string "µs"
      , 1 <$ AT.char 's'
      , 60 <$ AT.char 'm'
      , 3600 <$ AT.char 'h'
      ]

newtype ShowSeries = ShowSeries
  { _key :: Key
  }

instance QueryResults ShowSeries where
  parseMeasurement _ _ _ columns fields = do
    name <- getField "key" columns fields >>= parseJSON
    return $ ShowSeries $ F.formatKey F.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

-- | 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