summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--CHANGELOG.md12
-rw-r--r--README.md2
-rw-r--r--Setup.hs31
-rw-r--r--examples/random-points.hs2
-rw-r--r--influxdb.cabal32
-rw-r--r--src/Database/InfluxDB.hs12
-rw-r--r--src/Database/InfluxDB/Format.hs56
-rw-r--r--src/Database/InfluxDB/Line.hs37
-rw-r--r--src/Database/InfluxDB/Types.hs32
-rw-r--r--src/Database/InfluxDB/Write.hs4
-rw-r--r--tests/doctests.hs7
11 files changed, 184 insertions, 43 deletions
diff --git a/CHANGELOG.md b/CHANGELOG.md
index 010a1a2..28c68dc 100644
--- a/CHANGELOG.md
+++ b/CHANGELOG.md
@@ -1,6 +1,16 @@
+# Revision history for influxdb
+
+## v1.3.0 - 2018-03-05
+
+* Relax upper version bound for base ([#51](https://github.com/maoe/influxdb-haskell/pull/51))
+* Implement proper escaping and quoting for special characters ([#51](https://github.com/maoe/influxdb-haskell/pull/51), [#52](https://github.com/maoe/influxdb-haskell/pull/52))
+ * Introduce the Measurement type and accompanying functions
+* Fix a bug in the HTTP writer where the precision parameter is ignored when constructing requests
+* Some minor doctest fixes
+
## v1.2.2.3 - 2018-01-30
-* Relax upper version bounds for http-types and tasty-hunit
+* Relax upper version bounds for http-types, lens and time
## v1.2.2.2 - 2017-11-30
diff --git a/README.md b/README.md
index 0bcc902..50591bc 100644
--- a/README.md
+++ b/README.md
@@ -5,7 +5,7 @@ Haskell client library for InfluxDB
[![Hackage-Deps](https://img.shields.io/hackage-deps/v/influxdb.svg)](http://packdeps.haskellers.com/feed?needle=influxdb)
[![Gitter](https://badges.gitter.im/maoe/influxdb-haskell.svg)](https://gitter.im/maoe/influxdb-haskell?utm_source=badge&utm_medium=badge&utm_campaign=pr-badge)
-Currently this library supports InfluxDB 1.2.
+Currently this library is tested against InfluxDB 1.4.
Contact information
----------
diff --git a/Setup.hs b/Setup.hs
index 9a994af..8ec54a0 100644
--- a/Setup.hs
+++ b/Setup.hs
@@ -1,2 +1,33 @@
+{-# LANGUAGE CPP #-}
+{-# OPTIONS_GHC -Wall #-}
+module Main (main) where
+
+#ifndef MIN_VERSION_cabal_doctest
+#define MIN_VERSION_cabal_doctest(x,y,z) 0
+#endif
+
+#if MIN_VERSION_cabal_doctest(1,0,0)
+
+import Distribution.Extra.Doctest ( defaultMainWithDoctests )
+main :: IO ()
+main = defaultMainWithDoctests "doctests"
+
+#else
+
+#ifdef MIN_VERSION_Cabal
+-- If the macro is defined, we have new cabal-install,
+-- but for some reason we don't have cabal-doctest in package-db
+--
+-- Probably we are running cabal sdist, when otherwise using new-build
+-- workflow
+#warning You are configuring this package without cabal-doctest installed. \
+ The doctests test-suite will not work as a result. \
+ To fix this, install cabal-doctest before configuring.
+#endif
+
import Distribution.Simple
+
+main :: IO ()
main = defaultMain
+
+#endif
diff --git a/examples/random-points.hs b/examples/random-points.hs
index 1e97e48..f2287aa 100644
--- a/examples/random-points.hs
+++ b/examples/random-points.hs
@@ -61,7 +61,7 @@ main = do
(Map.fromList [("value", nameToFVal value)])
(Just time)
- queryChunked qparams Default (F.formatQuery ("SELECT * FROM "%F.key) ct1) $
+ queryChunked qparams Default (F.formatQuery ("SELECT * FROM "%F.measurement) ct1) $
L.mapM_ $ traverse_ $ \Row {..} ->
printf "%s:\t%s\n"
(show $ posixSecondsToUTCTime rowTime)
diff --git a/influxdb.cabal b/influxdb.cabal
index 2252749..9040a1e 100644
--- a/influxdb.cabal
+++ b/influxdb.cabal
@@ -1,5 +1,5 @@
name: influxdb
-version: 1.2.2.3
+version: 1.3.0
synopsis: Haskell client library for InfluxDB
description:
@influxdb@ is a Haskell client library for InfluxDB.
@@ -12,9 +12,14 @@ author: Mitsutoshi Aoe
maintainer: Mitsutoshi Aoe <maoe@foldr.in>
copyright: Copyright (C) 2014-2018 Mitsutoshi Aoe
category: Database
-build-type: Simple
-cabal-version: >= 1.10
+build-type: Custom
+cabal-version: >= 1.24
tested-with: GHC >= 7.10 && < 8.1
+tested-with:
+ GHC == 7.10.3
+ GHC == 8.0.2
+ GHC == 8.2.2
+ GHC == 8.4.1
extra-source-files:
README.md
@@ -25,6 +30,12 @@ flag examples
default: False
manual: True
+custom-setup
+ setup-depends:
+ base >= 4 && < 5
+ , Cabal >= 1.24
+ , cabal-doctest >= 1 && < 1.1
+
library
exposed-modules:
Database.InfluxDB
@@ -60,7 +71,7 @@ library
ViewPatterns
ghc-options: -Wall
build-depends:
- base >= 4.8 && < 4.11
+ base >= 4.8 && < 4.12
, aeson >= 0.7 && < 1.3
, attoparsec < 0.14
, bytestring >= 0.10 && < 0.11
@@ -98,6 +109,19 @@ test-suite test-suite
hs-source-dirs: tests
default-language: Haskell2010
+test-suite doctests
+ type: exitcode-stdio-1.0
+ main-is: doctests.hs
+ build-depends:
+ base
+ , doctest >= 0.11.3 && < 0.14
+ , QuickCheck ==2.10.*
+ , influxdb
+ , template-haskell
+ ghc-options: -Wall -threaded
+ hs-source-dirs: tests
+ default-language: Haskell2010
+
executable influx-random-points
if !flag(examples)
buildable: False
diff --git a/src/Database/InfluxDB.hs b/src/Database/InfluxDB.hs
index 87f14b4..29df47b 100644
--- a/src/Database/InfluxDB.hs
+++ b/src/Database/InfluxDB.hs
@@ -63,6 +63,8 @@ module Database.InfluxDB
, Precision(..)
, Database
, F.formatDatabase
+ , Measurement
+ , F.formatMeasurement
, Key
, F.formatKey
@@ -125,6 +127,7 @@ Also note that in order to construct a 'Query', we use 'formatQuery' with the
>>> let db = "square_holes"
>>> let bubba = credentials "bubba" "bumblebeetuna"
>>> let p = queryParams db & authentication ?~ bubba
+>>> manage p $ formatQuery ("DROP DATABASE "%F.database) db
>>> manage p $ formatQuery ("CREATE DATABASE "%F.database) db
== Writing data
@@ -142,7 +145,9 @@ writeBatch wp
, ("system", FieldFloat 53.3)
, ("user", FieldFloat 46.6)
])
- (Nothing :: Maybe UTCTime)
+ (Just $ parseTimeOrError False defaultTimeLocale
+ "%F %T%Q %Z"
+ "2017-06-17 15:41:40.42659044 UTC") :: Line UTCTime
]
:}
@@ -168,8 +173,9 @@ instance QueryResults CPUUsage where
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}]
+
+>>> query p $ formatQuery ("SELECT * FROM "%F.measurement) cpuUsage :: IO (V.Vector CPUUsage)
+[CPUUsage {time = 2017-06-17 15:41:40 UTC, cpuIdle = 10.1, cpuSystem = 53.3, cpuUser = 46.6}]
Note that the type signature on query here is also necessary to type check.
-}
diff --git a/src/Database/InfluxDB/Format.hs b/src/Database/InfluxDB/Format.hs
index d8a5dba..ea8efc8 100644
--- a/src/Database/InfluxDB/Format.hs
+++ b/src/Database/InfluxDB/Format.hs
@@ -10,12 +10,15 @@ module Database.InfluxDB.Format
-- * Formatting functions
, formatQuery
, formatDatabase
+ , formatMeasurement
, formatKey
-- * Formatters for various types
, database
, key
, keys
+ , measurement
+ , measurements
, field
, decimal
, realFloat
@@ -97,6 +100,9 @@ instance a ~ r => IsString (Format a r) where
(%) :: Format b c -> Format a b -> Format a c
(%) = (.)
+runFormatWith :: (T.Text -> a) -> Format a r -> r
+runFormatWith f fmt = runFormat fmt (f . TL.toStrict . TL.toLazyText)
+
-- | Format a 'Query'.
--
-- >>> formatQuery "SELECT * FROM series"
@@ -104,14 +110,21 @@ instance a ~ r => IsString (Format a r) where
-- >>> formatQuery ("SELECT * FROM "%key) "series"
-- "SELECT * FROM \"series\""
formatQuery :: Format Query r -> r
-formatQuery fmt = runFormat fmt (Query . TL.toStrict . TL.toLazyText)
+formatQuery = runFormatWith Query
-- | Format a 'Database'.
--
-- >>> formatDatabase "test-db"
-- "test-db"
formatDatabase :: Format Database r -> r
-formatDatabase fmt = runFormat fmt (Database . TL.toStrict . TL.toLazyText)
+formatDatabase = runFormatWith Database
+
+-- | Format a 'Measurement'.
+--
+-- >>> formatMeasurement "test-series"
+-- "test-series"
+formatMeasurement :: Format Measurement r -> r
+formatMeasurement = runFormatWith Measurement
-- | Format a 'Key'.
--
@@ -124,20 +137,23 @@ formatKey fmt = runFormat fmt (Key . TL.toStrict . TL.toLazyText)
makeFormat :: (a -> TL.Builder) -> Format r (a -> r)
makeFormat build = Format $ \k a -> k $ build a
+doubleQuote :: T.Text -> TL.Builder
+doubleQuote name = "\"" <> TL.fromText name <> "\""
+
+singleQuote :: T.Text -> TL.Builder
+singleQuote name = "'" <> TL.fromText name <> "'"
+
-- | 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 <> "\""
+database = makeFormat $ \(Database name) -> doubleQuote name
--- | Format a key (e.g. series names, field names etc).
+-- | Format a key (e.g. field names, tag names, tag values etc).
--
--- >>> formatQuery ("SELECT * FROM "%key) "test-series"
--- "SELECT * FROM \"test-series\""
+-- >>> formatQuery ("SELECT "%key%" FROM series") "field"
+-- "SELECT \"field\" FROM series"
key :: Format r (Key -> r)
key = makeFormat keyBuilder
@@ -148,6 +164,26 @@ key = makeFormat keyBuilder
keys :: Format r ([Key] -> r)
keys = makeFormat $ mconcat . L.intersperse "," . map keyBuilder
+keyBuilder :: Key -> TL.Builder
+keyBuilder (Key name) = doubleQuote name
+
+-- | Format a measurement.
+--
+-- >>> formatQuery ("SELECT * FROM "%measurement) "test-series"
+-- "SELECT * FROM \"test-series\""
+measurement :: Format r (Measurement -> r)
+measurement = makeFormat measurementBuilder
+
+-- | Format a measurement.
+--
+-- >>> formatQuery ("SELECT * FROM "%measurements) ["series1", "series2"]
+-- "SELECT * FROM \"series1\",\"series2\""
+measurements :: Format r ([Measurement] -> r)
+measurements = makeFormat $ mconcat . L.intersperse "," . map measurementBuilder
+
+measurementBuilder :: Measurement -> TL.Builder
+measurementBuilder (Measurement name) = doubleQuote name
+
-- | Format 'QueryField'.
--
-- >>> formatQuery ("SELECT * FROM series WHERE "%key%" = "%field) "location" "tokyo"
@@ -156,7 +192,7 @@ field :: Format r (QueryField -> r)
field = makeFormat $ \case
FieldInt n -> TL.decimal n
FieldFloat d -> TL.realFloat d
- FieldString s -> "'" <> TL.fromText s <> "'"
+ FieldString s -> singleQuote s
FieldBool b -> if b then "true" else "false"
FieldNull -> "null"
diff --git a/src/Database/InfluxDB/Line.hs b/src/Database/InfluxDB/Line.hs
index afd3708..8a743b5 100644
--- a/src/Database/InfluxDB/Line.hs
+++ b/src/Database/InfluxDB/Line.hs
@@ -15,6 +15,10 @@ module Database.InfluxDB.Line
, buildLines
, encodeLine
, encodeLines
+
+ , LineField
+ , Field(..)
+ , Precision(..)
) where
import Data.List (intersperse)
import Data.Int (Int64)
@@ -36,9 +40,9 @@ import Database.InfluxDB.Types
-- See https://docs.influxdata.com/influxdb/v1.2/write_protocols/line_protocol_tutorial/ for the
-- concrete syntax.
data Line time = Line
- { _measurement :: !Key
+ { _measurement :: !Measurement
-- ^ Measurement name
- , _tagSet :: !(Map Key Text)
+ , _tagSet :: !(Map Key Key)
-- ^ Set of tags (optional)
, _fieldSet :: !(Map Key LineField)
-- ^ Set of fields
@@ -68,8 +72,8 @@ buildLine
buildLine toTimestamp Line {..} =
key <> " " <> fields <> maybe "" (" " <>) timestamp
where
- measurement = buildKey _measurement
- tags = buildMap TE.encodeUtf8Builder _tagSet
+ measurement = TE.encodeUtf8Builder $ escapeMeasurement _measurement
+ tags = buildMap (TE.encodeUtf8Builder . escapeKey) _tagSet
key = if Map.null _tagSet
then measurement
else measurement <> "," <> tags
@@ -79,22 +83,31 @@ buildLine toTimestamp Line {..} =
mconcat . intersperse "," . map encodeKeyVal . Map.toList
where
encodeKeyVal (name, val) = mconcat
- [ buildKey name
+ [ TE.encodeUtf8Builder $ escapeKey name
, "="
, encodeVal val
]
-buildKey :: Key -> B.Builder
-buildKey = TE.encodeUtf8Builder . escapeKey
-
escapeKey :: Key -> Text
-escapeKey (Key text) = T.replace " " "\\ " $ T.replace "," "\\," text
+escapeKey (Key text) = escapeCommas $ escapeEqualSigns $ escapeSpaces text
+
+escapeMeasurement :: Measurement -> Text
+escapeMeasurement (Measurement text) = escapeCommas $ escapeSpaces text
+
+escapeStringField :: Text -> Text
+escapeStringField = escapeDoubleQuotes
+
+escapeCommas, escapeEqualSigns, escapeSpaces, escapeDoubleQuotes :: Text -> Text
+escapeCommas = T.replace "," "\\,"
+escapeEqualSigns = T.replace "=" "\\="
+escapeSpaces = T.replace " " "\\ "
+escapeDoubleQuotes = T.replace "\"" "\\\""
buildFieldValue :: LineField -> B.Builder
buildFieldValue = \case
FieldInt i -> B.int64Dec i <> "i"
FieldFloat d -> B.doubleDec d
- FieldString t -> "\"" <> TE.encodeUtf8Builder t <> "\""
+ FieldString t -> "\"" <> TE.encodeUtf8Builder (escapeStringField t) <> "\""
FieldBool b -> if b then "true" else "false"
buildLines
@@ -107,11 +120,11 @@ buildLines toTimestamp = foldMap ((<> "\n") . buildLine toTimestamp)
makeLensesWith (lensRules & generateSignatures .~ False) ''Line
-- | Name of the measurement that you want to write your data to.
-measurement :: Lens' (Line time) Key
+measurement :: Lens' (Line time) Measurement
-- | Tag(s) that you want to include with your data point. Tags are optional in
-- the Line Protocol, so you can set it 'empty'.
-tagSet :: Lens' (Line time) (Map Key Text)
+tagSet :: Lens' (Line time) (Map Key Key)
-- | Field(s) for your data point. Every data point requires at least one field
-- in the Line Protocol, so it shouldn't be 'empty'.
diff --git a/src/Database/InfluxDB/Types.hs b/src/Database/InfluxDB/Types.hs
index aa8b60c..f0666c5 100644
--- a/src/Database/InfluxDB/Types.hs
+++ b/src/Database/InfluxDB/Types.hs
@@ -115,28 +115,40 @@ password :: Lens' Credentials Text
-- 'Database'.
newtype Database = Database { databaseName :: Text } deriving (Eq, Ord)
--- | String type that is used for measurements, tag keys and field keys.
+instance IsString Database where
+ fromString xs = Database $ fromNonEmptyString "Database" xs
+
+instance Show Database where
+ show (Database name) = show name
+
+-- | String name that is used for measurements.
+--
+-- 'Database.InfluxDB.formatMeasurement' can be used to construct a
+-- 'Measurement'.
+newtype Measurement = Measurement Text deriving (Eq, Ord)
+
+instance IsString Measurement where
+ fromString xs = Measurement $ fromNonEmptyString "Measurement" xs
+
+instance Show Measurement where
+ show (Measurement name) = show name
+
+-- | String type that is used for tag keys/values and field keys.
--
-- 'Database.InfluxDB.formatKey' can be used to construct a 'Key'.
newtype Key = Key Text deriving (Eq, Ord)
-instance IsString Database where
- fromString xs = Database $ fromNonEmptyString "Database" xs
-
instance IsString Key where
fromString xs = Key $ fromNonEmptyString "Key" xs
+instance Show Key where
+ show (Key name) = show name
+
fromNonEmptyString :: String -> String -> Text
fromNonEmptyString ty xs
| null xs = error $ ty ++ " should never be empty"
| otherwise = fromString xs
-instance Show Database where
- show (Database name) = show name
-
-instance Show Key where
- show (Key name) = show name
-
data Nullability = Nullable | NonNullable deriving Typeable
-- | Field type for queries. Queries can contain null values.
diff --git a/src/Database/InfluxDB/Write.hs b/src/Database/InfluxDB/Write.hs
index 622e38d..71ad00f 100644
--- a/src/Database/InfluxDB/Write.hs
+++ b/src/Database/InfluxDB/Write.hs
@@ -173,7 +173,9 @@ writeRequest WriteParams {..} =
where
Server {..} = writeServer
qs = concat
- [ [("db", Just $ TE.encodeUtf8 $ databaseName writeDatabase)]
+ [ [ ("db", Just $ TE.encodeUtf8 $ databaseName writeDatabase)
+ , ("precision", Just $ TE.encodeUtf8 $ precisionName writePrecision)
+ ]
, fromMaybe [] $ do
Key name <- writeRetentionPolicy
return [("rp", Just (TE.encodeUtf8 name))]
diff --git a/tests/doctests.hs b/tests/doctests.hs
new file mode 100644
index 0000000..f0bd848
--- /dev/null
+++ b/tests/doctests.hs
@@ -0,0 +1,7 @@
+module Main where
+
+import Build_doctests (flags, pkgs, module_sources)
+import Test.DocTest (doctest)
+
+main :: IO ()
+main = doctest $ flags ++ pkgs ++ module_sources