influxdb 0.2.1.1 → 0.2.2

raw patch · 6 files changed

+131/−26 lines, 6 filesdep +exceptionsdep ~retryPVP ok

version bump matches the API change (PVP)

Dependencies added: exceptions

Dependency ranges changed: retry

API changes (from Hackage documentation)

Files

• CHANGELOG.md +6/−0
• influxdb.cabal +35/−7
• src/Database/InfluxDB.hs +4/−2
• src/Database/InfluxDB/Http.hs +58/−11
• src/Database/InfluxDB/Types.hs +1/−1
• tests/test-suite.hs +27/−5

@@ -1,3 +1,9 @@+## v0.2.2 - 2014-05-08++* Support for retry-0.4+* Add deleteSeries+* Add authenticateClusterAdmin and authenticateDatabaseUser+ ## v0.2.1.1 - 2014-04-22  * Bug fix: Treat as integer if base10Exponent is positive

@@ -1,5 +1,5 @@ name: influxdb-version: 0.2.1.1+version: 0.2.2 synopsis: Haskell client library for InfluxDB description: Haskell client library for InfluxDB homepage: https://github.com/maoe/influxdb-haskell@@ -21,10 +21,16 @@   default: False   manual: True -flag aeson070-  default: False+flag aeson-070+  description: Use aeson >= 0.7.0+  default: True   manual: False +flag retry-040+  description: Use retry >= 0.4, which depends on exceptions+  default: True+  manual: False+ library   exposed-modules:     Database.InfluxDB@@ -39,6 +45,21 @@     Database.InfluxDB.TH   other-modules:     Database.InfluxDB.Types.Internal+  other-extensions:+    BangPatterns+    CPP+    ConstraintKinds+    DeriveDataTypeable+    FlexibleInstances+    GeneralizedNewtypeDeriving+    NamedFieldPuns+    OverloadedStrings+    RankNTypes+    RecordWildCards+    ScopedTypeVariables+    TemplateHaskell+    TypeSynonymInstances+    ViewPatterns   ghc-options: -Wall   build-depends:       base >= 4 && < 4.8@@ -48,17 +69,15 @@     , data-default-class     , dlist     , http-client-    , lifted-base     , mtl     , network-    , retry     , tagged     , template-haskell     , text     , time     , vector -  if flag(aeson070)+  if flag(aeson-070)     build-depends:         aeson >= 0.7.0       , scientific >= 0.2@@ -66,6 +85,15 @@     build-depends:         aeson >= 0.6.1.0 && < 0.7.0 +  if flag(retry-040)+    build-depends:+        exceptions == 0.5.*+      , retry >= 0.4+  else+    build-depends:+        lifted-base+      , retry < 0.4+   hs-source-dirs: src   default-language: Haskell2010 @@ -113,5 +141,5 @@  source-repository this   type: git-  tag: v0.2.1.1+  tag: v0.2.2   location: https://github.com/maoe/influxdb-haskell.git

@@ -38,8 +38,8 @@   , writePoints    -- *** Deleting Points-  -- **** One Time Deletes (not implemented)-  -- , deleteSeries+  -- **** One Time Deletes+  , deleteSeries   -- **** Regularly Scheduled Deletes (not implemented)   -- , getScheduledDeletes   -- , addScheduledDelete@@ -59,11 +59,13 @@   -- *** Security   -- **** Cluster admin   , listClusterAdmins+  , authenticateClusterAdmin   , addClusterAdmin   , updateClusterAdminPassword   , deleteClusterAdmin   -- **** Database user   , listDatabaseUsers+  , authenticateDatabaseUser   , addDatabaseUser   , updateDatabaseUserPassword   , deleteDatabaseUser

@@ -1,3 +1,4 @@+{-# LANGUAGE CPP #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE OverloadedStrings #-}@@ -19,8 +20,8 @@   , writePoints    -- ** Deleting Points-  -- *** One Time Deletes (not implemented)-  -- , deleteSeries+  -- *** One Time Deletes+  , deleteSeries   -- *** Regularly Scheduled Deletes (not implemented)   -- , getScheduledDeletes   -- , addScheduledDelete@@ -40,11 +41,13 @@   -- ** Security   -- *** Cluster admin   , listClusterAdmins+  , authenticateClusterAdmin   , addClusterAdmin   , updateClusterAdminPassword   , deleteClusterAdmin   -- *** Database user   , listDatabaseUsers+  , authenticateDatabaseUser   , addDatabaseUser   , updateDatabaseUserPassword   , deleteDatabaseUser@@ -68,7 +71,6 @@ import qualified Data.DList as DL import qualified Data.Text as T -import Control.Exception.Lifted (Handler(..)) import Control.Retry import Data.Aeson ((.=)) import Data.Default.Class (Default(def))@@ -83,6 +85,12 @@ import Database.InfluxDB.Stream (Stream(..)) import qualified Database.InfluxDB.Stream as S +#if MIN_VERSION_retry(0, 4, 0)+import Control.Monad.Catch (Handler(..))+#else+import Control.Exception.Lifted (Handler(..))+#endif+ -- | Configurations for HTTP API client. data Config = Config   { configCreds :: !Credentials@@ -225,16 +233,27 @@   -> PointT a m () writePoints = tell . DL.singleton . toSeriesPoints +deleteSeries+  :: Config+  -> Text -- ^ Database name+  -> Text -- ^ Series name+  -> IO ()+deleteSeries Config {..} databaseName seriesName =+  void $ httpLbsWithRetry configServerPool makeRequest configHttpManager+  where+    makeRequest = def+      { HC.method = "DELETE"+      , HC.path = escapeString $ printf "/db/%s/series/%s"+          (T.unpack databaseName)+          (T.unpack seriesName)+      , HC.queryString = escapeString $ printf "u=%s&p=%s"+          (T.unpack credsUser)+          (T.unpack credsPassword)+      }+    Credentials {..} = configCreds+ -- TODO: Delete API hasn't been implemented in InfluxDB yet ----- deleteSeries---   :: Config---   -> HC.Manager---   -> Series---   -> IO ()--- deleteSeries Config {..} manager =---   error "deleteSeries: not implemented"--- -- getScheduledDeletes --   :: Config --   -> HC.Manager@@ -402,6 +421,18 @@       }     Credentials {..} = configCreds +authenticateClusterAdmin :: Config -> IO ()+authenticateClusterAdmin Config {..} =+  void $ httpLbsWithRetry configServerPool makeRequest configHttpManager+  where+    makeRequest = def+      { HC.path = "/cluster_admins/authenticate"+      , HC.queryString = escapeString $ printf "u=%s&p=%s"+          (T.unpack credsUser)+          (T.unpack credsPassword)+      }+    Credentials {..} = configCreds+ -- | Add a new cluster administrator. Requires cluster admin privilege. addClusterAdmin   :: Config@@ -483,6 +514,22 @@   where     makeRequest = def       { HC.path = escapeString $ printf "/db/%s/users"+          (T.unpack database)+      , HC.queryString = escapeString $ printf "u=%s&p=%s"+          (T.unpack credsUser)+          (T.unpack credsPassword)+      }+    Credentials {..} = configCreds++authenticateDatabaseUser+  :: Config+  -> Text -- ^ Database name+  -> IO ()+authenticateDatabaseUser Config {..} database =+  void $ httpLbsWithRetry configServerPool makeRequest configHttpManager+  where+    makeRequest = def+      { HC.path = escapeString $ printf "/db/%s/authenticate"           (T.unpack database)       , HC.queryString = escapeString $ printf "u=%s&p=%s"           (T.unpack credsUser)

@@ -109,7 +109,7 @@ data SeriesData = SeriesData   { seriesDataColumns :: Vector Column   , seriesDataPoints :: [Vector Value]-  } deriving Show+  } deriving (Eq, Show)  type Column = Text 

@@ -100,7 +100,7 @@       writeSeries name $ Val 42     ss <- query config database $ "select value from " <> name     case ss of-      [series] -> fromSeriesData series @=? Right [Val 42]+      [series] -> fromSeriesData series @?= Right [Val 42]       _ -> assertFailure $ "Expect one series, but got: " ++ show ss  case_post_multi_series :: Assertion@@ -113,7 +113,7 @@       writeSeries name $ Val 42     ss <- query config database $ "select value from " <> name     case ss of-      [series] -> fromSeriesData series @=? Right [Val 42, Val 42, Val 42]+      [series] -> fromSeriesData series @?= Right [Val 42, Val 42, Val 42]       _ -> assertFailure $ "Expect one series, but got: " ++ show ss  case_post_multi_points :: Assertion@@ -126,7 +126,7 @@       writePoints $ Val 42     ss <- query config database $ "select value from " <> name     case ss of-      [series] -> fromSeriesData series @=? Right [Val 42, Val 42, Val 42]+      [series] -> fromSeriesData series @?= Right [Val 42, Val 42, Val 42]       _ -> assertFailure $ "Expect one series, but got: " ++ show ss  case_queryChunked :: Assertion@@ -139,7 +139,7 @@       writePoints $ Val 42     ss <- queryChunked config database ("select value from " <> name) $       S.fold step []-    mapM fromSeriesData ss @=? Right [[Val 42], [Val 42], [Val 42]]+    mapM fromSeriesData ss @?= Right [[Val 42], [Val 42], [Val 42]]   where     step xs series = case fromSeriesData series of       Left reason -> throwIO $ HUnitFailure reason@@ -153,9 +153,23 @@       writeSeries name $ Val 42     ss <- query config database $ "select value from " <> name     case ss of-      [series] -> fromSeriesData series @=? Right [Val 42]+      [series] -> fromSeriesData series @?= Right [Val 42]       _ -> assertFailure $ "Expect one series, but got: " ++ show ss +case_delete_series :: Assertion+case_delete_series = runTest $ \config ->+  withTestDatabase config $ \database -> do+    name <- liftIO newName+    post config database $+      writeSeries name $ Val 42+    ss <- query config database $ "select value from " <> name+    case ss of+      [series] -> fromSeriesData series @?= Right [Val 42]+      _ -> assertFailure $ "Expect one series, but got: " ++ show ss+    deleteSeries config database name+    ss' <- query config database $ "select value from " <> name+    ss' @=? ([] :: [SeriesData])+ case_listDatabases :: Assertion case_listDatabases = runTest $ \config ->   withTestDatabase config $ \name -> do@@ -182,6 +196,9 @@   assertBool "No root admin" $     any (("root" ==) . adminUsername) admins +case_authenticate_cluster_admin :: Assertion+case_authenticate_cluster_admin = runTest authenticateClusterAdmin+ case_add_then_delete_cluster_admin :: Assertion case_add_then_delete_cluster_admin = runTest $ \config -> do   name <- newName@@ -222,6 +239,11 @@       assertBool "There shouldn't be any users" $ null users     newUserName <- newName     addDatabaseUser config name newUserName "somePassword"+    let newCreds = rootCreds+          { credsUser = newUserName+          , credsPassword = "somePassword" }+        newConfig = config { configCreds = newCreds }+    authenticateDatabaseUser newConfig name     listDatabaseUsers config name >>= \users ->       assertBool ("No such user: " <> T.unpack newUserName) $         any ((newUserName ==) . userName) users