summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorMitsutoshiAoe <>2014-06-05 10:59:00 (GMT)
committerhdiff <hdiff@hdiff.luite.com>2014-06-05 10:59:00 (GMT)
commit582c779c174345ecd4fc71d429ffe35376225c73 (patch)
treea6e95a9ac9f58e4e45a8be3b137c7bb582f6f7f5
parent12a8f6354d38cf7ac76fde5528afa08b362857bd (diff)
version 0.4.10.4.1
-rw-r--r--CHANGELOG.md4
-rw-r--r--examples/random-points.hs2
-rw-r--r--influxdb.cabal4
-rw-r--r--src/Database/InfluxDB/Http.hs14
-rw-r--r--src/Database/InfluxDB/Types.hs28
5 files changed, 33 insertions, 19 deletions
diff --git a/CHANGELOG.md b/CHANGELOG.md
index 09fad77..7f823ab 100644
--- a/CHANGELOG.md
+++ b/CHANGELOG.md
@@ -1,3 +1,7 @@
+## v0.4.1 - 2014-06-05
+
+* Make retry settings configurable (#5)
+
## v0.4.0 - 2014-06-05
* Remove `databaseReplicationFactor` field from `Database` type
diff --git a/examples/random-points.hs b/examples/random-points.hs
index d87e559..50a8162 100644
--- a/examples/random-points.hs
+++ b/examples/random-points.hs
@@ -67,7 +67,7 @@ main = do
newConfig :: HC.Manager -> IO Config
newConfig manager = do
- pool <- newServerPool localServer [] -- no backup servers
+ pool <- newServerPool localServer []
return Config
{ configCreds = rootCreds
, configServerPool = pool
diff --git a/influxdb.cabal b/influxdb.cabal
index a19e82a..70add2c 100644
--- a/influxdb.cabal
+++ b/influxdb.cabal
@@ -1,5 +1,5 @@
name: influxdb
-version: 0.4.0
+version: 0.4.1
synopsis: Haskell client library for InfluxDB
description: Haskell client library for InfluxDB
homepage: https://github.com/maoe/influxdb-haskell
@@ -141,5 +141,5 @@ source-repository head
source-repository this
type: git
- tag: v0.4.0
+ tag: v0.4.1
location: https://github.com/maoe/influxdb-haskell.git
diff --git a/src/Database/InfluxDB/Http.hs b/src/Database/InfluxDB/Http.hs
index 5016263..fea8581 100644
--- a/src/Database/InfluxDB/Http.hs
+++ b/src/Database/InfluxDB/Http.hs
@@ -59,7 +59,7 @@ import Control.Applicative
import Control.Monad.Identity
import Control.Monad.Writer
import Data.DList (DList)
-import Data.IORef (IORef)
+import Data.IORef
import Data.Proxy
import Data.Text (Text)
import Data.Vector (Vector)
@@ -655,8 +655,9 @@ withPool
-> HC.Request
-> (HC.Request -> IO a)
-> IO a
-withPool pool request f =
- recovering defaultRetrySettings handlers $ do
+withPool pool request f = do
+ retrySettings <- serverRetrySettings <$> readIORef pool
+ recovering retrySettings handlers $ do
server <- activeServer pool
f $ makeRequest server
where
@@ -673,13 +674,6 @@ withPool pool request f =
_ -> return False
]
-defaultRetrySettings :: RetrySettings
-defaultRetrySettings = RetrySettings
- { numRetries = limitedRetries 5
- , backoff = True
- , baseDelay = 50
- }
-
escapeText :: Text -> BS.ByteString
escapeText = escapeString . T.unpack
diff --git a/src/Database/InfluxDB/Types.hs b/src/Database/InfluxDB/Types.hs
index 84eec2a..cac94cc 100644
--- a/src/Database/InfluxDB/Types.hs
+++ b/src/Database/InfluxDB/Types.hs
@@ -23,7 +23,9 @@ module Database.InfluxDB.Types
-- * Server pool
, ServerPool
+ , serverRetrySettings
, newServerPool
+ , newServerPoolWithRetrySettings
, activeServer
, failover
) where
@@ -38,6 +40,7 @@ import Data.Typeable (Typeable)
import Data.Vector (Vector)
import qualified Data.Sequence as Seq
+import Control.Retry (RetrySettings(..), limitedRetries)
import Data.Aeson ((.=), (.:))
import Data.Aeson.TH
import qualified Data.Aeson as A
@@ -173,6 +176,7 @@ data ServerPool = ServerPool
-- ^ Current active server
, serverBackup :: !(Seq Server)
-- ^ The rest of the servers in the pool.
+ , serverRetrySettings :: !RetrySettings
}
newtype Database = Database
@@ -201,10 +205,22 @@ newtype Admin = Admin
-- | Create a non-empty server pool. You must specify at least one server
-- location to create a pool.
newServerPool :: Server -> [Server] -> IO (IORef ServerPool)
-newServerPool active backups = newIORef ServerPool
- { serverActive = active
- , serverBackup = Seq.fromList backups
- }
+newServerPool = newServerPoolWithRetrySettings defaultRetrySettings
+ where
+ defaultRetrySettings = RetrySettings
+ { numRetries = limitedRetries 5
+ , backoff = True
+ , baseDelay = 50
+ }
+
+newServerPoolWithRetrySettings
+ :: RetrySettings -> Server -> [Server] -> IO (IORef ServerPool)
+newServerPoolWithRetrySettings retrySettings active backups =
+ newIORef ServerPool
+ { serverActive = active
+ , serverBackup = Seq.fromList backups
+ , serverRetrySettings = retrySettings
+ }
-- | Get a server from the pool.
activeServer :: IORef ServerPool -> IO Server
@@ -219,9 +235,9 @@ failover :: IORef ServerPool -> IO ()
failover ref = atomicModifyIORef' ref $ \pool@ServerPool {..} ->
case Seq.viewl serverBackup of
EmptyL -> (pool, ())
- active :< rest -> (pool', ())
+ active :< rest -> (newPool, ())
where
- pool' = ServerPool
+ newPool = pool
{ serverActive = active
, serverBackup = rest |> serverActive
}