influxdb 1.1.2.2 → 1.2.0

raw patch · 13 files changed

+701/−289 lines, 13 filesdep −data-default-classdep ~http-clientPVP ok

version bump matches the API change (PVP)

Dependencies removed: data-default-class

Dependency ranges changed: http-client

API changes (from Hackage documentation)

Files

• CHANGELOG.md +19/−0
• examples/random-points.hs +2/−2
• influxdb.cabal +7/−15
• src/Database/InfluxDB.hs +107/−6
• src/Database/InfluxDB/Format.hs +111/−10
• src/Database/InfluxDB/JSON.hs +38/−24
• src/Database/InfluxDB/Line.hs +4/−6
• src/Database/InfluxDB/Manage.hs +76/−38
• src/Database/InfluxDB/Ping.hs +89/−49
• src/Database/InfluxDB/Query.hs +75/−54
• src/Database/InfluxDB/Types.hs +83/−17
• src/Database/InfluxDB/Write.hs +90/−52
• src/Network/HTTP/Client/Compat.hs +0/−16

@@ -1,3 +1,22 @@+## v1.2.0 - 2017-06-19++There are a lot of breaking changes in this release. The API has been cleaned up+and a lot of Haddock comments are added extensively.++* The `FieldVal` has been renamed to `Field` which takes `Nullability` as a type parameter.+* `localServer` has been renamed to `defaultServer`+* Some constructors in `InfluxException` have been renamed+    * `BadRequest` to `ClientError`+    * `IllformedJSON` to `UnexpectedResponse`+* Added a smart constructor `credentials` for `Credentials`+* Dropped `parseTimestamp` and added `parseUTCTime`+* `ping` handles timeout proerply and throws `InfluxException` on failure+* `PingResult` has been renamed to `Pong` and is now an abstract data type.+* `PingParams` has been turned into an abstract data type.+* `waitForLeader` has been renamed to `timeout`.+* `parsekey` has been removed. `getField` and `parseQueryField` can be used instead.+* Drop support for `http-client < 0.5`+ ## v1.1.2.2 - 2017-05-31  * Relax upper version bound for foldl

@@ -77,7 +77,7 @@  instance QueryResults Row where   parseResults prec = parseResultsWith $ \_ _ columns fields -> do-    rowTime <- getField "time" columns fields >>= parseTimestamp prec+    rowTime <- getField "time" columns fields >>= parsePOSIXTime prec     String name <- getField "value" columns fields     rowValue <- case name of       "foo" -> return Foo@@ -96,7 +96,7 @@   | Qux   deriving (Enum, Bounded, Show) -nameToFVal :: Name -> FieldValue+nameToFVal :: Name -> LineField nameToFVal = FieldString . T.toLower . T.pack . show  instance Variate Name where

@@ -1,7 +1,10 @@ name: influxdb-version: 1.1.2.2+version: 1.2.0 synopsis: Haskell client library for InfluxDB-description: Haskell client library for InfluxDB+description:+  @influxdb@ is a Haskell client library for InfluxDB.+  .+  Read "Database.InfluxDB" for a quick start guide. homepage: https://github.com/maoe/influxdb-haskell license: BSD3 license-file: LICENSE@@ -22,10 +25,6 @@   default: False   manual: True -flag http-client-05-  default: True-  manual: False- library   exposed-modules:     Database.InfluxDB@@ -38,8 +37,6 @@     Database.InfluxDB.Types     Database.InfluxDB.Write     Database.InfluxDB.Write.UDP-  other-modules:-    Network.HTTP.Client.Compat   other-extensions:     BangPatterns     CPP@@ -70,6 +67,7 @@     , clock >= 0.7 && < 0.8     , containers >= 0.5 && < 0.6     , foldl < 1.4+    , http-client >= 0.5 && < 0.6     , http-types >= 0.8.6 && < 0.10     , lens >= 4.9 && < 4.16     , network >= 2.6 && < 2.7@@ -79,12 +77,6 @@     , time >= 1.5 && < 1.9     , unordered-containers < 0.3     , vector >= 0.10 && < 0.13-  if flag(http-client-05)-    build-depends: http-client >= 0.5 && < 0.6-  else-    build-depends:-        data-default-class-      , http-client >= 0.4.10 && < 0.5   hs-source-dirs: src   default-language: Haskell2010 @@ -150,5 +142,5 @@  source-repository this   type: git-  tag: v1.1.2.2+  tag: v1.2.0   location: https://github.com/maoe/influxdb-haskell.git

@@ -23,17 +23,21 @@   , fieldSet   , timestamp -  , FieldValue(..)+  , Field(..)+  , LineField+  , QueryField   , Timestamp(..)   , precisionScale   , precisionName    -- * Querying data+  -- $query   , Query   , query   , queryChunked -  -- * Query constructor+  -- ** Query construction+  -- $query-construction   , formatQuery   , (%) @@ -43,13 +47,14 @@   , authentication    -- ** Parsing results+  -- $parsing-results   , QueryResults(..)   , parseResultsWith   , getField   , getTag-  , parseTimestamp-  , parseFieldValue-  , parseKey+  , parseUTCTime+  , parsePOSIXTime+  , parseQueryField    -- * Database management   , manage@@ -63,9 +68,10 @@   , host   , port   , ssl-  , localServer+  , defaultServer    , Credentials+  , credentials   , user   , password @@ -86,6 +92,85 @@ import Database.InfluxDB.Types import Database.InfluxDB.Write +{- $intro+= Getting started++This tutorial assumes the following language extensions and imports.++>>> :set -XOverloadedStrings+>>> :set -XRecordWildCards+>>> import Database.InfluxDB+>>> import qualified Database.InfluxDB.Format as F+>>> import Control.Lens+>>> import qualified Data.Map as Map+>>> import Data.Time+>>> import qualified Data.Vector as V++The examples below roughly follows the+ [README](https://github.com/influxdata/influxdb/blob/0b4528b26de43d5504ec0623c184540f7c3e1a54/client/README.md)+in the official Go client library.++== Creating a database++This library assumes the [lens](https://hackage.haskell.org/package/lens)+package in some APIs. Here we use 'Control.Lens.?~' to set the authentication+parameters of type @Maybe 'Credentials'@.++Also note that in order to construct a 'Query', we use 'formatQuery' with the+'F.database' formatter. There are many other formatter defined in+"Database.InfluxDB.Format".++>>> let db = "square_holes"+>>> let bubba = credentials "bubba" "bumblebeetuna"+>>> let p = queryParams db & authentication ?~ bubba+>>> manage p $ formatQuery ("CREATE DATABASE "%F.database) db++== Writing data++'write' or 'writeBatch' can be used to write data. In general 'writeBatch'+should be used for efficiency when writing multiple data points.++>>> let wp = writeParams db & authentication ?~ bubba & precision .~ Second+>>> let cpuUsage = "cpu_usage"+>>> :{+writeBatch wp+  [ Line cpuUsage (Map.singleton "cpu" "cpu-total")+    (Map.fromList+      [ ("idle",   FieldFloat 10.1)+      , ("system", FieldFloat 53.3)+      , ("user",   FieldFloat 46.6)+      ])+    (Nothing :: Maybe UTCTime)+  ]++Note that the type signature of the timestamp is necessary. Otherwise it doesn't+type check.++== Querying data++First we define a placeholder data type called 'CPUUsage' and a 'QueryResults'+instance. 'getField', 'parseUTCTime' and 'parseQueryField' etc are avilable to+make JSON decoding easier.++>>> :{+data CPUUsage = CPUUsage+  { time :: UTCTime+  , cpuIdle, cpuSystem, cpuUser :: Double+  } deriving Show+instance QueryResults CPUUsage where+  parseResults prec = parseResultsWithDecoder strictDecoder $ \_ _ columns fields -> do+    time <- getField "time" columns fields >>= parseUTCTime prec+    FieldFloat cpuIdle <- getField "idle" columns fields >>= parseQueryField+    FieldFloat cpuSystem <- getField "system" columns fields >>= parseQueryField+    FieldFloat cpuUser <- getField "user" columns fields >>= parseQueryField+    return CPUUsage {..}+:}+>>> query p $ formatQuery ("SELECT * FROM "%F.key) cpuUsage :: IO (V.Vector CPUUsage)+[CPUUsage {time = 2017-06-17 15:41:40.52659044 UTC, cpuIdle = 10.1, cpuSystem = 53.3, cpuUser = 46.6}]++Note that the type signature on query here is also necessary to type check.+-}+ {- $write InfluxDB has two ways to write data into it, via HTTP and UDP. This module only exports functions for the HTTP API. For UDP, you can use a qualified@@ -93,5 +178,21 @@  @ import qualified "Database.InfluxDB.Write.UDP" as UDP+@+-}++{- $query+'query' and 'queryChunked' can be used to query data. If your dataset fits your+memory, 'query' is easier to use. If it doesn't, use 'queryChunked' to stream+data.+-}++{- $query-construction+There are various utility functions available in "Database.InfluxDB.Format".+This module is designed to be imported as qualified:++@+import "Database.InfluxDB"+import qualified "Database.InfluxDB.Format" as F @ -}

@@ -1,28 +1,31 @@ {-# LANGUAGE GADTs #-}-{-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE OverloadedStrings #-} module Database.InfluxDB.Format-  ( Query-  , fromQuery--  , Format+  ( -- * The 'Format' type and associated functions+    Format   , makeFormat   , (%)++  -- * Formatting functions   , formatQuery   , formatDatabase   , formatKey +  -- * Formatters for various types   , database   , key   , keys-  , fieldVal+  , field   , decimal   , realFloat   , text   , string   , byteString8   , time++  -- * Utility functions+  , fromQuery   ) where import Control.Category import Data.Monoid@@ -43,12 +46,35 @@  import Database.InfluxDB.Types hiding (database) +-- $setup+-- >>> :set -XOverloadedStrings++-- | Serialize a 'Query' to a 'B.ByteString'. fromQuery :: Query -> B.ByteString fromQuery (Query q) =   BL.toStrict $ BL.toLazyByteString $ T.encodeUtf8Builder q -newtype Format a b = Format { runFormat :: (TL.Builder -> a) -> b }+-- | A typed format string. @Format a r@ means that @a@ is the type of formatted+-- string, and @r@ is the type of the formatter.+--+-- >>> :t formatQuery+-- formatQuery :: Format Query r -> r+-- >>> :t key+-- key :: Format r (Key -> r)+-- >>> :t "SELECT * FROM "%key+-- "SELECT * FROM "%key :: Format a (Key -> a)+-- >>> :t formatQuery ("SELECT * FROM "%key)+-- formatQuery ("SELECT * FROM "%key) :: Key -> Query+-- >>> formatQuery ("SELECT * FROM "%key) "series"+-- "SELECT * FROM \"series\""+newtype Format a r = Format { runFormat :: (TL.Builder -> a) -> r } +-- | 'Format's can be composed using @('.')@ from "Control.Category".+--+-- >>> import Control.Category ((.))+-- >>> import Prelude hiding ((.))+-- >>> formatQuery ("SELECT * FROM " . key) "series"+-- "SELECT * FROM \"series\"" instance Category Format where   id = Format (\k -> k "")   fmt1 . fmt2 = Format $ \k ->@@ -56,59 +82,134 @@       runFormat fmt2 $ \b ->         k (a <> b) -instance a ~ b => IsString (Format a b) where+-- | With the OverloadedStrings exension, string literals can be used to write+-- queries.+--+-- >>> "SELECT * FROM series" :: Query+-- "SELECT * FROM series"+instance a ~ r => IsString (Format a r) where   fromString xs = Format $ \k -> k $ fromString xs +-- | 'Format' specific synonym of @('.')@.+--+-- This is typically easier to use than @('.')@ is because it doesn't+-- conflict with @Prelude.(.)@. (%) :: Format b c -> Format a b -> Format a c (%) = (.) +-- | Format a 'Query'.+--+-- >>> formatQuery "SELECT * FROM series"+-- "SELECT * FROM series"+-- >>> formatQuery ("SELECT * FROM "%key) "series"+-- "SELECT * FROM \"series\"" formatQuery :: Format Query r -> r formatQuery fmt = runFormat fmt (Query . TL.toStrict . TL.toLazyText) +-- | Format a 'Database'.+--+-- >>> formatDatabase "test-db"+-- "test-db" formatDatabase :: Format Database r -> r formatDatabase fmt = runFormat fmt (Database . TL.toStrict . TL.toLazyText) +-- | Format a 'Key'.+--+-- >>> formatKey "test-key"+-- "test-key" formatKey :: Format Key r -> r formatKey fmt = runFormat fmt (Key . TL.toStrict . TL.toLazyText) +-- | Convenience function to make a custom formatter. makeFormat :: (a -> TL.Builder) -> Format r (a -> r) makeFormat build = Format $ \k a -> k $ build a +-- | Format a database name.+--+-- >>> formatQuery ("CREATE DATABASE "%database) "test-db"+-- "CREATE DATABASE \"test-db\"" database :: Format r (Database -> r) database = makeFormat $ \(Database name) -> "\"" <> TL.fromText name <> "\""  keyBuilder :: Key -> TL.Builder keyBuilder (Key name) = "\"" <> TL.fromText name <> "\"" +-- | Format a key (e.g. series names, field names etc).+--+-- >>> formatQuery ("SELECT * FROM "%key) "test-series"+-- "SELECT * FROM \"test-series\"" key :: Format r (Key -> r) key = makeFormat keyBuilder +-- | Format multiple keys.+--+-- >>> formatQuery ("SELECT "%keys%" FROM series") ["field1", "field2"]+-- "SELECT \"field1\",\"field2\" FROM series" keys :: Format r ([Key] -> r) keys = makeFormat $ mconcat . L.intersperse "," . map keyBuilder -fieldVal :: Format r (FieldValue -> r)-fieldVal = makeFormat $ \case+-- | Format 'QueryField'.+--+-- >>> formatQuery ("SELECT * FROM series WHERE "%key%" = "%field) "location" "tokyo"+-- "SELECT * FROM series WHERE \"location\" = 'tokyo'"+field :: Format r (QueryField -> r)+field = makeFormat $ \case   FieldInt n -> TL.decimal n   FieldFloat d -> TL.realFloat d   FieldString s -> "'" <> TL.fromText s <> "'"   FieldBool b -> if b then "true" else "false"   FieldNull -> "null" +-- | Format a decimal number.+--+-- >>> formatQuery ("SELECT * FROM series WHERE time < now() - "%decimal%"h") 1+-- "SELECT * FROM series WHERE time < now() - 1h" decimal :: Integral a => Format r (a -> r) decimal = makeFormat TL.decimal +-- | Format a floating-point number.+--+-- >>> formatQuery ("SELECT * FROM series WHERE value > "%realFloat) 0.1+-- "SELECT * FROM series WHERE value > 0.1" realFloat :: RealFloat a => Format r (a -> r) realFloat = makeFormat TL.realFloat +-- | Format a text.+--+-- Note that this doesn't escape the string. Use 'fieldKey' to format field+-- values in a query.+--+-- >>> :t formatKey text+-- formatKey text :: T.Text -> Key text :: Format r (T.Text -> r) text = makeFormat TL.fromText +-- | Format a string.+--+-- Note that this doesn't escape the string. Use 'fieldKey' to format field+-- values in a query.+--+-- >>> :t formatKey string+-- formatKey string :: String -> Key string :: Format r (String -> r) string = makeFormat TL.fromString +-- | Format a UTF-8 encoded byte string.+--+-- Note that this doesn't escape the string. Use 'fieldKey' to format field+-- values in a query.+--+-- >>> :t formatKey byteString8+-- formatKey byteString8 :: B.ByteString -> Key byteString8 :: Format r (B.ByteString -> r) byteString8 = makeFormat $ TL.fromText . T.decodeUtf8 +-- | Format a time.+--+-- >>> import Data.Time+-- >>> let Just t = parseTimeM False defaultTimeLocale "%s" "0" :: Maybe UTCTime+-- >>> formatQuery ("SELECT * FROM series WHERE time >= "%time) t+-- "SELECT * FROM series WHERE time >= '1970-01-01 00:00:00'" time :: FormatTime time => Format r (time -> r) time = makeFormat $ \t ->   "'" <> TL.fromString (formatTime defaultTimeLocale fmt t) <> "'"

@@ -2,26 +2,29 @@ {-# LANGUAGE ExistentialQuantification #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE GADTs #-}-{-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RecordWildCards #-}-{-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE ViewPatterns #-} module Database.InfluxDB.JSON-  ( parseResultsWith+  ( -- * Result parsers+    parseResultsWith   , parseResultsWithDecoder++  -- ** Decoder settings   , Decoder(..)   , strictDecoder   , lenientDecoder +  -- * Getting fields and tags   , getField   , getTag -  , parseTimestamp+  -- * Common JSON object parsers+  , parseUTCTime   , parsePOSIXTime   , parseRFC3339-  , parseFieldValue-+  , parseQueryField+  -- ** Utility functions   , parseResultsObject   , parseSeriesObject   , parseSeriesBody@@ -35,6 +38,7 @@ import Data.Aeson import Data.HashMap.Strict (HashMap) import Data.Text (Text)+import Data.Time.Clock import Data.Time.Clock.POSIX import Data.Time.Format import Data.Vector (Vector)@@ -46,7 +50,8 @@  import Database.InfluxDB.Types --- | Parse a JSON response+-- | A helper function to parse a JSON response in+-- 'Database.InfluxDB.Query.parseResults'. parseResultsWith   :: (Maybe Text -> HashMap Text Text -> Vector Text -> Array -> A.Parser a)   -- ^ A parser that takes@@ -116,10 +121,11 @@  -- | Get a field value from a column name getField-  :: Text -- ^ Column name+  :: Monad m+  => Text -- ^ Column name   -> Vector Text -- ^ Columns-  -> Array -- ^ Fields-  -> A.Parser Value+  -> Vector Value -- ^ Field values+  -> m Value getField column columns fields =   case V.elemIndex column columns of     Nothing -> fail $ "getField: no such column " ++ show column@@ -131,19 +137,22 @@ getTag   :: Monad m   => Text -- ^ Tag name-  -> HashMap Text Text -- ^ Tags-  -> m Text+  -> HashMap Text Value -- ^ Tags+  -> m Value getTag tag tags = case HashMap.lookup tag tags of   Nothing -> fail $ "getTag: no such tag " ++ show tag   Just val -> return val +-- | Parse a result response. parseResultsObject :: Value -> A.Parser (Vector A.Value) parseResultsObject = A.withObject "results" $ \obj -> obj .: "results" +-- | Parse a series response. parseSeriesObject :: Value -> A.Parser (Vector A.Value) parseSeriesObject = A.withObject "series" $ \obj ->   fromMaybe V.empty <$> obj .:? "series" +-- | Parse the common JSON structure used in query responses. parseSeriesBody   :: Value   -> A.Parser (Maybe Text, HashMap Text Text, Vector Text, Array)@@ -154,21 +163,23 @@   !tags <- obj .:? "tags" .!= HashMap.empty   return (name, tags, columns, values) +-- | Parse the common JSON structure used in failure response. parseErrorObject :: A.Value -> A.Parser a parseErrorObject = A.withObject "error" $ \obj -> do   message <- obj .: "error"   fail $ T.unpack message --- | Parse either a POSIX timestamp or RFC3339 formatted timestamp.-parseTimestamp :: Precision ty -> A.Value -> A.Parser POSIXTime-parseTimestamp prec val = case prec of-  RFC3339 -> utcTimeToPOSIXSeconds <$!> parseRFC3339 val-  _ -> parsePOSIXTime prec val+-- | Parse either a POSIX timestamp or RFC3339 formatted timestamp as 'UTCTime'.+parseUTCTime :: Precision ty -> A.Value -> A.Parser UTCTime+parseUTCTime prec val = case prec of+  RFC3339 -> parseRFC3339 val+  _ -> posixSecondsToUTCTime <$!> parsePOSIXTime prec val --- | Parse an integer POSIX timestamp in given time precision.+-- | Parse either a POSIX timestamp or RFC3339 formatted timestamp as+-- 'POSIXTime'. parsePOSIXTime :: Precision ty -> A.Value -> A.Parser POSIXTime parsePOSIXTime prec val = case prec of-  RFC3339 -> A.typeMismatch err val+  RFC3339 -> utcTimeToPOSIXSeconds <$!> parseRFC3339 val   _ -> A.withScientific err     (\s -> case timestampToUTC s of       Nothing -> A.typeMismatch err val@@ -186,16 +197,18 @@ -- before parsing. parseRFC3339 :: ParseTime time => A.Value -> A.Parser time parseRFC3339 val = A.withText err-  (\text -> maybe (A.typeMismatch err val) (return $!) $-    parseTimeM True defaultTimeLocale fmt $ T.unpack text)+  (maybe (A.typeMismatch err val) (return $!)+    . parseTimeM True defaultTimeLocale fmt+    . T.unpack)   val   where     fmt, err :: String     fmt = "%FT%X%QZ"     err = "RFC3339-formatted timestamp" -parseFieldValue :: A.Value -> A.Parser FieldValue-parseFieldValue val = case val of+-- | Parse a 'QueryField'.+parseQueryField :: A.Value -> A.Parser QueryField+parseQueryField val = case val of   A.Number sci ->     return $! either FieldFloat FieldInt $ Sci.floatingOrInteger sci   A.String txt ->@@ -204,4 +217,5 @@     return $! FieldBool b   A.Null ->     return FieldNull-  _ -> fail "parseFieldValue: expected a flat data structure"+  _ -> fail $ "parseQueryField: expected a flat data structure, but got "+    ++ show val

@@ -1,4 +1,3 @@-{-# LANGUAGE DataKinds #-} {-# LANGUAGE KindSignatures #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE OverloadedStrings #-}@@ -34,14 +33,14 @@  -- | Placeholder for the Line Protocol ----- See https://docs.influxdata.com/influxdb/v1.0/write_protocols/line_protocol_tutorial/ for the+-- See https://docs.influxdata.com/influxdb/v1.2/write_protocols/line_protocol_tutorial/ for the -- concrete syntax. data Line time = Line   { _measurement :: !Key   -- ^ Measurement name   , _tagSet :: !(Map Key Text)   -- ^ Set of tags (optional)-  , _fieldSet :: !(Map Key FieldValue)+  , _fieldSet :: !(Map Key LineField)   -- ^ Set of fields   --   -- It shouldn't be empty.@@ -91,13 +90,12 @@ escapeKey :: Key -> Text escapeKey (Key text) = T.replace " " "\\ " $ T.replace "," "\\," text -buildFieldValue :: FieldValue -> B.Builder+buildFieldValue :: LineField -> B.Builder buildFieldValue = \case   FieldInt i -> B.int64Dec i <> "i"   FieldFloat d -> B.doubleDec d   FieldString t -> "\"" <> TE.encodeUtf8Builder t <> "\""   FieldBool b -> if b then "true" else "false"-  FieldNull -> "null"  buildLines   :: Foldable f@@ -117,7 +115,7 @@  -- | Field(s) for your data point. Every data point requires at least one field -- in the Line Protocol, so it shouldn't be 'empty'.-fieldSet :: Lens' (Line time) (Map Key FieldValue)+fieldSet :: Lens' (Line time) (Map Key LineField)  -- | Timestamp for your data point. You can put whatever type of timestamp that -- is an instance of the 'Timestamp' class.

@@ -1,17 +1,35 @@+{-# LANGUAGE CPP #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TemplateHaskell #-} {-# 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-  ( manage+  ( -- * Management query interface+    Query+  , manage +  -- * Query parameters+  , QueryParams+  , queryParams+  , server+  , database+  , precision+  , manager++  -- * Management query results+  -- ** SHOW QUERIES   , ShowQuery   , qid   , queryText-  , Types.database   , duration +  -- ** SHOW SERIES   , ShowSeries   , key   ) where@@ -30,22 +48,32 @@ 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, parseQueryField) import Database.InfluxDB.Types as Types import Database.InfluxDB.Query hiding (query) import qualified Database.InfluxDB.Format as F-import qualified Network.HTTP.Client.Compat as HC +-- $setup+-- >>> :set -XOverloadedStrings+-- >>> import Database.InfluxDB.Query+-- >>> import Database.InfluxDB.Format ((%))+ -- | 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'+  response <- HC.httpLbs request manager' `catch` (throwIO . HTTPException)   let body = HC.responseBody response   case eitherDecode' body of-    Left message -> do-      throwIO $ IllformedJSON message body+    Left message ->+      throwIO $ UnexpectedResponse message body     Right val -> case A.parse (parseResults (params^.precision)) val of       A.Success (_ :: V.Vector Void) -> return ()       A.Error message -> do@@ -53,7 +81,7 @@         when (HT.statusIsServerError status) $           throwIO $ ServerError message         when (HT.statusIsClientError status) $-          throwIO $ BadRequest message request+          throwIO $ ClientError message request         fail $ "BUG: " ++ message ++ " in Database.InfluxDB.Manage.manage"   where     request = HC.setQueryString qs $ manageRequest params@@ -72,23 +100,25 @@   where     Server {..} = params^.server +-- |+-- >>> v <- query (queryParams "_internal") "SHOW QUERIES" :: IO (V.Vector ShowQuery) data ShowQuery = ShowQuery-  { _qid :: !Int-  , _queryText :: !Query-  , _database :: !Database-  , _duration :: !NominalDiffTime-  } deriving Show+  { showQueryQid :: !Int+  , showQueryText :: !Query+  , showQueryDatabase :: !Database+  , showQueryDuration :: !NominalDiffTime+  }  instance QueryResults ShowQuery where   parseResults _ = parseResultsWith $ \_ _ columns fields ->     maybe (fail "parseResults: parse error") return $ do-      Number (toBoundedInteger -> Just _qid) <-+      Number (toBoundedInteger -> Just showQueryQid) <-         V.elemIndex "qid" columns >>= V.indexM fields-      String (F.formatQuery F.text -> _queryText) <-+      String (F.formatQuery F.text -> showQueryText) <-         V.elemIndex "query" columns >>= V.indexM fields-      String (F.formatDatabase F.text -> _database) <-+      String (F.formatDatabase F.text -> showQueryDatabase) <-         V.elemIndex "database" columns >>= V.indexM fields-      String (parseDuration -> Right _duration) <-+      String (parseDuration -> Right showQueryDuration) <-         V.elemIndex "duration" columns >>= V.indexM fields       return ShowQuery {..} @@ -110,49 +140,57 @@  newtype ShowSeries = ShowSeries   { _key :: Key-  } deriving Show+  }  instance QueryResults ShowSeries where-  parseResults _ = parseResultsWith $ \_ _ columns fields ->-    ShowSeries <$> parseKey "key" columns fields+  parseResults _ = parseResultsWith $ \_ _ columns fields -> do+    FieldString name <- getField "key" columns fields >>= parseQueryField+    return $ ShowSeries $ F.formatKey F.text name -makeLensesWith (lensRules & generateSignatures .~ False) ''ShowQuery+makeLensesWith+  ( lensRules+    & generateSignatures .~ False+    & lensField .~ lookingupNamer+      [ ("showQueryQid", "qid")+      , ("showQueryText", "queryText")+      , ("showQueryDatabase", "_database")+      , ("showQueryDuration", "duration")+      ]+  ) ''ShowQuery  -- | Query ID ----- >>> v <- query (queryParams "_internal") "SHOW QUERIES" :: IO (V.Vector ShowQuery)--- >>> v ^.. each.qid--- [149250]+-- >> v <- query (queryParams "_internal") "SHOW QUERIES" :: IO (V.Vector ShowQuery)+-- >> v ^.. each.qid+-- >[149250] qid :: Lens' ShowQuery Int  -- | Query text ----- >>> v <- query (queryParams "_internal") "SHOW QUERIES" :: IO (V.Vector ShowQuery)--- >>> v ^.. each.queryText--- ["SHOW QUERIES"]+-- >> v <- query (queryParams "_internal") "SHOW QUERIES" :: IO (V.Vector ShowQuery)+-- >> v ^.. each.queryText+-- >["SHOW QUERIES"] queryText :: Lens' ShowQuery Query -database :: Lens' ShowQuery Database- -- |--- >>> v <- query (queryParams "_internal") "SHOW QUERIES" :: IO (V.Vector ShowQuery)--- >>> v ^.. each.database--- ["_internal"]+-- >> v <- query (queryParams "_internal") "SHOW QUERIES" :: IO (V.Vector ShowQuery)+-- >> v ^.. each.database+-- >["_internal"] instance HasDatabase ShowQuery where-  database = Database.InfluxDB.Manage.database+  database = _database  -- | Duration of the query ----- >>> v <- query (queryParams "_internal") "SHOW QUERIES" :: IO (V.Vector ShowQuery)--- >>> v ^.. each.duration--- [0.06062s]+-- >> v <- query (queryParams "_internal") "SHOW QUERIES" :: IO (V.Vector ShowQuery)+-- >> v ^.. each.duration+-- >[0.06062s] duration :: Lens' ShowQuery NominalDiffTime  makeLensesWith (lensRules & generateSignatures .~ False) ''ShowSeries  -- | Series name ----- >>> v <- query (queryParams "_internal") "SHOW SERIES" :: IO (V.Vector ShowSeries)--- >>> length $ v ^.. each.key--- 755+-- >> v <- query (queryParams "_internal") "SHOW SERIES" :: IO (V.Vector ShowSeries)+-- >> length $ v ^.. each.key+-- >755 key :: Lens' ShowSeries Key

@@ -1,66 +1,91 @@+{-# 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 interface     ping    -- * Ping parameters-  , PingParams(..)+  , PingParams   , pingParams-  , Types.server-  , Types.manager-  , waitForLeader+  , server+  , manager+  , timeout -  -- * Ping result-  , PingResult(..)+  -- * 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.Compat as HC-import System.Clock+import qualified Network.HTTP.Client as HC  import Database.InfluxDB.Types as Types - -- Ping requests do not require authentication -- | The full set of parameters for the ping API data PingParams = PingParams-  { _server :: !Server-  , _manager :: !(Either HC.ManagerSettings HC.Manager)+  { pingServer :: !Server+  , pingManager :: !(Either HC.ManagerSettings HC.Manager)   -- ^ HTTP connection manager-  , _waitForLeader :: !(Maybe Int)-  -- ^ the number of seconds to wait+  , pingTimeout :: !(Maybe NominalDiffTime)+  -- ^ Timeout   } -makeLensesWith (lensRules & generateSignatures .~ False) ''PingParams+-- | Smart constructor for 'PingParams'+--+-- Default parameters:+--+--   ['L.server'] 'defaultServer'+--   ['L.manager'] @'Left' 'HC.defaultManagerSettings'@+--   ['L.timeout'] 'Nothing'+pingParams :: PingParams+pingParams = PingParams+  { pingServer = defaultServer+  , pingManager = Left HC.defaultManagerSettings+  , pingTimeout = Nothing+  } -server :: Lens' PingParams Server+makeLensesWith+  ( lensRules+    & generateSignatures .~ False+    & lensField .~ lookingupNamer+      [ ("pingServer", "_server")+      , ("pingManager", "_manager")+      , ("pingTimeout", "timeout")+      ]+    )+  ''PingParams +-- |+-- >>> pingParams ^. server.host+-- "localhost" instance HasServer PingParams where-  server = Database.InfluxDB.Ping.server--manager :: Lens' PingParams (Either HC.ManagerSettings HC.Manager)+  server = _server +-- |+-- >>> let p = pingParams & manager .~ Left HC.defaultManagerSettings instance HasManager PingParams where-  manager = Database.InfluxDB.Ping.manager+  manager = _manager  -- | The number of seconds to wait before returning a response-waitForLeader :: Lens' PingParams (Maybe Int)--pingParams :: PingParams-pingParams =-  PingParams-  { _server = localServer-  , _manager = Left HC.defaultManagerSettings-  , _waitForLeader = Nothing-  }+--+-- >>> pingParams ^. timeout+-- Nothing+-- >>> let p = pingParams & timeout ?~ 1+timeout :: Lens' PingParams (Maybe NominalDiffTime)  pingRequest :: PingParams -> HC.Request pingRequest PingParams {..} = HC.defaultRequest@@ -71,31 +96,46 @@   , HC.path = "/ping"   }   where-    Server {..} = _server+    Server {..} = pingServer -data PingResult = PingResult+-- | Response of a ping request+data Pong = Pong   { _roundtripTime :: !TimeSpec+  -- ^ Round-trip time of the ping   , _influxdbVersion :: !BS.ByteString+  -- ^ Version string returned by InfluxDB   } deriving (Show, Eq, Ord) -makeLensesWith (lensRules & generateSignatures .~ False) ''PingResult+makeLensesWith (lensRules & generateSignatures .~ False) ''Pong --- | Roundtrip time of the ping-roundtripTime :: Lens' PingResult TimeSpec+-- | Round-trip time of the ping+roundtripTime :: Lens' Pong TimeSpec --- | Version string returned by the InfluxDB header-influxdbVersion :: Lens' PingResult BS.ByteString+-- | Version string returned by InfluxDB+influxdbVersion :: Lens' Pong BS.ByteString -ping :: PingParams -> IO PingResult+-- | Send a ping to InfluxDB.+--+-- It may throw an 'InfluxException'.+ping :: PingParams -> IO Pong ping params = do-  manager' <- either HC.newManager return $ _manager params-  startTime <- getTime'-  HC.withResponse request manager' (\response -> do-    endTime <- getTime'-    let headers = HC.responseHeaders response-    case lookup "X-Influxdb-Version" headers of-      Just version -> pure (PingResult (diffTimeSpec endTime startTime) version)-      Nothing -> error "A response by influxdb should always contain a version header.")+  manager' <- either HC.newManager return $ pingManager params+  startTime <- getTimeMonotonic+  HC.withResponse request manager' $ \response -> do+    endTime <- getTimeMonotonic+    case lookup "X-Influxdb-Version" (HC.responseHeaders response) of+      Just version ->+        return $! Pong (diffTimeSpec endTime startTime) version+      Nothing ->+        throwIO $ UnexpectedResponse+          "The X-Influxdb-Version header was missing in the response."+          ""+  `catch` (throwIO . HTTPException)   where-    request = pingRequest params-    getTime' = getTime Monotonic+    request = (pingRequest params)+      { HC.responseTimeout = case pingTimeout params of+        Nothing -> HC.responseTimeoutNone+        Just sec -> HC.responseTimeoutMicro $+          round $ realToFrac sec / (10**(-6) :: Double)+      }+    getTimeMonotonic = getTime Monotonic

@@ -19,27 +19,26 @@   -- * Query parameters   , QueryParams   , queryParams-  , Types.server-  , Types.database-  , Types.precision-  , Types.manager+  , server+  , database+  , precision+  , manager    -- * Parsing results   , QueryResults(..)   , parseResultsWith-  , parseKey    -- * Low-level functions   , withQueryResponse   ) where import Control.Exception import Control.Monad-import Text.Printf+import Data.Char+import Data.List  import Control.Lens import Data.Aeson import Data.Optional (Optional(..), optional)-import Data.Text (Text) import Data.Vector (Vector) import Data.Void import qualified Control.Foldl as L@@ -52,14 +51,42 @@ import qualified Data.Text.Encoding as TE import qualified Data.Text as T import qualified Data.Vector as V+import qualified Network.HTTP.Client as HC import qualified Network.HTTP.Types as HT  import Database.InfluxDB.JSON import Database.InfluxDB.Types as Types import qualified Database.InfluxDB.Format as F-import qualified Network.HTTP.Client.Compat as HC +-- $setup+-- >>> :set -XOverloadedStrings+-- >>> :set -XRecordWildCards+-- >>> import Data.Time (UTCTime)++-- | Types that can be converted from an JSON object returned by InfluxDB.+--+-- For example the @h2o_feet@ series in+-- [the official document](https://docs.influxdata.com/influxdb/v1.2/query_language/data_exploration/)+-- can be encoded as follows:+--+-- >>> :{+-- data H2OFeet = H2OFeet+--   { time :: UTCTime+--   , levelDesc :: T.Text+--   , location :: T.Text+--   , waterLevel :: Double+--   }+-- instance QueryResults H2OFeet where+--   parseResults prec = parseResultsWith $ \_ _ columns fields -> do+--     time <- getField "time" columns fields >>= parseUTCTime prec+--     String levelDesc <- getField "level_description" columns fields+--     String location <- getField "location" columns fields+--     FieldFloat waterLevel <-+--       getField "water_level" columns fields >>= parseQueryField+--     return H2OFeet {..}+-- :} class QueryResults a where+  -- | Parse a JSON object as an array of values of expected type.   parseResults     :: Precision 'QueryRequest     -> Value@@ -149,23 +176,17 @@         h <- fields V.!? 7         return (a, b, c, d, e, f, g, h) -parseKey :: Key -> Vector Text -> Array -> A.Parser Key-parseKey (Key name) columns fields = do-  case V.elemIndex name columns >>= V.indexM fields of-    Just (String (F.formatKey F.text -> key)) -> return key-    _ -> fail $ printf "parseKey: %s not found in columns" $ show name- -- | The full set of parameters for the query API data QueryParams = QueryParams-  { _server :: !Server-  , _database :: !Database-  , _precision :: !(Precision 'QueryRequest)+  { queryServer :: !Server+  , queryDatabase :: !Database+  , queryPrecision :: !(Precision 'QueryRequest)   -- ^ Timestamp precision   --   -- InfluxDB uses nanosecond precision if nothing is specified.-  , _authentication :: !(Maybe Credentials)+  , queryAuthentication :: !(Maybe Credentials)   -- ^ No authentication by default-  , _manager :: !(Either HC.ManagerSettings HC.Manager)+  , queryManager :: !(Either HC.ManagerSettings HC.Manager)   -- ^ HTTP connection manager   } @@ -173,16 +194,16 @@ -- -- Default parameters: -----   ['L.server'] 'localServer'+--   ['L.server'] 'defaultServer' --   ['L.precision'] 'RFC3339'---   ['authentication'] 'Nothing'+--   ['L.authentication'] 'Nothing' --   ['L.manager'] @'Left' 'HC.defaultManagerSettings'@ queryParams :: Database -> QueryParams-queryParams _database = QueryParams-  { _server = localServer-  , _precision = RFC3339-  , _authentication = Nothing-  , _manager = Left HC.defaultManagerSettings+queryParams queryDatabase = QueryParams+  { queryServer = defaultServer+  , queryPrecision = RFC3339+  , queryAuthentication = Nothing+  , queryManager = Left HC.defaultManagerSettings   , ..   } @@ -196,8 +217,8 @@       chunks <- HC.brConsume $ HC.responseBody response       let body = BL.fromChunks chunks       case eitherDecode' body of-        Left message -> throwIO $ IllformedJSON message body-        Right val -> case A.parse (parseResults (_precision params)) val of+        Left message -> throwIO $ UnexpectedResponse message body+        Right val -> case A.parse (parseResults (queryPrecision params)) val of           A.Success vec -> return vec           A.Error message ->             errorQuery request response message@@ -250,12 +271,12 @@           | B.null chunk = return x           | otherwise = case k chunk of             AB.Fail unconsumed _contexts message ->-              throwIO $ IllformedJSON message $ BL.fromStrict unconsumed+              throwIO $ UnexpectedResponse message $ BL.fromStrict unconsumed             AB.Partial k' -> do               chunk' <- HC.responseBody response               loop x k' chunk'             AB.Done leftover val ->-              case A.parse (parseResults (_precision params)) val of+              case A.parse (parseResults (queryPrecision params)) val of                 A.Success vec -> do                   x' <- step x vec                   loop x' k0 leftover@@ -275,18 +296,19 @@   -> (HC.Request -> HC.Response HC.BodyReader -> IO r)   -> IO r withQueryResponse params chunkSize q f = do-    manager' <- either HC.newManager return $ _manager params+    manager' <- either HC.newManager return $ queryManager params     HC.withResponse request manager' (f request)+      `catch` (throwIO . HTTPException)   where     request =-      HC.setQueryString (setPrecision (_precision params) queryString) $+      HC.setQueryString (setPrecision (queryPrecision params) queryString) $         queryRequest params     queryString = addChunkedParam       [ ("q", Just $ F.fromQuery q)       , ("db", Just db)       ]       where-        !db = TE.encodeUtf8 $ databaseName $ _database params+        !db = TE.encodeUtf8 $ databaseName $ queryDatabase params     addChunkedParam ps = case chunkSize of       Nothing -> ps       Just size ->@@ -305,7 +327,7 @@   , HC.path = "/query"   }   where-    Server {..} = _server+    Server {..} = queryServer  errorQuery :: HC.Request -> HC.Response body -> String -> IO a errorQuery request response message = do@@ -313,55 +335,54 @@   when (HT.statusIsServerError status) $     throwIO $ ServerError message   when (HT.statusIsClientError status) $-    throwIO $ BadRequest message request+    throwIO $ ClientError message request   fail $ "BUG: " ++ message ++ " in Database.InfluxDB.Query.query - "     ++ show request -makeLensesWith (lensRules & generateSignatures .~ False) ''QueryParams--server :: Lens' QueryParams Server+makeLensesWith+  ( lensRules+    & lensField .~ mappingNamer+      (\name -> case stripPrefix "query" name of+        Just (c:cs) -> ['_':toLower c:cs]+        _ -> [])+    )+  ''QueryParams  -- | -- >>> let p = queryParams "foo" -- >>> p ^. server.host -- "localhost" instance HasServer QueryParams where-  server = Database.InfluxDB.Query.server--database :: Lens' QueryParams Database+  server = _server  -- | -- >>> let p = queryParams "foo" -- >>> p ^. database -- "foo" instance HasDatabase QueryParams where-  database = Database.InfluxDB.Query.database--precision :: Lens' QueryParams (Precision 'QueryRequest)+  database = _database  -- | Returning JSON responses contain timestamps in the specified -- precision/format. -- -- >>> let p = queryParams "foo" -- >>> p ^. precision--- Nanosecond+-- RFC3339 instance HasPrecision 'QueryRequest QueryParams where-  precision = Database.InfluxDB.Query.precision--manager :: Lens' QueryParams (Either HC.ManagerSettings HC.Manager)+  precision = _precision  -- |--- >>> let p = queryParams "foo"--- >>> p & manager .~ Left HC.defaultManagerSettings+-- >>> let p = queryParams "foo" & manager .~ Left HC.defaultManagerSettings instance HasManager QueryParams where-  manager = Database.InfluxDB.Query.manager+  manager = _manager  -- | Authentication info for the query -- -- >>> let p = queryParams "foo" -- >>> p ^. authentication -- Nothing-authentication :: Lens' QueryParams (Maybe Credentials)-+-- >>> let p' = p & authentication ?~ credentials "john" "passw0rd"+-- >>> p' ^. authentication.traverse.user+-- "john" instance HasCredentials QueryParams where-  authentication = Database.InfluxDB.Query.authentication+  authentication = _authentication

@@ -13,7 +13,6 @@ {-# LANGUAGE TemplateHaskell #-} module Database.InfluxDB.Types where import Control.Exception-import Data.Data (Data) import Data.Int (Int64) import Data.String import Data.Typeable (Typeable)@@ -26,7 +25,30 @@ import Network.HTTP.Client (Manager, ManagerSettings, Request) import qualified Data.ByteString.Lazy as BL import qualified Data.Text as T+import qualified Network.HTTP.Client as HC +-- $setup+-- >>> :set -XOverloadedStrings+-- >>> import Database.InfluxDB++-- | An InfluxDB query.+--+-- A spec of the format is available at+-- <https://docs.influxdata.com/influxdb/v1.2/query_language/spec/>.+--+-- A 'Query' can be constructed using either+--+--   * the 'IsString' instance with @-XOverloadedStrings@+--   * or 'Database.InfluxDB.Format.formatQuery'.+--+-- >>> :set -XOverloadedStrings+-- >>> "SELECT * FROM series" :: Query+-- "SELECT * FROM series"+-- >>> import qualified Database.InfluxDB.Format as F+-- >>> formatQuery ("SELECT * FROM "%F.key) "series"+-- "SELECT * FROM \"series\""+--+-- NOTE: Currently this library doesn't support type-safe query construction. newtype Query = Query T.Text deriving IsString  instance Show Query where@@ -45,8 +67,8 @@ --  * 'host': @"localhost"@ --  * 'port': @8086@ --  * 'ssl': 'False'-localServer :: Server-localServer = Server+defaultServer :: Server+defaultServer = Server   { _host = "localhost"   , _port = 8086   , _ssl = False@@ -67,11 +89,21 @@ data Credentials = Credentials   { _user :: !Text   , _password :: !Text-  }+  } deriving Show +credentials+    :: Text -- ^ User name+    -> Text -- ^ Password+    -> Credentials+credentials = Credentials+ makeLensesWith (lensRules & generateSignatures .~ False) ''Credentials --- | User name to access InfluxDB+-- | User name to access InfluxDB.+--+-- >>> let creds = credentials "john" "passw0rd"+-- >>> creds ^. user+-- "john" user :: Lens' Credentials Text  -- | Password to access InfluxDB@@ -100,15 +132,27 @@ instance Show Key where   show (Key name) = show name -data FieldValue-  = FieldInt !Int64-  | FieldFloat !Double-  | FieldString !Text-  | FieldBool !Bool-  | FieldNull-  deriving (Eq, Show, Data, Typeable, Generic)+data Nullability = Nullable | NonNullable deriving Typeable -instance IsString FieldValue where+-- | Field type for queries. Queries can contain null values.+type QueryField = Field 'Nullable++-- | Field type for the line protocol. The line protocol doesn't accept null+-- values.+type LineField = Field 'NonNullable++data Field (n :: Nullability) where+  FieldInt :: !Int64 -> Field n+  FieldFloat :: !Double -> Field n+  FieldString :: !Text -> Field n+  FieldBool :: !Bool -> Field n+  FieldNull :: Field 'Nullable+  deriving Typeable++deriving instance Eq (Field n)+deriving instance Show (Field n)++instance IsString (Field n) where   fromString = FieldString . T.pack  -- | Type of a request@@ -141,6 +185,10 @@  deriving instance Show (Precision a) +-- | Name of the time precision.+--+-- >>> precisionName Nanosecond+-- "n" precisionName :: Precision ty -> Text precisionName = \case   Nanosecond -> "n"@@ -162,6 +210,12 @@ roundAt :: RealFrac a => a -> a -> a roundAt scale x = fromIntegral (round (x / scale) :: Int) * scale +-- | Scale of the type precision.+--+-- >>> precisionScale RFC3339+-- 1.0e-9+-- >>> precisionScale Microsecond+-- 1.0e-6 precisionScale :: Fractional a => Precision ty -> a precisionScale = \case   RFC3339 ->     10^^(-9 :: Int)@@ -191,27 +245,38 @@   --   -- You can expect to get a successful response once the issue is resolved on   -- the server side.-  | BadRequest String Request+  | ClientError String Request   -- ^ Client side error.   --   -- You need to fix your query to get a successful response.-  | IllformedJSON String BL.ByteString-  -- ^ Unexpected JSON response.+  | UnexpectedResponse String BL.ByteString+  -- ^ Received an unexpected response. The 'String' field is a message and the+  -- 'BL.ByteString' field is a possibly-empty relevant payload.   --   -- This can happen e.g. when the response from InfluxDB is incompatible with   -- what this library expects due to an upstream format change etc.+  | HTTPException HC.HttpException+  -- ^ HTTP communication error.+  --+  -- Typical HTTP errors (4xx and 5xx) are covered by 'ClientError' and+  -- 'ServerError'. So this exception means something unusual happened. Note+  -- that if 'HC.checkResponse' is overridden to throw an 'HC.HttpException' on+  -- an unsuccessful HTTP code, this exception is thrown instead of+  -- 'ClientError' or 'ServerError'.   deriving (Show, Typeable)  instance Exception InfluxException  class HasServer a where+  -- | InfluxDB server address and port that to interact with.   server :: Lens' a Server  class HasDatabase a where+  -- | Database name to work on.   database :: Lens' a Database  class HasPrecision (ty :: RequestType) a | a -> ty where-  -- Time precision parameter+  -- | Time precision parameter.   precision :: Lens' a (Precision ty)  class HasManager a where@@ -222,4 +287,5 @@   manager :: Lens' a (Either ManagerSettings Manager)  class HasCredentials a where+  -- | User name and password to be used when sending requests to InfluxDB.   authentication :: Lens' a (Maybe Credentials)

@@ -1,3 +1,4 @@+{-# LANGUAGE CPP #-} {-# LANGUAGE DataKinds #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE NamedFieldPuns #-}@@ -6,8 +7,14 @@ {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE ViewPatterns #-}+#if __GLASGOW_HASKELL__ >= 800+{-# OPTIONS_GHC -Wno-missing-signatures #-}+#else+{-# OPTIONS_GHC -fno-warn-missing-signatures #-}+#endif module Database.InfluxDB.Write   ( -- * Writers+    -- $intro     write   , writeBatch   , writeByteString@@ -31,27 +38,43 @@ import qualified Data.ByteString.Char8 as B8 import qualified Data.ByteString.Lazy as BL import qualified Data.Text.Encoding as TE+import qualified Network.HTTP.Client as HC import qualified Network.HTTP.Types as HT  import Database.InfluxDB.Line import Database.InfluxDB.Types as Types import Database.InfluxDB.JSON-import qualified Network.HTTP.Client.Compat as HC +-- $setup+-- >>> :set -XOverloadedStrings+-- >>> import qualified Data.Map as Map+-- >>> import Data.Time+-- >>> import Database.InfluxDB+-- >>> manage (queryParams "test-db") "CREATE DATABASE \"test-db\""++{- $intro+The code snippets in this module assume the following imports.++@+import qualified Data.Map as Map+import Data.Time+@+-}+ -- | The full set of parameters for the HTTP writer. data WriteParams = WriteParams-  { _server :: !Server-  , _database :: !Database+  { writeServer :: !Server+  , writeDatabase :: !Database   -- ^ Database to be written-  , _retentionPolicy :: !(Maybe Key)+  , writeRetentionPolicy :: !(Maybe Key)   -- ^ 'Nothing' means the default retention policy for the database.-  , _precision :: !(Precision 'WriteRequest)+  , writePrecision :: !(Precision 'WriteRequest)   -- ^ Timestamp precision   --   -- In the HTTP API, timestamps are scaled by the given precision.-  , _authentication  :: !(Maybe Credentials)+  , writeAuthentication  :: !(Maybe Credentials)   -- ^ No authentication by default-  , _manager :: !(Either HC.ManagerSettings HC.Manager)+  , writeManager :: !(Either HC.ManagerSettings HC.Manager)   -- ^ HTTP connection manager   } @@ -59,45 +82,56 @@ -- -- Default parameters: -----   ['L.server'] 'localServer'+--   ['L.server'] 'defaultServer' --   ['L.precision'] 'Nanosecond' --   ['retentionPolicy'] 'Nothing' --   ['L.manager'] @'Left' 'HC.defaultManagerSettings'@ writeParams :: Database -> WriteParams-writeParams _database = WriteParams-  { _server = localServer-  , _precision = Nanosecond-  , _retentionPolicy = Nothing-  , _authentication = Nothing-  , _manager = Left HC.defaultManagerSettings+writeParams writeDatabase = WriteParams+  { writeServer = defaultServer+  , writePrecision = Nanosecond+  , writeRetentionPolicy = Nothing+  , writeAuthentication = Nothing+  , writeManager = Left HC.defaultManagerSettings   , ..   } --- | Write a 'Line'+-- | Write a 'Line'.+--+-- >>> let p = writeParams "test-db"+-- >>> write p $ Line "room_temp" Map.empty (Map.fromList [("temp", FieldFloat 25.0)]) (Nothing :: Maybe UTCTime) write   :: Timestamp time   => WriteParams   -> Line time   -> IO ()-write p@WriteParams {_precision} =-  writeByteString p . encodeLine (scaleTo _precision)+write p@WriteParams {writePrecision} =+  writeByteString p . encodeLine (scaleTo writePrecision) --- | Write 'Line's in a batch+-- | Write multiple 'Line's in a batch. ----- This is more efficient than 'write'.+-- This is more efficient than calling 'write' multiple times.+--+-- >>> let p = writeParams "test-db"+-- >>> :{+-- writeBatch p+--   [ Line "temp" (Map.singleton "city" "tokyo") (Map.fromList [("temp", FieldFloat 25.0)]) (Nothing :: Maybe UTCTime)+--   , Line "temp" (Map.singleton "city" "osaka") (Map.fromList [("temp", FieldFloat 25.2)]) (Nothing :: Maybe UTCTime)+--   ]+-- :} writeBatch   :: (Timestamp time, Foldable f)   => WriteParams   -> f (Line time)   -> IO ()-writeBatch p@WriteParams {_precision} =-  writeByteString p . encodeLines (scaleTo _precision)+writeBatch p@WriteParams {writePrecision} =+  writeByteString p . encodeLines (scaleTo writePrecision)  -- | Write a raw 'BL.ByteString' writeByteString :: WriteParams -> BL.ByteString -> IO () writeByteString params payload = do-  manager' <- either HC.newManager return $ _manager params-  response <- HC.httpLbs request manager'+  manager' <- either HC.newManager return $ writeManager params+  response <- HC.httpLbs request manager' `catch` (throwIO . HTTPException)   let body = HC.responseBody response       status = HC.responseStatus response   if BL.null body@@ -106,18 +140,19 @@       when (HT.statusIsServerError status) $         throwIO $ ServerError message       when (HT.statusIsClientError status) $-        throwIO $ BadRequest message request+        throwIO $ ClientError message request     else case A.eitherDecode' body of       Left message ->-        throwIO $ IllformedJSON message body+        throwIO $ UnexpectedResponse message body       Right val -> case A.parse parseErrorObject val of         A.Success _ ->-          fail $ "BUG: impossible code path in Database.InfluxDB.Write.writeByteString"+          fail $ "BUG: impossible code path in "+            ++ "Database.InfluxDB.Write.writeByteString"         A.Error message -> do           when (HT.statusIsServerError status) $             throwIO $ ServerError message           when (HT.statusIsClientError status) $-            throwIO $ BadRequest message request+            throwIO $ ClientError message request           fail $ "BUG: " ++ message             ++ " in Database.InfluxDB.Write.writeByteString" @@ -136,74 +171,77 @@     , HC.path = "/write"     }   where-    Server {..} = _server+    Server {..} = writeServer     qs = concat-      [ [("db", Just $ TE.encodeUtf8 $ databaseName _database)]+      [ [("db", Just $ TE.encodeUtf8 $ databaseName writeDatabase)]       , fromMaybe [] $ do-        Key name <- _retentionPolicy+        Key name <- writeRetentionPolicy         return [("rp", Just (TE.encodeUtf8 name))]       , fromMaybe [] $ do-        Credentials { _user = u, _password = p } <- _authentication+        Credentials { _user = u, _password = p } <- writeAuthentication         return           [ ("u", Just (TE.encodeUtf8 u))           , ("p", Just (TE.encodeUtf8 p))           ]       ] -makeLensesWith (lensRules & generateSignatures .~ False) ''WriteParams--server :: Lens' WriteParams Server+makeLensesWith+  ( lensRules+    & generateSignatures .~ False+    & lensField .~ lookingupNamer+      [ ("writeServer", "_server")+      , ("writeDatabase", "_database")+      , ("writeRetentionPolicy", "retentionPolicy")+      , ("writePrecision", "_precision")+      , ("writeManager", "_manager")+      , ("writeAuthentication", "_authentication")+      ]+    )+  ''WriteParams  -- | -- >>> let p = writeParams "foo" -- >>> p ^. server.host -- "localhost" instance HasServer WriteParams where-  server = Database.InfluxDB.Write.server--database :: Lens' WriteParams Database+  server = _server  -- | -- >>> let p = writeParams "foo" -- >>> p ^. database -- "foo" instance HasDatabase WriteParams where-  database = Database.InfluxDB.Write.database+  database = _database  -- | Target retention policy for the write. -- -- InfluxDB writes to the @default@ retention policy if this parameter is set -- to 'Nothing'. ----- >>> let p = writeParams "foo"--- >>> let p' = p & retentionPolicy .~ Just "two_hours"--- >>> p' ^. retentionPolicy+-- >>> let p = writeParams "foo" & retentionPolicy .~ Just "two_hours"+-- >>> p ^. retentionPolicy -- Just "two_hours" retentionPolicy :: Lens' WriteParams (Maybe Key) -precision :: Lens' WriteParams (Precision 'WriteRequest)- -- | -- >>> let p = writeParams "foo" -- >>> p ^. precision -- Nanosecond instance HasPrecision 'WriteRequest WriteParams where-  precision = Database.InfluxDB.Write.precision--manager :: Lens' WriteParams (Either HC.ManagerSettings HC.Manager)+  precision = _precision  -- |--- >>> let p = writeParams "foo"--- >>> p & manager .~ Left HC.defaultManagerSettings+-- >>> let p = writeParams "foo" & manager .~ Left HC.defaultManagerSettings instance HasManager WriteParams where-  manager = Database.InfluxDB.Write.manager+  manager = _manager  -- | Authentication info for the write -- -- >>> let p = writeParams "foo" -- >>> p ^. authentication -- Nothing-authentication :: Lens' WriteParams (Maybe Credentials)-+-- >>> let p' = p & authentication ?~ credentials "john" "passw0rd"+-- >>> p' ^. authentication . traverse . user+-- "john" instance HasCredentials WriteParams where-  authentication = Database.InfluxDB.Write.authentication+  authentication = _authentication

@@ -1,16 +0,0 @@-{-# LANGUAGE CPP #-}-module Network.HTTP.Client.Compat-  ( defaultRequest-  , module X-  ) where--#if MIN_VERSION_http_client(0, 5, 0)-import Network.HTTP.Client (defaultRequest)-import Network.HTTP.Client as X hiding (defaultRequest)-#else-import Data.Default.Class (def)-import Network.HTTP.Client as X--defaultRequest :: Request-defaultRequest = def-#endif