influxdb 0.6.0 → 0.7.0

raw patch · 6 files changed

+234/−57 lines, 6 filesdep +ghc-primPVP ok

version bump matches the API change (PVP)

Dependencies added: ghc-prim

API changes (from Hackage documentation)

Files

• CHANGELOG.md +8/−0
• influxdb.cabal +6/−2
• src/Database/InfluxDB.hs +10/−5
• src/Database/InfluxDB/Http.hs +103/−30
• src/Database/InfluxDB/Types.hs +26/−16
• tests/test-suite.hs +81/−4

@@ -1,3 +1,11 @@+## v0.7.0 - 2014-09-12++* Support for influxdb v0.8 (#15)+    * Add shard spaces API+    * Add `configureDatabase`+* Add Typeable and Generic instances where missing+* Remove unused `ScheduledDelete` type+ ## v0.6.0 - 2014-08-19  * Support for retry-0.5 (#16)

@@ -1,5 +1,5 @@ name: influxdb-version: 0.6.0+version: 0.7.0 synopsis: Haskell client library for InfluxDB description: Haskell client library for InfluxDB homepage: https://github.com/maoe/influxdb-haskell@@ -102,6 +102,10 @@     build-depends:       network < 2.6 +  if impl(ghc < 7.6)+    build-depends:+      ghc-prim+   hs-source-dirs: src   default-language: Haskell2010 @@ -149,5 +153,5 @@  source-repository this   type: git-  tag: v0.6.0+  tag: v0.7.0   location: https://github.com/maoe/influxdb-haskell.git

@@ -29,6 +29,7 @@   , User(..)   , Admin(..)   , Ping(..)+  , ShardSpace(..)    -- *** Exception   , InfluxException(..)@@ -43,12 +44,7 @@   , writePoints    -- *** Deleting Points-  -- **** One Time Deletes   , deleteSeries-  -- **** Regularly Scheduled Deletes (not implemented)-  -- , getScheduledDeletes-  -- , addScheduledDelete-  -- , removeScheduledDelete    -- ** Querying Data   , query@@ -61,7 +57,16 @@   , createDatabase   , dropDatabase +  , DatabaseRequest(..)+  , configureDatabase+   -- *** Security+  -- **** Shard spaces+  , ShardSpaceRequest(..)+  , listShardSpaces+  , createShardSpace+  , dropShardSpace+   -- **** Cluster admin   , listClusterAdmins   , authenticateClusterAdmin

@@ -4,6 +4,7 @@ {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TemplateHaskell #-} module Database.InfluxDB.Http   ( Config(..)   , Credentials(..), rootCreds@@ -20,12 +21,7 @@   , writePoints    -- ** Deleting Points-  -- *** One Time Deletes   , deleteSeries-  -- *** Regularly Scheduled Deletes (not implemented)-  -- , getScheduledDeletes-  -- , addScheduledDelete-  -- , removeScheduledDelete    -- * Querying Data   , query@@ -38,7 +34,16 @@   , createDatabase   , dropDatabase +  , DatabaseRequest(..)+  , configureDatabase+   -- ** Security+  -- *** Shard spaces+  , ShardSpaceRequest(..)+  , listShardSpaces+  , createShardSpace+  , dropShardSpace+   -- *** Cluster admin   , listClusterAdmins   , authenticateClusterAdmin@@ -68,16 +73,18 @@ import Data.Proxy import Data.Text (Text) import Data.Vector (Vector)+import Data.Word (Word32) import Network.URI (escapeURIString, isAllowedInURI)-import Text.Printf (printf) import qualified Data.ByteString as BS import qualified Data.ByteString.Char8 as BS8 import qualified Data.ByteString.Lazy as BL import qualified Data.DList as DL import qualified Data.Text as T+import Text.Printf (printf)  import Control.Retry import Data.Aeson ((.=))+import Data.Aeson.TH (deriveToJSON) import Data.Default.Class (Default(def)) import qualified Data.Aeson as A import qualified Data.Aeson.Encode as AE@@ -90,6 +97,7 @@ import Database.InfluxDB.Decode import Database.InfluxDB.Encode import Database.InfluxDB.Types+import Database.InfluxDB.Types.Internal (stripPrefixOptions) import Database.InfluxDB.Stream (Stream(..)) import qualified Database.InfluxDB.Stream as S @@ -259,30 +267,6 @@       }     Credentials {..} = configCreds config --- TODO: Delete API hasn't been implemented in InfluxDB yet------ getScheduledDeletes---   :: Config---   -> HC.Manager---   -> IO [ScheduledDelete]--- getScheduledDeletes = do---   error "getScheduledDeletes: not implemented"------ addScheduledDelete---   :: Config---   -> HC.Manager---   -> IO ScheduledDelete--- addScheduledDelete =---   error "addScheduledDeletes: not implemented"------ removeScheduledDelete---   :: Config---   -> HC.Manager---   -> ScheduledDeletes---   -> IO ()--- removeScheduledDelete =---   error "removeScheduledDelete: not implemented"- ----------------------------------------------------------- -- Querying Data @@ -404,6 +388,89 @@       }     Credentials {..} = configCreds config ++data DatabaseRequest = DatabaseRequest+  { databaseRequestSpaces :: [ShardSpaceRequest]+  , databaseRequestContinuousQueries :: [Text]+  } deriving Show++configureDatabase+  :: Config+  -> Text -- ^ Database name+  -> DatabaseRequest+  -> IO ()+configureDatabase config databaseName databaseRequest =+  runRequest_ config request+  where+    request = def+      { HC.method = "POST"+      , HC.requestBody = HC.RequestBodyLBS $ AE.encode databaseRequest+      , HC.path = escapeString $ printf "/cluster/database_configs/%s"+          (T.unpack databaseName)+      , HC.queryString = escapeString $ printf "u=%s&p=%s"+          (T.unpack credsUser)+          (T.unpack credsPassword)+      }+    Credentials {..} = configCreds config++-- | List shard spaces.+listShardSpaces :: Config -> IO [ShardSpace]+listShardSpaces config = runRequest config request+  where+    request = def+      { HC.path = "/cluster/shard_spaces"+      , HC.queryString = escapeString $ printf "u=%s&p=%s"+          (T.unpack credsUser)+          (T.unpack credsPassword)+      }+    Credentials {..} = configCreds config++data ShardSpaceRequest = ShardSpaceRequest+  { shardSpaceRequestName :: Text+  , shardSpaceRequestRegex :: Text+  , shardSpaceRequestRetentionPolicy :: Text+  , shardSpaceRequestShardDuration :: Text+  , shardSpaceRequestReplicationFactor :: Word32+  , shardSpaceRequestSplit :: Word32+  } deriving Show++-- | Create a shard space.+createShardSpace+  :: Config+  -> Text -- ^ Database+  -> ShardSpaceRequest+  -> IO ()+createShardSpace config databaseName shardSpace = runRequest_ config request+  where+    request = def+      { HC.method = "POST"+      , HC.requestBody = HC.RequestBodyLBS $ AE.encode shardSpace+      , HC.path = escapeString $ printf "/cluster/shard_spaces/%s"+          (T.unpack databaseName)+      , HC.queryString = escapeString $ printf "u=%s&p=%s"+          (T.unpack credsUser)+          (T.unpack credsPassword)+      }+    Credentials {..} = configCreds config++dropShardSpace+  :: Config+  -> Text -- ^ Database name+  -> Text -- ^ Shard space name+  -> IO ()+dropShardSpace config databaseName shardSpaceName = runRequest_ config request+  where+    request = def+      { HC.method = "DELETE"+      , HC.path = escapeString $ printf "/cluster/shard_spaces/%s/%s"+          (T.unpack databaseName)+          (T.unpack shardSpaceName)+      , HC.queryString = escapeString $ printf "u=%s&p=%s"+          (T.unpack credsUser)+          (T.unpack credsPassword)+      }+    Credentials {..} = configCreds config+ -- | List cluster administrators. listClusterAdmins :: Config -> IO [Admin] listClusterAdmins config = runRequest config request@@ -721,3 +788,9 @@ runRequest_ :: Config -> HC.Request -> IO () runRequest_ Config {..} req =   void $ httpLbsWithRetry configServerPool req configHttpManager++-----------------------------------------------------------+-- Aeson instances++deriveToJSON (stripPrefixOptions "shardSpaceRequest") ''ShardSpaceRequest+deriveToJSON (stripPrefixOptions "databaseRequest") ''DatabaseRequest

@@ -1,5 +1,6 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RecordWildCards #-}@@ -17,11 +18,11 @@   , Credentials(..)   , Server(..)   , Database(..)-  , ScheduledDelete(..)   , User(..)   , Admin(..)   , Ping(..)   , Interface+  , ShardSpace(..)    -- * Server pool   , ServerPool@@ -42,12 +43,14 @@ import Control.Applicative (empty) import Control.Exception (Exception, throwIO) import Data.Data (Data)-import Data.IORef import Data.Int (Int64)+import Data.IORef import Data.Sequence (Seq, ViewL(..), (|>)) import Data.Text (Text) import Data.Typeable (Typeable) import Data.Vector (Vector)+import Data.Word (Word32)+import GHC.Generics (Generic) import qualified Data.Sequence as Seq  import Data.Aeson ((.=), (.:))@@ -92,7 +95,7 @@   -- ^ Series name   , seriesData :: {-# UNPACK #-} !SeriesData   -- ^ Columns and data points in the series-  }+  } deriving (Typeable, Generic)  -- | Convenient accessor for columns. seriesColumns :: Series -> Vector Column@@ -129,7 +132,7 @@ data SeriesData = SeriesData   { seriesDataColumns :: Vector Column   , seriesDataPoints :: [Vector Value]-  } deriving (Eq, Show)+  } deriving (Eq, Show, Typeable, Generic)  type Column = Text @@ -140,7 +143,7 @@   | String !Text   | Bool !Bool   | Null-  deriving (Eq, Show, Data, Typeable)+  deriving (Eq, Show, Data, Typeable, Generic)  instance A.ToJSON Value where   toJSON (Int n) = A.toJSON n@@ -188,7 +191,7 @@ data Credentials = Credentials   { credsUser :: !Text   , credsPassword :: !Text-  } deriving Show+  } deriving (Show, Typeable, Generic)  -- | Server location. data Server = Server@@ -197,7 +200,7 @@   , serverPort :: !Int   , serverSsl :: !Bool   -- ^ SSL is enabled or not in the server side-  } deriving Show+  } deriving (Show, Typeable, Generic)  -- | Non-empty set of server locations. The active server will always be used -- until any HTTP communications fail.@@ -207,7 +210,7 @@   , serverBackup :: !(Seq Server)   -- ^ The rest of the servers in the pool.   , serverRetryPolicy :: !RetryPolicy-  }+  } deriving (Typeable, Generic)  {-# DEPRECATED serverRetrySettings "Use serverRetryPolicy instead" #-} serverRetrySettings :: ServerPool -> RetryPolicy@@ -219,29 +222,35 @@  newtype Database = Database   { databaseName :: Text-  } deriving Show--newtype ScheduledDelete = ScheduledDelete-  { scheduledDeleteId :: Int-  } deriving Show+  } deriving (Show, Typeable, Generic)  -- | User data User = User   { userName :: Text   , userIsAdmin :: Bool-  } deriving Show+  } deriving (Show, Typeable, Generic)  -- | Administrator newtype Admin = Admin   { adminName :: Text-  } deriving Show+  } deriving (Show, Typeable, Generic)  newtype Ping = Ping   { pingStatus :: Text-  } deriving Show+  } deriving (Show, Typeable, Generic)  type Interface = Text +data ShardSpace = ShardSpace+  { shardSpaceDatabase :: Maybe Text+  , shardSpaceName :: Text+  , shardSpaceRegex :: Text+  , shardSpaceRetentionPolicy :: Text+  , shardSpaceShardDuration :: Text+  , shardSpaceReplicationFactor :: Word32+  , shardSpaceSplit :: Word32+  } deriving (Show, Typeable, Generic)+ ----------------------------------------------------------- -- Server pool manipulation @@ -320,3 +329,4 @@ deriveFromJSON (stripPrefixOptions "admin") ''Admin deriveFromJSON (stripPrefixOptions "user") ''User deriveFromJSON (stripPrefixOptions "ping") ''Ping+deriveFromJSON (stripPrefixOptions "shardSpace") ''ShardSpace

@@ -146,8 +146,8 @@ case_query_nonexistent_series = runTest $ \config ->   withTestDatabase config $ \database -> do     name <- liftIO newName-    ss <- query config database $ "select * from " <> name-    ss @?= ([] :: [SeriesData])+    assertStatusCodeException+      (query config database $ "select * from " <> name :: IO [SeriesData])  case_query_empty_series :: Assertion case_query_empty_series = runTest $ \config ->@@ -198,8 +198,8 @@       [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])+    assertStatusCodeException+      (query config database $ "select value from " <> name :: IO [SeriesData])  case_listDatabases :: Assertion case_listDatabases = runTest $ \config ->@@ -208,6 +208,72 @@     assertBool ("No such database: " ++ T.unpack name) $       any ((name ==) . databaseName) databases +case_configureDatabase :: Assertion+case_configureDatabase = runTest $ \config -> do+  dbName <- newName+  do+    configureDatabase config dbName $ DatabaseRequest shardSpaces contQueries+    listDatabases config >>= \databases ->+      assertBool ("No such database: " ++ T.unpack dbName) $+        any ((dbName ==) . databaseName) databases+    listShardSpaces config >>= \spaces ->+        assertBool "Missing shard space(s)" $+          any ((`elem` spaceNames) . shardSpaceName) spaces+    `finally`+      dropDatabase config dbName+  where+    spaceNames = map shardSpaceRequestName shardSpaces+    shardSpaces =+      [ ShardSpaceRequest+          { shardSpaceRequestName = "everything_30d"+          , shardSpaceRequestRetentionPolicy = "30d"+          , shardSpaceRequestShardDuration = "7d"+          , shardSpaceRequestRegex = "/.*/"+          , shardSpaceRequestReplicationFactor = 1+          , shardSpaceRequestSplit = 1+          }+      , ShardSpaceRequest+          { shardSpaceRequestName = "forever"+          , shardSpaceRequestRetentionPolicy = "inf"+          , shardSpaceRequestShardDuration = "7d"+          , shardSpaceRequestRegex = "/^_.*/"+          , shardSpaceRequestReplicationFactor = 1+          , shardSpaceRequestSplit = 1+          }+      , ShardSpaceRequest+          { shardSpaceRequestName = "rollups"+          , shardSpaceRequestRetentionPolicy = "365d"+          , shardSpaceRequestShardDuration = "30d"+          , shardSpaceRequestRegex = "/^\\d+.*/"+          , shardSpaceRequestReplicationFactor = 1+          , shardSpaceRequestSplit = 1+          }+      ]+    contQueries =+      [ "select * from events into events.[id]"+      , "select count(value) from events group by time(5m) into 5m.count.events"+      ]++case_shardSpaces :: Assertion+case_shardSpaces = runTest $ \config ->+  withTestDatabase config $ \name -> do+    spaceName <- newName+    createShardSpace config name $ ShardSpaceRequest+      { shardSpaceRequestName = spaceName+      , shardSpaceRequestRegex = "^[a-z].*"+      , shardSpaceRequestRetentionPolicy = "7d"+      , shardSpaceRequestShardDuration = "1d"+      , shardSpaceRequestReplicationFactor = 1+      , shardSpaceRequestSplit = 1+      }+    listShardSpaces config >>= \spaces ->+      assertBool ("No such shard space: " ++ T.unpack spaceName) $+        any ((spaceName ==) . shardSpaceName) spaces+    dropShardSpace config name spaceName+    listShardSpaces config >>= \spaces ->+      assertBool ("Found a dropped shard space: " ++ T.unpack spaceName) $+        all ((spaceName /=) . shardSpaceName) spaces+ case_create_then_drop_database :: Assertion case_create_then_drop_database = runTest $ \config -> do   name <- newName@@ -262,6 +328,7 @@   listDatabases newConfig >>= \databases ->     assertBool ("Found a dropped database: " ++ T.unpack name') $       all ((name' /=) . databaseName) databases+  deleteClusterAdmin config admin  case_add_then_delete_database_users :: Assertion case_add_then_delete_database_users = runTest $ \config ->@@ -398,6 +465,16 @@  catchAll :: IO a -> (SomeException -> IO a) -> IO a catchAll = E.catch++assertStatusCodeException :: Show a => IO a -> IO ()+assertStatusCodeException io = do+  r <- try io+  case r of+    Left e -> case fromException e of+      Just HC.StatusCodeException {} -> return ()+      _ ->+        assertFailure $ "Expect a StatusCodeException, but got " ++ show e+    Right ss -> assertFailure $ "Expect an exception, but got " ++ show ss  -------------------------------------------------