diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,5 +1,20 @@ # Revision history for influxdb +## v1.8.0 - 2020-06-19 + +This release reworked the `QueryResuls` type class. There are some breaking changes: + +* `parseResults` has been deprecated. `QueryResults` has now `parseMeasurement` method. +* `Decoder` has been monomorphized so that it can be used with lens. The original `Decoder` type has been renamed to `SomeDecoder`. +* `QueryParams` has now `decoder` field. +* `parseResults` and `parseResultsWith` had been using `lenientDecoder` and it caused some unintuitive behavior ([#64](https://github.com/maoe/influxdb-haskell/issues/64), [#66](https://github.com/maoe/influxdb-haskell/issues/66)). Now they use `strictDecoder` instead. +* `parseErrorObject` now doesn't fail. It returns the error message of a response. +* `parseQueryField` which has been deprecated is now deleted. +* `QueryResults` instance for `ShowSeries` was broken. This is fixed. +* The constructor of `Decoder`, `parseResultsWith`, and `parseResultsWithDecoder` have been hidden from the top-level module. They're still available from `Database.InfluxDB.JSON`. + +See [#68](https://github.com/maoe/influxdb-haskell/pull/68/files) for how to migrate your code from v1.7.x to v1.8.x. + ## v1.7.1.6 - 2020-06-03 * Relax upper version bound for doctest diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -6,7 +6,7 @@ [![Hackage CI](https://matrix.hackage.haskell.org/api/v2/packages/influxdb/badge)](https://matrix.hackage.haskell.org/package/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 is tested against InfluxDB 1.7. +Currently this library is tested against InfluxDB 1.8. ## Getting started diff --git a/examples/random-points.hs b/examples/random-points.hs --- a/examples/random-points.hs +++ b/examples/random-points.hs @@ -2,7 +2,6 @@ {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE ScopedTypeVariables #-} -{-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TypeSynonymInstances #-} {-# LANGUAGE ViewPatterns #-} import Data.Foldable @@ -76,7 +75,7 @@ } deriving Show instance QueryResults Row where - parseResults prec = parseResultsWith $ \_ _ columns fields -> do + parseMeasurement prec _ _ columns fields = do rowTime <- getField "time" columns fields >>= parsePOSIXTime prec String name <- getField "value" columns fields rowValue <- case name of diff --git a/influxdb.cabal b/influxdb.cabal --- a/influxdb.cabal +++ b/influxdb.cabal @@ -1,6 +1,6 @@ cabal-version: 1.24 name: influxdb -version: 1.7.1.6 +version: 1.8.0 synopsis: Haskell client library for InfluxDB description: @influxdb@ is an InfluxDB client library for Haskell. @@ -115,10 +115,12 @@ base , containers , influxdb + , lens , tasty , tasty-hunit , time , raw-strings-qq >= 1.1 && < 1.2 + , vector ghc-options: -Wall -threaded hs-source-dirs: tests default-language: Haskell2010 diff --git a/src/Database/InfluxDB.hs b/src/Database/InfluxDB.hs --- a/src/Database/InfluxDB.hs +++ b/src/Database/InfluxDB.hs @@ -45,12 +45,11 @@ , QueryParams , queryParams , authentication + , decoder -- ** Parsing results , QueryResults(..) - , parseResultsWith - , parseResultsWithDecoder - , Decoder(..) + , Decoder , lenientDecoder , strictDecoder , getField @@ -58,7 +57,6 @@ , parseJSON , parseUTCTime , parsePOSIXTime - , parseQueryField -- *** Re-exports from tagged , Tagged(..) @@ -200,7 +198,7 @@ , cpuIdle, cpuSystem, cpuUser :: Double } deriving Show instance QueryResults CPUUsage where - parseResults prec = parseResultsWithDecoder strictDecoder $ \_ _ columns fields -> do + parseMeasurement prec _name _tags columns fields = do time <- getField "time" columns fields >>= parseUTCTime prec cpuIdle <- getField "idle" columns fields >>= parseJSON cpuSystem <- getField "system" columns fields >>= parseJSON diff --git a/src/Database/InfluxDB/JSON.hs b/src/Database/InfluxDB/JSON.hs --- a/src/Database/InfluxDB/JSON.hs +++ b/src/Database/InfluxDB/JSON.hs @@ -3,6 +3,7 @@ {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE RankNTypes #-} {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE ViewPatterns #-} module Database.InfluxDB.JSON @@ -12,6 +13,7 @@ -- ** Decoder settings , Decoder(..) + , SomeDecoder(..) , strictDecoder , lenientDecoder @@ -24,7 +26,6 @@ , parseUTCTime , parsePOSIXTime , parseRFC3339 - , parseQueryField -- ** Utility functions , parseResultsObject , parseSeriesObject @@ -34,8 +35,10 @@ import Control.Applicative import Control.Exception import Control.Monad -import qualified Control.Monad.Fail as Fail +import Data.Foldable import Data.Maybe +import Prelude +import qualified Control.Monad.Fail as Fail import Data.Aeson import Data.HashMap.Strict (HashMap) @@ -52,43 +55,51 @@ import Database.InfluxDB.Types --- | Parse a JSON response with the 'lenientDecoder'. This can be useful to --- implement the 'Database.InfluxDB.Query.parseResults' method. +-- | Parse a JSON response with the 'strictDecoder'. parseResultsWith :: (Maybe Text -> HashMap Text Text -> Vector Text -> Array -> A.Parser a) - -- ^ A parser that takes + -- ^ A parser that parses a measurement. A measurement consists of -- -- 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 + -- 3. an array of field keys + -- 4. an array of field values + -> Value -- ^ JSON response -> A.Parser (Vector a) -parseResultsWith = parseResultsWithDecoder lenientDecoder +parseResultsWith = parseResultsWithDecoder strictDecoder -- | Parse a JSON response with the specified decoder settings. parseResultsWithDecoder - :: Decoder a + :: Decoder -> (Maybe Text -> HashMap Text Text -> Vector Text -> Array -> A.Parser a) - -- ^ A parser that takes + -- ^ A parser that parses a measurement. A measurement consists of -- -- 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 + -- 3. an array of field keys + -- 4. an array of field values + -> Value -- ^ JSON response -> A.Parser (Vector a) -parseResultsWithDecoder Decoder {..} row val0 = success +parseResultsWithDecoder (Decoder SomeDecoder {..}) row val0 = do + r <- foldr1 (<|>) + [ Left <$> parseErrorObject val0 + , Right <$> success + ] + case r of + Left err -> fail err + Right vec -> return vec where success = do results <- parseResultsObject val0 - (join -> series) <- V.forM results $ \val -> - parseSeriesObject val <|> parseErrorObject val + (join -> series) <- V.forM results $ \val -> do + r <- foldr1 (<|>) + [ Left <$> parseErrorObject val + , Right <$> parseSeriesObject val + ] + case r of + Left err -> fail err + Right vec -> return vec values <- V.forM series $ \val -> do (name, tags, columns, values) <- parseSeriesBody val decodeFold $ V.forM values $ A.withArray "values" $ \fields -> do @@ -96,25 +107,48 @@ decodeEach $ row name tags columns fields return $! join values --- | Decoder settings -data Decoder a = forall b. Decoder +-- | A decoder to use when parsing a JSON response. +-- +-- Use 'strictDecoder' if you want to fail the entire decoding process if +-- there's any failure. Use 'lenientDecoder' if you want the decoding process +-- to collect only successful results. +newtype Decoder = Decoder (forall a. SomeDecoder a) + +-- | @'SomeDecoder' a@ represents how to decode a JSON response given a row +-- parser of type @'A.Parser' a@. +data SomeDecoder a = forall b. SomeDecoder { decodeEach :: A.Parser a -> A.Parser b - -- ^ How to decode each row. For example 'optional' can be used to turn parse + -- ^ How to decode each row. + -- + -- For example 'optional' can be used to turn parse -- failrues into 'Nothing's. , decodeFold :: A.Parser (Vector b) -> A.Parser (Vector a) -- ^ How to aggregate rows into the resulting vector. + -- + -- For example when @b ~ 'Maybe' a@, one way to aggregate the values is to + -- return only 'Just's. } -- | A decoder that fails immediately if there's any parse failure. -strictDecoder :: Decoder a -strictDecoder = Decoder +-- +-- 'strictDecoder' is defined as follows: +-- +-- @ +-- strictDecoder :: Decoder +-- strictDecoder = Decoder $ SomeDecoder +-- { decodeEach = id +-- , decodeFold = id +-- } +-- @ +strictDecoder :: Decoder +strictDecoder = Decoder $ SomeDecoder { decodeEach = id , decodeFold = id } -- | A decoder that ignores parse failures and returns only successful results. -lenientDecoder :: Decoder a -lenientDecoder = Decoder +lenientDecoder :: Decoder +lenientDecoder = Decoder $ SomeDecoder { decodeEach = optional , decodeFold = \p -> do bs <- p @@ -166,10 +200,8 @@ 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 +parseErrorObject :: A.Value -> A.Parser String +parseErrorObject = A.withObject "error" $ \obj -> obj .: "error" -- | Parse either a POSIX timestamp or RFC3339 formatted timestamp as 'UTCTime'. parseUTCTime :: Precision ty -> A.Value -> A.Parser UTCTime @@ -207,20 +239,3 @@ fmt, err :: String fmt = "%FT%X%QZ" err = "RFC3339-formatted timestamp" - --- | 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 -> - return $! FieldString txt - A.Bool b -> - return $! FieldBool b - A.Null -> - return FieldNull - _ -> fail $ "parseQueryField: expected a flat data structure, but got " - ++ show val -{-# DEPRECATED parseQueryField - "This function parses numbers in a misleading way. Use 'parseJSON' instead." - #-} diff --git a/src/Database/InfluxDB/Manage.hs b/src/Database/InfluxDB/Manage.hs --- a/src/Database/InfluxDB/Manage.hs +++ b/src/Database/InfluxDB/Manage.hs @@ -1,6 +1,8 @@ +{-# LANGUAGE BangPatterns #-} {-# LANGUAGE CPP #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE TypeApplications #-} {-# LANGUAGE ViewPatterns #-} {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE ScopedTypeVariables #-} @@ -33,7 +35,6 @@ , ShowSeries , key ) where -import Control.Applicative import Control.Exception import Control.Monad @@ -74,19 +75,20 @@ case eitherDecode' body of Left message -> throwIO $ UnexpectedResponse message request body - Right val -> case A.parse (parseResults (params^.precision)) val of - A.Success (_ :: V.Vector Void) -> return () - A.Error message -> do - let status = HC.responseStatus response - when (HT.statusIsServerError status) $ - throwIO $ ServerError message - when (HT.statusIsClientError status) $ - throwIO $ ClientError message request - throwIO $ UnexpectedResponse - ("BUG: " ++ message ++ " in Database.InfluxDB.Manage.manage") - request - (encode val) - + Right val -> do + let parser = parseQueryResultsWith (params^.decoder) (params^.precision) + case A.parse parser val of + A.Success (_ :: V.Vector Void) -> return () + A.Error message -> do + let status = HC.responseStatus response + when (HT.statusIsServerError status) $ + throwIO $ ServerError message + when (HT.statusIsClientError status) $ + throwIO $ ClientError message request + throwIO $ UnexpectedResponse + ("BUG: " ++ message ++ " in Database.InfluxDB.Manage.manage") + request + (encode val) where request = HC.setQueryString qs $ manageRequest params qs = @@ -114,29 +116,26 @@ } instance QueryResults ShowQuery where - parseResults _ = parseResultsWith $ \_ _ columns fields -> + parseMeasurement _ _ _ columns fields = maybe (fail "parseResults: parse error") return $ do Number (toBoundedInteger -> Just showQueryQid) <- - V.elemIndex "qid" columns >>= V.indexM fields + getField "qid" columns fields String (F.formatQuery F.text -> showQueryText) <- - V.elemIndex "query" columns >>= V.indexM fields + getField "query" columns fields String (F.formatDatabase F.text -> showQueryDatabase) <- - V.elemIndex "database" columns >>= V.indexM fields + getField "database" columns fields String (parseDuration -> Right showQueryDuration) <- - V.elemIndex "duration" columns >>= V.indexM fields + getField "duration" columns fields return ShowQuery {..} parseDuration :: Text -> Either String NominalDiffTime -parseDuration = AT.parseOnly $ sum <$!> durations +parseDuration = AT.parseOnly duration where - durations = some $ (*) - <$> fmap fromIntegral int + duration = (*) + <$> fmap (fromIntegral @Int) AT.decimal <*> unit - where - int :: AT.Parser Int - int = AT.decimal unit = AC.choice - [ 10^^(-6 :: Int) <$ AT.char 'u' + [ 10^^(-6 :: Int) <$ AT.string "µs" , 1 <$ AT.char 's' , 60 <$ AT.char 'm' , 3600 <$ AT.char 'h' @@ -147,7 +146,7 @@ } instance QueryResults ShowSeries where - parseResults _ = parseResultsWith $ \_ _ columns fields -> do + parseMeasurement _ _ _ columns fields = do name <- getField "key" columns fields >>= parseJSON return $ ShowSeries $ F.formatKey F.text name diff --git a/src/Database/InfluxDB/Query.hs b/src/Database/InfluxDB/Query.hs --- a/src/Database/InfluxDB/Query.hs +++ b/src/Database/InfluxDB/Query.hs @@ -6,6 +6,7 @@ {-# LANGUAGE LambdaCase #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE RankNTypes #-} {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TemplateHaskell #-} @@ -24,10 +25,13 @@ , database , precision , manager + , authentication + , decoder -- * Parsing results , QueryResults(..) - , parseResultsWith + , parseQueryResults + , parseQueryResultsWith -- * Low-level functions , withQueryResponse @@ -45,8 +49,10 @@ import Control.Lens import Data.Aeson +import Data.HashMap.Strict (HashMap) import Data.Optional (Optional(..), optional) import Data.Tagged +import Data.Text (Text) import Data.Vector (Vector) import Data.Void import qualified Control.Foldl as L @@ -58,7 +64,6 @@ 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 @@ -70,6 +75,7 @@ -- >>> :set -XOverloadedStrings -- >>> :set -XRecordWildCards -- >>> import Data.Time (UTCTime) +-- >>> import qualified Data.Vector as V -- | Types that can be converted from an JSON object returned by InfluxDB. -- @@ -85,7 +91,7 @@ -- , waterLevel :: Double -- } -- instance QueryResults H2OFeet where --- parseResults prec = parseResultsWith $ \_ _ columns fields -> do +-- parseMeasurement prec _name _tags columns fields = do -- time <- getField "time" columns fields >>= parseUTCTime prec -- levelDesc <- getField "level_description" columns fields >>= parseJSON -- location <- getField "location" columns fields >>= parseJSON @@ -98,10 +104,46 @@ :: Precision 'QueryRequest -> Value -> A.Parser (Vector a) + parseResults = parseQueryResultsWith strictDecoder + -- | Parse a measurement in a JSON object. + parseMeasurement + :: Precision 'QueryRequest + -- ^ Timestamp precision + -> Maybe Text + -- ^ Optional series name + -> HashMap Text Text + -- ^ Tag set + -> Vector Text + -- ^ Field keys + -> Array + -- ^ Field values + -> A.Parser a + +{-# DEPRECATED parseResults + "Use 'parseQueryResults' or 'parseQueryResultsWith' " #-} + +-- | Parse a JSON object as an array of values of expected type. +parseQueryResults + :: QueryResults a + => Precision 'QueryRequest + -> Value + -> A.Parser (Vector a) +parseQueryResults = parseQueryResultsWith strictDecoder + +parseQueryResultsWith + :: QueryResults a + => Decoder + -> Precision 'QueryRequest + -> Value + -> A.Parser (Vector a) +parseQueryResultsWith decoder prec = + parseResultsWithDecoder decoder (parseMeasurement prec) + +-- | 'QueryResults' instance for empty results. Used by +-- 'Database.InfluxDB.Manage.manage'. instance QueryResults Void where - parseResults _ = A.withObject "error" $ \obj -> obj .:? "error" - >>= maybe (pure V.empty) (withText "error" $ fail . T.unpack) + parseMeasurement _ _ _ _ _ = parseJSON A.emptyArray fieldName :: KnownSymbol k => proxy k -> T.Text fieldName = T.pack . symbolVal @@ -113,7 +155,7 @@ -- >>> find ((== "_internal") . untag) dbs -- Just (Tagged "_internal") instance (KnownSymbol k, FromJSON v) => QueryResults (Tagged k v) where - parseResults _ = parseResultsWith $ \_ _ columns fields -> + parseMeasurement _ _name _ columns fields = getField (fieldName (Proxy :: Proxy k)) columns fields >>= parseJSON -- | One-off tuple for sigle-field measurements @@ -121,7 +163,7 @@ ( KnownSymbol k1, FromJSON v1 , KnownSymbol k2, FromJSON v2 ) => QueryResults (Tagged k1 v1, Tagged k2 v2) where - parseResults _ = parseResultsWith $ \_ _ columns fields -> do + parseMeasurement _ _ _ columns fields = do v1 <- parseJSON =<< getField (fieldName (Proxy :: Proxy k1)) columns fields v2 <- parseJSON @@ -134,7 +176,7 @@ , KnownSymbol k2, FromJSON v2 , KnownSymbol k3, FromJSON v3 ) => QueryResults (Tagged k1 v1, Tagged k2 v2, Tagged k3 v3) where - parseResults _ = parseResultsWith $ \_ _ columns fields -> do + parseMeasurement _ _ _ columns fields = do v1 <- parseJSON =<< getField (fieldName (Proxy :: Proxy k1)) columns fields v2 <- parseJSON @@ -150,7 +192,7 @@ , KnownSymbol k3, FromJSON v3 , KnownSymbol k4, FromJSON v4 ) => QueryResults (Tagged k1 v1, Tagged k2 v2, Tagged k3 v3, Tagged k4 v4) where - parseResults _ = parseResultsWith $ \_ _ columns fields -> do + parseMeasurement _ _ _ columns fields = do v1 <- parseJSON =<< getField (fieldName (Proxy :: Proxy k1)) columns fields v2 <- parseJSON @@ -172,7 +214,7 @@ ( Tagged k1 v1, Tagged k2 v2, Tagged k3 v3, Tagged k4 v4 , Tagged k5 v5 ) where - parseResults _ = parseResultsWith $ \_ _ columns fields -> do + parseMeasurement _ _ _ columns fields = do v1 <- parseJSON =<< getField (fieldName (Proxy :: Proxy k1)) columns fields v2 <- parseJSON @@ -197,7 +239,7 @@ ( Tagged k1 v1, Tagged k2 v2, Tagged k3 v3, Tagged k4 v4 , Tagged k5 v5, Tagged k6 v6 ) where - parseResults _ = parseResultsWith $ \_ _ columns fields -> do + parseMeasurement _ _ _ columns fields = do v1 <- parseJSON =<< getField (fieldName (Proxy :: Proxy k1)) columns fields v2 <- parseJSON @@ -225,7 +267,7 @@ ( Tagged k1 v1, Tagged k2 v2, Tagged k3 v3, Tagged k4 v4 , Tagged k5 v5, Tagged k6 v6, Tagged k7 v7 ) where - parseResults _ = parseResultsWith $ \_ _ columns fields -> do + parseMeasurement _ _ _ columns fields = do v1 <- parseJSON =<< getField (fieldName (Proxy :: Proxy k1)) columns fields v2 <- parseJSON @@ -256,7 +298,7 @@ ( Tagged k1 v1, Tagged k2 v2, Tagged k3 v3, Tagged k4 v4 , Tagged k5 v5, Tagged k6 v6, Tagged k7 v7, Tagged k8 v8 ) where - parseResults _ = parseResultsWith $ \_ _ columns fields -> do + parseMeasurement _ _ _ columns fields = do v1 <- parseJSON =<< getField (fieldName (Proxy :: Proxy k1)) columns fields v2 <- parseJSON @@ -282,8 +324,9 @@ -- * 'server' -- * 'database' -- * 'precision' --- * 'authentication' -- * 'manager' +-- * 'authentication' +-- * 'decoder' data QueryParams = QueryParams { queryServer :: !Server , queryDatabase :: !Database @@ -295,6 +338,9 @@ -- ^ No authentication by default , queryManager :: !(Either HC.ManagerSettings HC.Manager) -- ^ HTTP connection manager + , queryDecoder :: Decoder + -- ^ Decoder settings to configure how to parse a JSON resposne given a row + -- parser } -- | Smart constructor for 'QueryParams' @@ -305,12 +351,14 @@ -- ['precision'] 'RFC3339' -- ['authentication'] 'Nothing' -- ['manager'] @'Left' 'HC.defaultManagerSettings'@ +-- ['decoder'] @'strictDecoder'@ queryParams :: Database -> QueryParams queryParams queryDatabase = QueryParams { queryServer = defaultServer , queryPrecision = RFC3339 , queryAuthentication = Nothing , queryManager = Left HC.defaultManagerSettings + , queryDecoder = strictDecoder , .. } @@ -328,9 +376,13 @@ let body = BL.fromChunks chunks case eitherDecode' body of Left message -> throwIO $ UnexpectedResponse message request body - Right val -> case A.parse (parseResults (queryPrecision params)) val of - A.Success vec -> return vec - A.Error message -> errorQuery message request response val + Right val -> do + let parser = parseQueryResultsWith + (queryDecoder params) + (queryPrecision params) + case A.parse parser val of + A.Success vec -> return vec + A.Error message -> errorQuery message request response val setPrecision :: Precision 'QueryRequest @@ -506,3 +558,11 @@ -- "john" instance HasCredentials QueryParams where authentication = _authentication + +-- | Decoder settings +-- +-- >>> let p = queryParams "foo" +-- >>> let _ = p & decoder .~ strictDecoder +-- >>> let _ = p & decoder .~ lenientDecoder +decoder :: Lens' QueryParams Decoder +decoder = _decoder diff --git a/tests/regressions.hs b/tests/regressions.hs --- a/tests/regressions.hs +++ b/tests/regressions.hs @@ -1,34 +1,79 @@ +{-# LANGUAGE DataKinds #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE QuasiQuotes #-} -import Data.Time.Clock (UTCTime) +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TemplateHaskell #-} +import Control.Exception (bracket_, try) + +import Control.Lens +import Data.Time import Test.Tasty import Test.Tasty.HUnit -import Text.RawString.QQ (r) import qualified Data.Map as M +import qualified Data.Map.Strict as Map +import qualified Data.Vector as V +import qualified Text.RawString.QQ as Raw (r) import Database.InfluxDB import Database.InfluxDB.Line import qualified Database.InfluxDB.Format as F main :: IO () -main = defaultMain tests - -tests :: TestTree -tests = testGroup "regression tests" - [ issue75 +main = defaultMain $ testGroup "regression tests" + [ testCase "issue #64" case_issue64 + , testCase "issue #66" case_issue66 + , testCaseSteps "issue #75" case_issue75 ] --- https://github.com/maoe/influxdb-haskell/issues/75 +-- https://github.com/maoe/influxdb-haskell/issues/64 +case_issue64 :: Assertion +case_issue64 = withDatabase dbName $ do + write wp $ Line "count" Map.empty + (Map.fromList [("value", FieldInt 1)]) + (Nothing :: Maybe UTCTime) + r <- try $ query qp "SELECT value FROM count" + case r of + Left err -> case err of + UnexpectedResponse message _ _ -> + message @?= + "BUG: parsing Int failed, expected Number, but encountered String in Database.InfluxDB.Query.query" + _ -> + assertFailure $ got ++ show err + Right (v :: (V.Vector (Tagged "time" Int, Tagged "value" Int))) -> + -- NOTE: The time columns should be UTCTime, Text, or String + assertFailure $ got ++ "no errors: " ++ show v + where + dbName = "case_issue64" + qp = queryParams dbName & precision .~ RFC3339 + wp = writeParams dbName + got = "expeted an UnexpectedResponse but got " -issue75 :: TestTree -issue75 = testCaseSteps "issue #75" $ \step -> do +-- https://github.com/maoe/influxdb-haskell/issues/66 +case_issue66 :: Assertion +case_issue66 = do + r <- try $ query (queryParams "_internal") "SELECT time FROM dummy" + case r of + Left err -> case err of + UnexpectedResponse message _ _ -> + message @?= + "BUG: at least 1 non-time field must be queried in Database.InfluxDB.Query.query" + _ -> + assertFailure $ got ++ show err + Right (v :: V.Vector (Tagged "time" Int)) -> + assertFailure $ got ++ "no errors: " ++ show v + where + got = "expected an UnexpectedResponse but got " + +-- https://github.com/maoe/influxdb-haskell/issues/75 +case_issue75 :: (String -> IO ()) -> Assertion +case_issue75 step = do step "Checking encoded value" - let string = [r|bl\"a|] + let string = [Raw.r|bl\"a|] let encoded = encodeLine (scaleTo Nanosecond) $ Line "testing" mempty (M.singleton "test" $ FieldString string) (Nothing :: Maybe UTCTime) - encoded @?= [r|testing test="bl\\\"a"|] + encoded @?= [Raw.r|testing test="bl\\\"a"|] step "Preparing a test database" let db = "issue75" @@ -39,3 +84,11 @@ step "Checking server response" let wp = writeParams db writeByteString wp encoded + +withDatabase :: Database -> IO a -> IO a +withDatabase dbName f = bracket_ + (manage q (formatQuery ("CREATE DATABASE "%F.database) dbName)) + (manage q (formatQuery ("DROP DATABASE "%F.database) dbName)) + f + where + q = queryParams dbName