influxdb-1.2.0: Haskell client library for InfluxDB

Stabilityexperimental
PortabilityGHC
Safe HaskellNone
LanguageHaskell2010

Database.InfluxDB

Contents

Description

 

Synopsis

Documentation

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 in the official Go client library.

Creating a database

This library assumes the lens package in some APIs. Here we use ?~ to set the authentication parameters of type Maybe Credentials.

Also note that in order to construct a Query, we use formatQuery with the 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.

Writing data

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

import qualified Database.InfluxDB.Write.UDP as UDP

write :: Timestamp time => WriteParams -> Line time -> IO () Source #

Write a Line.

>>> let p = writeParams "test-db"
>>> write p $ Line "room_temp" Map.empty (Map.fromList [("temp", FieldFloat 25.0)]) (Nothing :: Maybe UTCTime)

writeBatch :: (Timestamp time, Foldable f) => WriteParams -> f (Line time) -> IO () Source #

Write multiple Lines in a batch.

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)
  ]
:}

Write parameters

data WriteParams Source #

The full set of parameters for the HTTP writer.

Instances

HasCredentials WriteParams Source #

Authentication info for the write

>>> let p = writeParams "foo"
>>> p ^. authentication
Nothing
>>> let p' = p & authentication ?~ credentials "john" "passw0rd"
>>> p' ^. authentication . traverse . user
"john"
HasManager WriteParams Source #
>>> let p = writeParams "foo" & manager .~ Left HC.defaultManagerSettings
HasDatabase WriteParams Source #
>>> let p = writeParams "foo"
>>> p ^. database
"foo"
HasServer WriteParams Source #
>>> let p = writeParams "foo"
>>> p ^. server.host
"localhost"
HasPrecision WriteRequest WriteParams Source #
>>> let p = writeParams "foo"
>>> p ^. precision
Nanosecond

retentionPolicy :: Lens' WriteParams (Maybe Key) Source #

Target retention policy for the write.

InfluxDB writes to the default retention policy if this parameter is set to Nothing.

>>> let p = writeParams "foo" & retentionPolicy .~ Just "two_hours"
>>> p ^. retentionPolicy
Just "two_hours"

The Line protocol

data Line time Source #

Placeholder for the Line Protocol

See https://docs.influxdata.com/influxdb/v1.2/write_protocols/line_protocol_tutorial/ for the concrete syntax.

Constructors

Line !Key !(Map Key Text) !(Map Key LineField) !(Maybe time) 

measurement :: Lens' (Line time) Key Source #

Name of the measurement that you want to write your data to.

tagSet :: Lens' (Line time) (Map Key Text) Source #

Tag(s) that you want to include with your data point. Tags are optional in the Line Protocol, so you can set it empty.

fieldSet :: Lens' (Line time) (Map Key LineField) Source #

Field(s) for your data point. Every data point requires at least one field in the Line Protocol, so it shouldn't be empty.

timestamp :: Lens' (Line time) (Maybe time) Source #

Timestamp for your data point. You can put whatever type of timestamp that is an instance of the Timestamp class.

data Field n where Source #

Constructors

FieldInt :: !Int64 -> Field n 
FieldFloat :: !Double -> Field n 
FieldString :: !Text -> Field n 
FieldBool :: !Bool -> Field n 
FieldNull :: Field Nullable 

Instances

Eq (Field n) Source # 

Methods

(==) :: Field n -> Field n -> Bool #

(/=) :: Field n -> Field n -> Bool #

Show (Field n) Source # 

Methods

showsPrec :: Int -> Field n -> ShowS #

show :: Field n -> String #

showList :: [Field n] -> ShowS #

IsString (Field n) Source # 

Methods

fromString :: String -> Field n #

type LineField = Field NonNullable Source #

Field type for the line protocol. The line protocol doesn't accept null values.

type QueryField = Field Nullable Source #

Field type for queries. Queries can contain null values.

class Timestamp time where Source #

A Timestamp is something that can be converted to a valid InfluxDB timestamp, which is represented as a 64-bit integer.

Minimal complete definition

roundTo, scaleTo

Methods

roundTo :: Precision WriteRequest -> time -> Int64 Source #

Round a time to the given precision and scale it to nanoseconds

scaleTo :: Precision WriteRequest -> time -> Int64 Source #

Scale a time to the given precision

precisionScale :: Fractional a => Precision ty -> a Source #

Scale of the type precision.

>>> precisionScale RFC3339
1.0e-9
>>> precisionScale Microsecond
1.0e-6

precisionName :: Precision ty -> Text Source #

Name of the time precision.

>>> precisionName Nanosecond
"n"

Querying data

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.

data Query Source #

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

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

query :: QueryResults a => QueryParams -> Query -> IO (Vector a) Source #

Query data from InfluxDB.

It may throw InfluxException.

queryChunked Source #

Arguments

:: QueryResults a 
=> QueryParams 
-> Optional Int

Chunk size

By Default, InfluxDB chunks responses by series or by every 10,000 points, whichever occurs first. If it set to a Specific value, InfluxDB chunks responses by series or by that number of points.

-> Query 
-> FoldM IO (Vector a) r 
-> IO r 

Same as query but it instructs InfluxDB to stream chunked responses rather than returning a huge JSON object. This can be lot more efficient than query if the result is huge.

It may throw InfluxException.

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

formatQuery :: Format Query r -> r Source #

Format a Query.

>>> formatQuery "SELECT * FROM series"
"SELECT * FROM series"
>>> formatQuery ("SELECT * FROM "%key) "series"
"SELECT * FROM \"series\""

(%) :: Format b c -> Format a b -> Format a c Source #

Format specific synonym of (.).

This is typically easier to use than (.) is because it doesn't conflict with Prelude.(.).

Query parameters

data QueryParams Source #

The full set of parameters for the query API

Instances

HasCredentials QueryParams Source #

Authentication info for the query

>>> let p = queryParams "foo"
>>> p ^. authentication
Nothing
>>> let p' = p & authentication ?~ credentials "john" "passw0rd"
>>> p' ^. authentication.traverse.user
"john"
HasManager QueryParams Source #
>>> let p = queryParams "foo" & manager .~ Left HC.defaultManagerSettings
HasDatabase QueryParams Source #
>>> let p = queryParams "foo"
>>> p ^. database
"foo"
HasServer QueryParams Source #
>>> let p = queryParams "foo"
>>> p ^. server.host
"localhost"
HasPrecision QueryRequest QueryParams Source #

Returning JSON responses contain timestamps in the specified precision/format.

>>> let p = queryParams "foo"
>>> p ^. precision
RFC3339

authentication :: HasCredentials a => Lens' a (Maybe Credentials) Source #

User name and password to be used when sending requests to InfluxDB.

Parsing results

class QueryResults a where Source #

Types that can be converted from an JSON object returned by InfluxDB.

For example the h2o_feet series in the official document 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 {..}
:}

Minimal complete definition

parseResults

Methods

parseResults :: Precision QueryRequest -> Value -> Parser (Vector a) Source #

Parse a JSON object as an array of values of expected type.

Instances

QueryResults Void Source # 
QueryResults ShowSeries Source # 
QueryResults ShowQuery Source # 
((~) * a Value, (~) * b Value) => QueryResults (a, b) Source # 
((~) * a Value, (~) * b Value, (~) * c Value) => QueryResults (a, b, c) Source # 
((~) * a Value, (~) * b Value, (~) * c Value, (~) * d Value) => QueryResults (a, b, c, d) Source # 

Methods

parseResults :: Precision QueryRequest -> Value -> Parser (Vector (a, b, c, d)) Source #

((~) * a Value, (~) * b Value, (~) * c Value, (~) * d Value, (~) * e Value) => QueryResults (a, b, c, d, e) Source # 

Methods

parseResults :: Precision QueryRequest -> Value -> Parser (Vector (a, b, c, d, e)) Source #

((~) * a Value, (~) * b Value, (~) * c Value, (~) * d Value, (~) * e Value, (~) * f Value) => QueryResults (a, b, c, d, e, f) Source # 

Methods

parseResults :: Precision QueryRequest -> Value -> Parser (Vector (a, b, c, d, e, f)) Source #

((~) * a Value, (~) * b Value, (~) * c Value, (~) * d Value, (~) * e Value, (~) * f Value, (~) * g Value) => QueryResults (a, b, c, d, e, f, g) Source # 

Methods

parseResults :: Precision QueryRequest -> Value -> Parser (Vector (a, b, c, d, e, f, g)) Source #

((~) * a Value, (~) * b Value, (~) * c Value, (~) * d Value, (~) * e Value, (~) * f Value, (~) * g Value, (~) * h Value) => QueryResults (a, b, c, d, e, f, g, h) Source # 

Methods

parseResults :: Precision QueryRequest -> Value -> Parser (Vector (a, b, c, d, e, f, g, h)) Source #

parseResultsWith Source #

Arguments

:: (Maybe Text -> HashMap Text Text -> Vector Text -> Array -> Parser a)

A parser that takes

  1. an optional name of the series
  2. a map of tags
  3. an array of field names
  4. an array of values

to construct a value.

-> Value 
-> Parser (Vector a) 

A helper function to parse a JSON response in parseResults.

getField Source #

Arguments

:: Monad m 
=> Text

Column name

-> Vector Text

Columns

-> Vector Value

Field values

-> m Value 

Get a field value from a column name

getTag Source #

Arguments

:: Monad m 
=> Text

Tag name

-> HashMap Text Value

Tags

-> m Value 

Get a tag value from a tag name

parseUTCTime :: Precision ty -> Value -> Parser UTCTime Source #

Parse either a POSIX timestamp or RFC3339 formatted timestamp as UTCTime.

parsePOSIXTime :: Precision ty -> Value -> Parser POSIXTime Source #

Parse either a POSIX timestamp or RFC3339 formatted timestamp as POSIXTime.

Database management

manage :: QueryParams -> Query -> IO () Source #

Send a database management query to InfluxDB.

>>> let db = "manage-test"
>>> let p = queryParams db
>>> manage p $ F.formatQuery ("CREATE DATABASE "%F.database) db

Common data types and classes

data Precision ty where Source #

Predefined set of time precision.

RFC3339 is only available for QueryRequests.

Constructors

Nanosecond :: Precision ty

POSIX time in ns

Microsecond :: Precision ty

POSIX time in μs

Millisecond :: Precision ty

POSIX time in ms

Second :: Precision ty

POSIX time in s

Minute :: Precision ty

POSIX time in minutes

Hour :: Precision ty

POSIX time in hours

RFC3339 :: Precision QueryRequest

Nanosecond precision time in a human readable format, like 2016-01-04T00:00:23.135623Z. This is the default format for /query.

Instances

data Key Source #

String type that is used for measurements, tag keys and field keys.

Instances

Eq Key Source # 

Methods

(==) :: Key -> Key -> Bool #

(/=) :: Key -> Key -> Bool #

Ord Key Source # 

Methods

compare :: Key -> Key -> Ordering #

(<) :: Key -> Key -> Bool #

(<=) :: Key -> Key -> Bool #

(>) :: Key -> Key -> Bool #

(>=) :: Key -> Key -> Bool #

max :: Key -> Key -> Key #

min :: Key -> Key -> Key #

Show Key Source # 

Methods

showsPrec :: Int -> Key -> ShowS #

show :: Key -> String #

showList :: [Key] -> ShowS #

IsString Key Source # 

Methods

fromString :: String -> Key #

data Server Source #

Instances

Eq Server Source # 

Methods

(==) :: Server -> Server -> Bool #

(/=) :: Server -> Server -> Bool #

Show Server Source # 
Generic Server Source # 

Associated Types

type Rep Server :: * -> * #

Methods

from :: Server -> Rep Server x #

to :: Rep Server x -> Server #

type Rep Server Source # 
type Rep Server = D1 (MetaData "Server" "Database.InfluxDB.Types" "influxdb-1.2.0-96yZUpcTNLGHGFnpYgIEZO" False) (C1 (MetaCons "Server" PrefixI True) ((:*:) (S1 (MetaSel (Just Symbol "_host") NoSourceUnpackedness SourceStrict DecidedStrict) (Rec0 Text)) ((:*:) (S1 (MetaSel (Just Symbol "_port") NoSourceUnpackedness SourceStrict DecidedStrict) (Rec0 Int)) (S1 (MetaSel (Just Symbol "_ssl") NoSourceUnpackedness SourceStrict DecidedStrict) (Rec0 Bool)))))

host :: Lens' Server Text Source #

Host name of the server

port :: Lens' Server Int Source #

Port number of the server

ssl :: Lens' Server Bool Source #

If SSL is enabled

defaultServer :: Server Source #

Default server settings.

Default parameters:

data Credentials Source #

User credentials

credentials Source #

Arguments

:: Text

User name

-> Text

Password

-> Credentials 

user :: Lens' Credentials Text Source #

User name to access InfluxDB.

>>> let creds = credentials "john" "passw0rd"
>>> creds ^. user
"john"

password :: Lens' Credentials Text Source #

Password to access InfluxDB

Exception

data InfluxException Source #

Exceptions used in this library.

In general, the library tries to convert exceptions from the dependent libraries to the following types of errors.

Constructors

ServerError String

Server side error.

You can expect to get a successful response once the issue is resolved on the server side.

ClientError String Request

Client side error.

You need to fix your query to get a successful response.

UnexpectedResponse String ByteString

Received an unexpected response. The String field is a message and the 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 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 checkResponse is overridden to throw an HttpException on an unsuccessful HTTP code, this exception is thrown instead of ClientError or ServerError.

class HasServer a where Source #

Minimal complete definition

server

Methods

server :: Lens' a Server Source #

InfluxDB server address and port that to interact with.

Instances

HasServer PingParams Source #
>>> pingParams ^. server.host
"localhost"
HasServer WriteParams Source #
>>> let p = writeParams "foo"
>>> p ^. server.host
"localhost"
HasServer QueryParams Source #
>>> let p = queryParams "foo"
>>> p ^. server.host
"localhost"

class HasDatabase a where Source #

Minimal complete definition

database

Methods

database :: Lens' a Database Source #

Database name to work on.

Instances

HasDatabase WriteParams Source #
>>> let p = writeParams "foo"
>>> p ^. database
"foo"
HasDatabase QueryParams Source #
>>> let p = queryParams "foo"
>>> p ^. database
"foo"
HasDatabase ShowQuery Source #
> v <- query (queryParams "_internal") "SHOW QUERIES" :: IO (V.Vector ShowQuery)
> v ^.. each.database
["_internal"]

class HasPrecision ty a | a -> ty where Source #

Minimal complete definition

precision

Methods

precision :: Lens' a (Precision ty) Source #

Time precision parameter.

Instances

HasPrecision QueryRequest QueryParams Source #

Returning JSON responses contain timestamps in the specified precision/format.

>>> let p = queryParams "foo"
>>> p ^. precision
RFC3339
HasPrecision WriteRequest WriteParams Source #

Timestamp precision.

In the UDP API, all timestamps are sent in nanosecond but you can specify lower precision. The writer just rounds timestamps to the specified precision.

HasPrecision WriteRequest WriteParams Source #
>>> let p = writeParams "foo"
>>> p ^. precision
Nanosecond

class HasManager a where Source #

Minimal complete definition

manager

Methods

manager :: Lens' a (Either ManagerSettings Manager) Source #

HTTP manager settings or a manager itself.

If it's set to ManagerSettings, the library will create a Manager from the settings for you.

Instances

HasManager PingParams Source #
>>> let p = pingParams & manager .~ Left HC.defaultManagerSettings
HasManager WriteParams Source #
>>> let p = writeParams "foo" & manager .~ Left HC.defaultManagerSettings
HasManager QueryParams Source #
>>> let p = queryParams "foo" & manager .~ Left HC.defaultManagerSettings