summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorMitsutoshiAoe <>2017-06-19 00:41:00 (GMT)
committerhdiff <hdiff@hdiff.luite.com>2017-06-19 00:41:00 (GMT)
commit4c9ec24781eba709a17b1580fcc1cd613e62a182 (patch)
tree2919a91366b247130a9fae2fd98252e3caa52716
parentaad152d652caf2bed7b03fbb8da9d3497e60ec23 (diff)
version 1.2.01.2.0
-rw-r--r--CHANGELOG.md19
-rw-r--r--examples/random-points.hs4
-rw-r--r--influxdb.cabal22
-rw-r--r--src/Database/InfluxDB.hs113
-rw-r--r--src/Database/InfluxDB/Format.hs123
-rw-r--r--src/Database/InfluxDB/JSON.hs62
-rw-r--r--src/Database/InfluxDB/Line.hs10
-rw-r--r--src/Database/InfluxDB/Manage.hs118
-rw-r--r--src/Database/InfluxDB/Ping.hs140
-rw-r--r--src/Database/InfluxDB/Query.hs129
-rw-r--r--src/Database/InfluxDB/Types.hs100
-rw-r--r--src/Database/InfluxDB/Write.hs142
-rw-r--r--src/Network/HTTP/Client/Compat.hs16
13 files changed, 705 insertions, 293 deletions
diff --git a/CHANGELOG.md b/CHANGELOG.md
index fc34a1b..3258ce3 100644
--- a/CHANGELOG.md
+++ b/CHANGELOG.md
@@ -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
diff --git a/examples/random-points.hs b/examples/random-points.hs
index 4e41845..1e97e48 100644
--- a/examples/random-points.hs
+++ b/examples/random-points.hs
@@ -77,7 +77,7 @@ data Row = Row
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 @@ data Name
| Qux
deriving (Enum, Bounded, Show)
-nameToFVal :: Name -> FieldValue
+nameToFVal :: Name -> LineField
nameToFVal = FieldString . T.toLower . T.pack . show
instance Variate Name where
diff --git a/influxdb.cabal b/influxdb.cabal
index 1db8c8a..ade5435 100644
--- a/influxdb.cabal
+++ b/influxdb.cabal
@@ -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 @@ flag examples
default: False
manual: True
-flag http-client-05
- default: True
- manual: False
-
library
exposed-modules:
Database.InfluxDB
@@ -38,8 +37,6 @@ library
Database.InfluxDB.Types
Database.InfluxDB.Write
Database.InfluxDB.Write.UDP
- other-modules:
- Network.HTTP.Client.Compat
other-extensions:
BangPatterns
CPP
@@ -70,6 +67,7 @@ library
, 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 @@ library
, 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 head
source-repository this
type: git
- tag: v1.1.2.2
+ tag: v1.2.0
location: https://github.com/maoe/influxdb-haskell.git
diff --git a/src/Database/InfluxDB.hs b/src/Database/InfluxDB.hs
index aef0159..67b736b 100644
--- a/src/Database/InfluxDB.hs
+++ b/src/Database/InfluxDB.hs
@@ -23,17 +23,21 @@ module Database.InfluxDB
, 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 @@ module Database.InfluxDB
, authentication
-- ** Parsing results
+ -- $parsing-results
, QueryResults(..)
, parseResultsWith
, getField
, getTag
- , parseTimestamp
- , parseFieldValue
- , parseKey
+ , parseUTCTime
+ , parsePOSIXTime
+ , parseQueryField
-- * Database management
, manage
@@ -63,9 +68,10 @@ module Database.InfluxDB
, host
, port
, ssl
- , localServer
+ , defaultServer
, Credentials
+ , credentials
, user
, password
@@ -86,6 +92,85 @@ import Database.InfluxDB.Query
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
@@ -95,3 +180,19 @@ import:
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
+@
+-}
diff --git a/src/Database/InfluxDB/Format.hs b/src/Database/InfluxDB/Format.hs
index 38623b6..d8a5dba 100644
--- a/src/Database/InfluxDB/Format.hs
+++ b/src/Database/InfluxDB/Format.hs
@@ -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 qualified Data.Text.Lazy.Builder.RealFloat as TL
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 @@ instance Category Format where
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) <> "'"
diff --git a/src/Database/InfluxDB/JSON.hs b/src/Database/InfluxDB/JSON.hs
index 8c7230f..f84e659 100644
--- a/src/Database/InfluxDB/JSON.hs
+++ b/src/Database/InfluxDB/JSON.hs
@@ -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.Maybe
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 qualified Data.Vector as V
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 @@ lenientDecoder = Decoder
-- | 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 @@ getField column columns fields =
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 @@ parseSeriesBody = A.withObject "series" $ \obj -> do
!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 @@ parsePOSIXTime prec val = case prec of
-- 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 @@ parseFieldValue val = case val of
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
diff --git a/src/Database/InfluxDB/Line.hs b/src/Database/InfluxDB/Line.hs
index e623b4a..afd3708 100644
--- a/src/Database/InfluxDB/Line.hs
+++ b/src/Database/InfluxDB/Line.hs
@@ -1,4 +1,3 @@
-{-# LANGUAGE DataKinds #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
@@ -34,14 +33,14 @@ import Database.InfluxDB.Types
-- | 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 @@ buildKey = TE.encodeUtf8Builder . escapeKey
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 @@ tagSet :: Lens' (Line time) (Map Key Text)
-- | 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.
diff --git a/src/Database/InfluxDB/Manage.hs b/src/Database/InfluxDB/Manage.hs
index 9042f6e..93cd058 100644
--- a/src/Database/InfluxDB/Manage.hs
+++ b/src/Database/InfluxDB/Manage.hs
@@ -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.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, 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 @@ manage params q = 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.Manage.manage"
where
request = HC.setQueryString qs $ manageRequest params
@@ -72,23 +100,25 @@ manageRequest params = HC.defaultRequest
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 @@ parseDuration = AT.parseOnly $ sum <$!> durations
newtype ShowSeries = ShowSeries
{ _key :: Key
- } deriving Show
+ }
instance QueryResults ShowSeries where
- parseResults _ = parseResultsWith $ \_ _ columns fields ->
- ShowSeries <$> parseKey "key" columns fields
-
-makeLensesWith (lensRules & generateSignatures .~ False) ''ShowQuery
+ parseResults _ = parseResultsWith $ \_ _ columns fields -> do
+ FieldString name <- getField "key" columns fields >>= parseQueryField
+ 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 (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
diff --git a/src/Database/InfluxDB/Ping.hs b/src/Database/InfluxDB/Ping.hs
index cb75b31..4774635 100644
--- a/src/Database/InfluxDB/Ping.hs
+++ b/src/Database/InfluxDB/Ping.hs
@@ -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
-
-server :: Lens' PingParams Server
+-- | 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
+ }
+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 @@ pingRequest PingParams {..} = HC.defaultRequest
, 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
diff --git a/src/Database/InfluxDB/Query.hs b/src/Database/InfluxDB/Query.hs
index 19f261d..eca397e 100644
--- a/src/Database/InfluxDB/Query.hs
+++ b/src/Database/InfluxDB/Query.hs
@@ -19,27 +19,26 @@ module Database.InfluxDB.Query
-- * 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.ByteString.Lazy as BL
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 @@ instance
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 @@ data QueryParams = QueryParams
--
-- 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 @@ query params q = withQueryResponse params Nothing q go
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 @@ queryChunked params chunkSize q (L.FoldM step initialize extract) =
| 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 @@ withQueryResponse
-> (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 @@ queryRequest QueryParams {..} = HC.defaultRequest
, 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 @@ errorQuery request response 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.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
diff --git a/src/Database/InfluxDB/Types.hs b/src/Database/InfluxDB/Types.hs
index 27fd118..823432c 100644
--- a/src/Database/InfluxDB/Types.hs
+++ b/src/Database/InfluxDB/Types.hs
@@ -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 Data.Time.Clock.POSIX
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 @@ data Server = Server
-- * 'host': @"localhost"@
-- * 'port': @8086@
-- * 'ssl': 'False'
-localServer :: Server
-localServer = Server
+defaultServer :: Server
+defaultServer = Server
{ _host = "localhost"
, _port = 8086
, _ssl = False
@@ -67,11 +89,21 @@ ssl :: Lens' Server Bool
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 Database where
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
+
+-- | 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
-instance IsString FieldValue where
+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 @@ data Precision (ty :: RequestType) where
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 @@ class Timestamp time where
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 @@ data InfluxException
--
-- 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 @@ class HasManager a where
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)
diff --git a/src/Database/InfluxDB/Write.hs b/src/Database/InfluxDB/Write.hs
index 70cfc28..622e38d 100644
--- a/src/Database/InfluxDB/Write.hs
+++ b/src/Database/InfluxDB/Write.hs
@@ -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.Aeson.Types as A
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 @@ data WriteParams = WriteParams
--
-- 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 @@ writeByteString params payload = do
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 @@ writeRequest WriteParams {..} =
, 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
diff --git a/src/Network/HTTP/Client/Compat.hs b/src/Network/HTTP/Client/Compat.hs
deleted file mode 100644
index 01a8e4e..0000000
--- a/src/Network/HTTP/Client/Compat.hs
+++ /dev/null
@@ -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