diff --git a/ChangeLog.org b/ChangeLog.org
new file mode 100644
--- /dev/null
+++ b/ChangeLog.org
@@ -0,0 +1,11 @@
+# Changelog for polling-cache
+
+* Unreleased changes
+
+* 0.0.1.0 | 2021-07-31
+** Added
+ - Initial public API
+ + 3 modes for handling polling delays
+ + 3 modes for handling polling failures
+ - Initial documentation
+ - Unit tests covering all core functionality
diff --git a/LICENSE b/LICENSE
new file mode 100644
--- /dev/null
+++ b/LICENSE
@@ -0,0 +1,30 @@
+Copyright Jordan Kaye (c) 2021
+
+All rights reserved.
+
+Redistribution and use in source and binary forms, with or without
+modification, are permitted provided that the following conditions are met:
+
+ * Redistributions of source code must retain the above copyright
+ notice, this list of conditions and the following disclaimer.
+
+ * Redistributions in binary form must reproduce the above
+ copyright notice, this list of conditions and the following
+ disclaimer in the documentation and/or other materials provided
+ with the distribution.
+
+ * Neither the name of Jordan Kaye nor the names of other
+ contributors may be used to endorse or promote products derived
+ from this software without specific prior written permission.
+
+THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
diff --git a/README.org b/README.org
new file mode 100644
--- /dev/null
+++ b/README.org
@@ -0,0 +1,54 @@
+* polling-cache
+
+ polling-cache is a Haskell library meant to facilitate low-frequency polling for reliability and performance in distributed systems.
+
+ More information about the concepts underlying the library can be found on [[https://jordankaye.dev/posts/polling-for-relability][my development blog]] (coming soon).
+
+ Detailed technical documentation for the library can be found on [[https://hackage.haskell.org/package/polling-cache][Hackage]] (coming soon).
+
+ #+html: 
+
+** Quick start guide
+
+ *IMPORTANT!* Before attempting to use this library, it's pivotal to understand your use case and whether simple polling is a reasonable solution.
+ Polling is a strategy generally suitable only for data that must be updated with a relatively low frequency, and for which
+ periodic failures to update are not catastrophic to the application. Attempting to use polling for data that is expensive to generate or
+ that must be updated frequently is a very easy way to destroy the performance of your system via self-imposed DDoS.
+
+*** Basic concepts
+
+ polling-cache works by allowing users to create ~PollingCache~ instances that automatically update themselves in the background and
+ expose their currently cached state in a thread-safe manner. The basic steps to work with the library are:
+
+ 1. Create a ~PollingCache~ by providing an action that generates values and a time span that must pass between invocations of that action
+ 2. Read values from the cache as required by your application
+ 3. Optionally, stop the cache's background operations once the data is no longer required (this invalidates the cache permanently)
+
+*** Example
+
+ While polling-cache supports arbitrary execution contexts via ~MonadCache~, nearly all end-users will want to operate in ~IO~.
+
+ Here's a simple example that you should be able to compile and run on your own that demonstrates the basic usage of the functions
+ exposed by polling-cache:
+
+ #+begin_src haskell
+
+ import Control.Concurrent
+ import Data.Cache.Polling
+
+ -- In "real" code, this generator would likely hit a database or service endpoint of some kind.
+ -- Any exception thrown from the generator is handled by the CacheResult (see API documentation for details).
+ dataGenerator :: IO String
+ dataGenerator = return "Very nice data"
+
+ main :: IO ()
+ main = do
+ -- 3600000000 microseconds = 1 hour delay between invocations of the generator, ignore failures
+ let opts = basicOptions (DelayForMicroseconds 3600000000) Ignore
+ cache <- newPollingCache opts dataGenerator
+ threadDelay 100 -- Give the runtime a bit of time to execute the action in the background
+ latestResult <- cachedValues cache
+ print latestResult
+ stopPolling cache -- Shut down and invalidate the cache
+
+ #+end_src
diff --git a/Setup.hs b/Setup.hs
new file mode 100644
--- /dev/null
+++ b/Setup.hs
@@ -0,0 +1,2 @@
+import Distribution.Simple
+main = defaultMain
diff --git a/polling-cache.cabal b/polling-cache.cabal
new file mode 100644
--- /dev/null
+++ b/polling-cache.cabal
@@ -0,0 +1,74 @@
+cabal-version: 1.12
+name: polling-cache
+version: 0.0.1.0
+license: BSD3
+license-file: LICENSE
+copyright: 2021 Jordan Kaye
+maintainer: jordan.kaye2@gmail.com
+author: Jordan Kaye
+homepage: https://github.com/jkaye2012/polling-cache#readme
+bug-reports: https://github.com/jkaye2012/polling-cache/issues
+synopsis:
+ Cache infrequently updated data for simpler distributed systems.
+
+description:
+ Cache infrequently updated data for simpler distributed systems. See for more details.
+
+category: Cache,"Distributed Computing"
+build-type: Simple
+extra-source-files:
+ README.org
+ ChangeLog.org
+
+source-repository head
+ type: git
+ location: https://github.com/jkaye2012/polling-cache
+
+library
+ exposed-modules:
+ Data.Cache
+ Data.Cache.Internal
+ Data.Cache.Polling
+
+ hs-source-dirs: src
+ other-modules: Paths_polling_cache
+ default-language: Haskell2010
+ ghc-options:
+ -Wall -Widentities -Wincomplete-record-updates
+ -Wincomplete-patterns -Wincomplete-uni-patterns -Wpartial-fields
+ -Wredundant-constraints
+
+ build-depends:
+ base >=4.14.1.0 && <4.15,
+ exceptions >=0.10.4 && <0.11,
+ random >=1.2.0 && <1.3,
+ stm >=2.5.0.0 && <2.6,
+ time >=1.9.3 && <1.10,
+ unliftio >=0.2.19 && <0.3
+
+test-suite polling-cache-test
+ type: exitcode-stdio-1.0
+ main-is: Spec.hs
+ hs-source-dirs: test
+ other-modules:
+ PollingCacheSpec
+ Paths_polling_cache
+
+ default-language: Haskell2010
+ ghc-options:
+ -Wall -Widentities -Wincomplete-record-updates
+ -Wincomplete-patterns -Wincomplete-uni-patterns -Wpartial-fields
+ -Wredundant-constraints -threaded -rtsopts -with-rtsopts=-N
+
+ build-depends:
+ base >=4.14.1.0 && <4.15,
+ exceptions >=0.10.4 && <0.11,
+ hspec >=2.7.10 && <2.8,
+ hspec-discover >=2.7.10 && <2.8,
+ mtl >=2.2.2 && <2.3,
+ polling-cache -any,
+ random >=1.2.0 && <1.3,
+ stm >=2.5.0.0 && <2.6,
+ time >=1.9.3 && <1.10,
+ transformers >=0.5.6.2 && <0.6,
+ unliftio >=0.2.19 && <0.3
diff --git a/src/Data/Cache.hs b/src/Data/Cache.hs
new file mode 100644
--- /dev/null
+++ b/src/Data/Cache.hs
@@ -0,0 +1,7 @@
+-- | Cache implementations.
+module Data.Cache
+ ( module Data.Cache.Polling,
+ )
+where
+
+import Data.Cache.Polling
diff --git a/src/Data/Cache/Internal.hs b/src/Data/Cache/Internal.hs
new file mode 100644
--- /dev/null
+++ b/src/Data/Cache/Internal.hs
@@ -0,0 +1,105 @@
+-- | Caching implementation internals.
+--
+-- This module is not part of the Data.Cache public API and should not be directly relied upon by users.
+-- Anything meant for external use defined here will be re-exported by a public module.
+module Data.Cache.Internal
+ ( MonadCache (..),
+ DelayMode (..),
+ FailureMode (..),
+ CacheOptions (..),
+ )
+where
+
+import Control.Concurrent
+import Control.Monad (forever)
+import Control.Monad.Catch
+import Control.Monad.IO.Class
+import Data.Time
+import System.Random.Stateful
+
+-- | The top-level 'Monad' in which caching operations are performed.
+--
+-- This exists primarily for testing purposes. Production uses should drop in 'IO' and forget that this exists.
+class (MonadCatch m, MonadIO m) => MonadCache m where
+ -- | The current system time.
+ currentTime :: m UTCTime
+
+ -- | Generate a random number between two bounds (inclusive).
+ randomize :: (Int, Int) -> m Int
+
+ -- | Delay execution of the current thread for a number of microseconds.
+ delay :: Int -> m ()
+
+ -- | Spawn a new thread of execution to run an action.
+ newThread :: m () -> m ThreadId
+
+ -- | Run an action forever.
+ repeatedly :: m () -> m ()
+
+ -- | Stop a thread of execution. The thread can be assumed to have been started using 'newThread'.
+ killCache :: ThreadId -> m ()
+
+instance MonadCache IO where
+ currentTime = getCurrentTime
+ randomize bounds = do
+ gen <- getStdGen >>= newIOGenM
+ uniformRM bounds gen
+ delay = threadDelay
+ newThread = forkIO
+ repeatedly = forever
+ killCache = killThread
+
+-- | The supported delay modes for a 'Data.Cache.PollingCache' instance.
+--
+-- The delay associated with a cache instance define the amount of time that will pass between
+-- cache refreshes.
+data DelayMode a
+ = -- | Delay for static number of microseconds between each refresh.
+ DelayForMicroseconds Int
+ | -- | Delay for a dynamic number of microseconds between each refresh.
+ --
+ -- This is useful if different delays should be used for successes or failures, or
+ -- if the result being retrieved contains information that could affect the delay period.
+ DelayDynamically (Either SomeException a -> Int)
+ | -- | Delay for a dynamic number of microseconds between each refresh within a set of bounds.
+ --
+ -- This is similarly useful to 'DelayDynamically', but when a known lower and upper bound should
+ -- be applied to the delay period. Regardless of the dynamic delay generated by the user-supplied
+ -- function, the delay period will never be below the lower bound or above the upper bound.
+ DelayDynamicallyWithBounds (Int, Int) (Either SomeException a -> Int)
+
+-- | The supported failure handling modes for a 'Data.Cache.PollingCache' instance.
+--
+-- In the context of the cache action, "failure" means an Exception thrown from
+-- the user-supplied action that generates values to populate the cache.
+--
+-- Because these operations are performed in a background thread, the user must decide how failures are to be handled
+-- upon cache creation.
+data FailureMode
+ = -- | Failures should be ignored entirely; the most relaxed failure handling strategy.
+ --
+ -- This means that 'Data.Cache.LoadFailed' will never be populated as a cache result.
+ Ignore
+ | -- | If a failure occurs, any previously cached value is immediately evicted from the cache; the strictest failure handling strategy.
+ EvictImmediately
+ | -- | Failures will be ignored unless they persist beyond the supplied time span.
+ --
+ -- This is a middle-ground failure handling strategy that probably makes sense to use in most scenarios.
+ -- The nature of asynchronous polling implies that somewhat stale values are not an issue to the consumer;
+ -- therefore, allowing some level of transient failure can often improve reliability without sacrificing correctness.
+ EvictAfterTime NominalDiffTime
+ deriving (Eq, Show)
+
+-- | Options that dictate the behavior of a 'Data.Cache.PollingCache' instance.
+data CacheOptions a = CacheOptions
+ { -- | The 'DelayMode' to use.
+ delayMode :: DelayMode a,
+ -- | The 'FailureMode' to use.
+ failureMode :: FailureMode,
+ -- | An optional fuzzing factor.
+ --
+ -- If provided, this factor defines the maximum number of microseconds that can be randomly added to each
+ -- delay period. This means that when fuzzing is enabled, the delay between any two refreshes will always be
+ -- greater than the delay period generated by the cache's 'DelayMode'. 'Nothing' disables fuzzing completely.
+ delayFuzzing :: Maybe Int
+ }
diff --git a/src/Data/Cache/Polling.hs b/src/Data/Cache/Polling.hs
new file mode 100644
--- /dev/null
+++ b/src/Data/Cache/Polling.hs
@@ -0,0 +1,155 @@
+{-# LANGUAGE RecordWildCards #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# OPTIONS_GHC -Wno-unused-record-wildcards #-}
+
+-- | A cache implementation that periodically (and asynchronously) polls an external action for updated values.
+module Data.Cache.Polling
+ ( -- * Entry-point types and typeclasses
+ MonadCache (..),
+ PollingCache,
+
+ -- * Types for working with cached results
+ CacheMiss (..),
+ CacheHit,
+ CacheResult,
+
+ -- * Types for cache creation
+ FailureMode (..),
+ DelayMode (..),
+ ThreadDelay,
+ CacheOptions (delayMode, failureMode, delayFuzzing),
+
+ -- * Functions for creating and interacting with caches
+ basicOptions,
+ newPollingCache,
+ cachedValues,
+ stopPolling,
+ )
+where
+
+import Control.Concurrent
+import Control.Monad (unless)
+import qualified Control.Monad.Catch as Exc
+import Data.Cache.Internal
+import Data.Functor ((<&>))
+import Data.Time.Clock
+import UnliftIO
+
+-- | The supported "empty" states for a 'PollingCache'.
+--
+-- See 'CacheResult' for a more in-depth explanation of why this is necessary.
+data CacheMiss
+ = -- | A value has never been loaded into the cache.
+ NotYetLoaded
+ | -- | The external action used to populate the cache threw an exception at some point in time.
+ LoadFailed UTCTime
+ | -- | The cache has been shut down and can no longer be used.
+ Stopped
+ deriving (Eq, Show)
+
+-- | A successfully cached value with the time at which it was generated.
+type CacheHit a = (a, UTCTime)
+
+-- | The result of reading a value from a 'PollingCache', including the possibility of failure.
+--
+-- Due to the asynchronous (and likely effectful) nature of executing external actions to populate
+-- the cache, it's possible for the cache to be "empty" at any point in time. The possible empty
+-- states are controlled by the 'FailureMode' selected by the user when creating the 'PollingCache'
+-- instance.
+type CacheResult a = Either CacheMiss (CacheHit a)
+
+type CachePayload a = TVar (CacheResult a)
+
+-- | An opaque type containing the internals necessary for background polling and caching.
+--
+-- Library functions will allow the user to create and interact with a 'PollingCache', but
+-- the raw data is not exposed to users so that the library can maintain invariants.
+data PollingCache a = PollingCache
+ { mostRecentValues :: CachePayload a,
+ threadId :: ThreadId
+ }
+
+-- | The minimum amount of time (in microseconds) that should pass before a cache reload is attempted.
+type ThreadDelay = Int
+
+isFailed :: CacheResult a -> Bool
+isFailed (Left (LoadFailed _)) = True
+isFailed _ = False
+
+writeCacheFailure :: MonadCache m => CachePayload a -> UTCTime -> m ()
+writeCacheFailure payload = atomically . writeTVar payload . Left . LoadFailed
+
+handleFailure :: MonadCache m => FailureMode -> CachePayload a -> m ()
+handleFailure Ignore _ = return ()
+handleFailure EvictImmediately payload = do
+ now <- currentTime
+ current <- readTVarIO payload
+ unless (isFailed current) $ writeCacheFailure payload now
+handleFailure (EvictAfterTime limit) payload = do
+ previousResult <- readTVarIO payload
+ now <- currentTime
+ let failed = previousResult <&> snd <&> (\prev -> diffUTCTime now prev >= limit)
+ case failed of
+ Right True -> writeCacheFailure payload now
+ _ -> return ()
+
+clamp :: Int -> Int -> Int -> Int
+clamp mn mx val
+ | val < mn = mn
+ | val > mx = mx
+ | otherwise = val
+
+handleDelay :: MonadCache m => DelayMode a -> Maybe Int -> Either SomeException a -> m ()
+handleDelay mode (Just fuzz) res = do
+ fuzzDelay <- randomize (0, fuzz)
+ delay fuzzDelay
+ handleDelay' mode res
+handleDelay mode Nothing res = handleDelay' mode res
+
+handleDelay' :: MonadCache m => DelayMode a -> Either SomeException a -> m ()
+handleDelay' (DelayForMicroseconds mics) _ = delay mics
+handleDelay' (DelayDynamically f) r = delay $ f r
+handleDelay' (DelayDynamicallyWithBounds (mn, mx) f) r =
+ delay . clamp mn mx $ f r
+
+-- | Create a 'CacheOptions' with basic functionality enabled.
+--
+-- Record update syntax can be use to further customize options created using this function:
+--
+-- > basicOpts = basicOptions (DelayForMicroseconds 60000000) EvictImmediately
+-- > customOpts = basicOpts { delayFuzzing = Just 100 }
+basicOptions :: DelayMode a -> FailureMode -> CacheOptions a
+basicOptions d f = CacheOptions d f Nothing
+
+-- | Creates a new 'PollingCache'.
+--
+-- The supplied action is used to generate values that are stored in the cache. The action is executed in the background
+-- with its delay, failure, and fuzzing behavior controlled by the provided 'CacheOptions'.
+newPollingCache :: forall a m. MonadCache m => CacheOptions a -> m a -> m (PollingCache a)
+newPollingCache CacheOptions {..} generator = do
+ tvar <- newTVarIO $ Left NotYetLoaded
+ tid <- newThread $ cacheThread tvar
+ return $ PollingCache tvar tid
+ where
+ cacheThread :: CachePayload a -> m ()
+ cacheThread tvar = repeatedly $ do
+ (result :: Either SomeException a) <- Exc.try generator
+ case result of
+ Left _ -> handleFailure failureMode tvar
+ Right value -> do
+ now <- currentTime
+ atomically . writeTVar tvar $ Right (value, now)
+ handleDelay delayMode delayFuzzing result
+
+-- | Retrieve the current values from a 'PollingCache'.
+cachedValues :: MonadCache m => PollingCache a -> m (CacheResult a)
+cachedValues = readTVarIO . mostRecentValues
+
+-- | Stops the background processing thread associated with a 'PollingCache'.
+--
+-- Calling this function will place the 'Stopped' value into the cache after stopping the processing thread,
+-- ensuring that a 'PollingCache' that has been stopped can no longer be used to query stale values.
+stopPolling :: MonadCache m => PollingCache a -> m ()
+stopPolling PollingCache {..} = do
+ killCache threadId
+ atomically . writeTVar mostRecentValues $ Left Stopped
diff --git a/test/PollingCacheSpec.hs b/test/PollingCacheSpec.hs
new file mode 100644
--- /dev/null
+++ b/test/PollingCacheSpec.hs
@@ -0,0 +1,276 @@
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE RecordWildCards #-}
+
+module PollingCacheSpec (spec) where
+
+import Control.Concurrent
+import Control.Exception
+import Control.Monad
+import Control.Monad.Trans
+import Control.Monad.Trans.State.Strict
+import Data.Cache.Polling
+import Data.Either (isRight)
+import Data.Functor ((<&>))
+import Data.Maybe (fromMaybe)
+import Data.Time
+import Data.Time.Calendar.OrdinalDate
+import Test.Hspec
+
+data TestState = TestState
+ { now :: UTCTime,
+ fuzzing :: Maybe Int,
+ numIterations :: Int,
+ maxIterations :: Int
+ }
+ deriving (Show)
+
+type TestCache a = StateT TestState IO a
+
+instance MonadCache (StateT TestState IO) where
+ currentTime = gets now
+ delay us = do
+ let diff = realToFrac us
+ st@TestState {..} <- get
+ put $ st {now = addUTCTime diff now}
+ randomize _ = do
+ fz <- gets fuzzing
+ return $ fromMaybe 0 fz
+ repeatedly act = go
+ where
+ step st@TestState {..} = st {numIterations = numIterations + 1}
+ go = do
+ withStateT step act
+ TestState {..} <- get
+ when (numIterations < maxIterations) go
+ newThread act = act >> lift myThreadId
+ killCache _ = return ()
+
+testDay :: Day
+testDay = fromOrdinalDate 0 0
+
+testTime :: DiffTime -> UTCTime
+testTime = UTCTime testDay
+
+testState :: Int -> TestState
+testState = TestState (testTime 0) Nothing 0
+
+testOptions :: Int -> FailureMode -> CacheOptions a
+testOptions ms fm = basicOptions (DelayForMicroseconds ms) fm
+
+testState' :: Int -> Int -> TestState
+testState' fuzz = TestState (testTime 0) (Just fuzz) 0
+
+testOptions' :: DelayMode a -> FailureMode -> TestState -> CacheOptions a
+testOptions' d f s = (basicOptions d f) {delayFuzzing = (fuzzing s)}
+
+data TestException = TestException deriving (Show)
+
+instance Exception TestException
+
+alwaysSucceeds :: TestCache Int
+alwaysSucceeds = return 123
+
+alwaysSucceedsIO :: IO Int
+alwaysSucceedsIO = return 123
+
+alwaysFails :: TestCache Int
+alwaysFails = throw TestException
+
+secondPassFails :: TestCache Int
+secondPassFails = do
+ TestState {..} <- get
+ when (numIterations == 2) $ throw TestException
+ return 234
+
+secondPassSucceeds :: TestCache Int
+secondPassSucceeds = do
+ iteration <- gets numIterations
+ if iteration == 2
+ then return 12190
+ else throw TestException
+
+transientFailure :: Int -> Int -> TestCache Int
+transientFailure startFailing stopFailing = do
+ iteration <- gets numIterations
+ if iteration >= startFailing && iteration <= stopFailing
+ then throw TestException
+ else return 81590
+
+spec :: Spec
+spec = do
+ basicFunctionalitySpec
+ ignoreSpec
+ evictImmediatelySpec
+ evictAfterTimeSpec
+ delayDynamicallySpec
+ delayDynamicallyWithBoundsSpec
+ fuzzingSpec
+
+basicFunctionalitySpec :: Spec
+basicFunctionalitySpec =
+ context "Basic functionality" $ do
+ describe "background processing thread" $ do
+ let testCache = newPollingCache (testOptions 100 Ignore) alwaysSucceeds
+ it "will suspend background execution for the time span specified by the user" $ do
+ cache <- evalStateT testCache $ testState 4
+ val <- cachedValues cache
+ val `shouldBe` Right (123, testTime 300)
+
+ describe "after stopping cache" $ do
+ it "will no longer return valid values" $ do
+ cache <- newPollingCache (testOptions 100 Ignore) alwaysSucceedsIO
+ stopPolling cache
+ val <- cachedValues cache
+ val `shouldBe` Left Stopped
+
+ describe "IO actions" $ do
+ it "will be executed in a background thread" $ do
+ cache <- newPollingCache (testOptions 1 Ignore) alwaysSucceedsIO
+ threadDelay 100
+ val <- cachedValues cache
+ val `shouldSatisfy` isRight
+ stopPolling cache
+
+ it "will execute repeatedly" $ do
+ cache <- newPollingCache (testOptions 1 Ignore) alwaysSucceedsIO
+ threadDelay 100
+ firstVal <- cachedValues cache
+ threadDelay 100
+ secondVal <- cachedValues cache
+ (firstVal <&> snd) `shouldNotBe` (secondVal <&> snd)
+ stopPolling cache
+
+ignoreSpec :: Spec
+ignoreSpec =
+ context "Ignoring faliure" $ do
+ describe "without succeeding" $ do
+ let testCache = newPollingCache (testOptions 10 Ignore) alwaysFails
+ it "will never load a value" $ do
+ cache <- evalStateT testCache $ testState 10
+ val <- cachedValues cache
+ val `shouldBe` Left NotYetLoaded
+
+ describe "after succeeding once" $ do
+ let testCache = newPollingCache (testOptions 10 Ignore) secondPassSucceeds
+ it "will always return the successful result" $ do
+ cache <- evalStateT testCache $ testState 10
+ val <- cachedValues cache
+ val `shouldBe` Right (12190, testTime 10)
+
+evictImmediatelySpec :: Spec
+evictImmediatelySpec =
+ context "Evicting immediately upon failure" $ do
+ describe "with a constant generator" $ do
+ let testCache = newPollingCache (testOptions 10 EvictImmediately) alwaysSucceeds
+ it "will continually return the generated value" $ do
+ (cache, st) <- runStateT testCache $ testState 1
+ val <- cachedValues cache
+ val `shouldBe` Right (123, testTime 0)
+ nextCache <- evalStateT testCache st
+ nextVal <- cachedValues nextCache
+ nextVal `shouldBe` Right (123, testTime 10)
+
+ describe "with a sporadic failure" $ do
+ let testCache = newPollingCache (testOptions 10 EvictImmediately) secondPassFails
+ it "will report the failure" $ do
+ cache <- evalStateT testCache $ testState 2
+ val <- cachedValues cache
+ val `shouldBe` (Left . LoadFailed $ testTime 10)
+
+ it "will succeed after failure" $ do
+ cache <- evalStateT testCache $ testState 10
+ val <- cachedValues cache
+ val `shouldBe` Right (234, testTime 90)
+
+ describe "with a persistent failure" $ do
+ let testCache = newPollingCache (testOptions 10 EvictImmediately) alwaysFails
+ it "will not update the original failure time" $ do
+ cache <- evalStateT testCache $ testState 10
+ val <- cachedValues cache
+ val `shouldBe` (Left . LoadFailed $ testTime 0)
+
+evictAfterTimeSpec :: Spec
+evictAfterTimeSpec =
+ context "Evicting after a time interval" $ do
+ describe "with a transient failure" $ do
+ let testCache = newPollingCache (testOptions 10 (EvictAfterTime 30)) (transientFailure 3 8)
+ it "will not report the failure before the cut-off period" $ do
+ cache <- evalStateT testCache $ testState 2
+ val <- cachedValues cache
+ val `shouldBe` Right (81590, testTime 10)
+
+ it "will report the failure after the cut-off period" $ do
+ cache <- evalStateT testCache $ testState 5
+ val <- cachedValues cache
+ val `shouldBe` (Left . LoadFailed $ testTime 40)
+
+ it "will not overwrite the failure time for successive failures" $ do
+ cache <- evalStateT testCache $ testState 7
+ val <- cachedValues cache
+ val `shouldBe` (Left . LoadFailed $ testTime 40)
+
+ it "will report success after the failure subsides" $ do
+ cache <- evalStateT testCache $ testState 10
+ val <- cachedValues cache
+ val `shouldBe` Right (81590, testTime 90)
+
+testDynamicDelay :: Int -> Either SomeException a -> Int
+testDynamicDelay = const
+
+delayDynamicallySpec :: Spec
+delayDynamicallySpec = context "Dynamic delay" $ do
+ let ts = testState 2
+ let testCache = newPollingCache (testOptions' (DelayDynamically $ testDynamicDelay 15) EvictImmediately ts)
+ describe "with a successful result" $ do
+ it "will delay for the user's supplied time span" $ do
+ cache <- evalStateT (testCache alwaysSucceeds) ts
+ val <- cachedValues cache
+ val `shouldBe` Right (123, testTime 15)
+ describe "with an exception" $ do
+ it "will delay for the user's supplied time span" $ do
+ cache <- evalStateT (testCache secondPassFails) ts
+ val <- cachedValues cache
+ val `shouldBe` (Left . LoadFailed $ testTime 15)
+
+delayDynamicallyWithBoundsSpec :: Spec
+delayDynamicallyWithBoundsSpec = context "Dynamic delay with bounds" $ do
+ let ts = testState 2
+ let testCache = newPollingCache (testOptions' (DelayDynamicallyWithBounds (5, 15) $ testDynamicDelay 10) EvictImmediately ts)
+ describe "with a successful result" $ do
+ it "will delay for the user's supplied time span" $ do
+ cache <- evalStateT (testCache alwaysSucceeds) ts
+ val <- cachedValues cache
+ val `shouldBe` Right (123, testTime 10)
+ describe "with an exception" $ do
+ it "will delay for the user's supplied time span" $ do
+ cache <- evalStateT (testCache secondPassFails) ts
+ val <- cachedValues cache
+ val `shouldBe` (Left . LoadFailed $ testTime 10)
+ describe "with a dynamic delay less than the lower bound" $ do
+ let c = newPollingCache (testOptions' (DelayDynamicallyWithBounds (5, 15) $ testDynamicDelay 1) EvictImmediately ts)
+ it "will delay for the lower bound" $ do
+ cache <- evalStateT (c alwaysSucceeds) ts
+ val <- cachedValues cache
+ val `shouldBe` Right (123, testTime 5)
+ describe "with a dynamic delay greater than the upper bound" $ do
+ let c = newPollingCache (testOptions' (DelayDynamicallyWithBounds (5, 15) $ testDynamicDelay 25) EvictImmediately ts)
+ it "will delay for upper bound" $ do
+ cache <- evalStateT (c alwaysSucceeds) ts
+ val <- cachedValues cache
+ val `shouldBe` Right (123, testTime 15)
+
+fuzzingSpec :: Spec
+fuzzingSpec = context "Fuzzing" $ do
+ let ts = testState' 7 2
+ describe "with a static delay" $ do
+ let testCache = newPollingCache (testOptions' (DelayForMicroseconds 11) EvictImmediately ts)
+ it "will modify the delay period" $ do
+ cache <- evalStateT (testCache alwaysSucceeds) ts
+ val <- cachedValues cache
+ val `shouldBe` Right (123, testTime 18)
+ describe "with a dynamic delay" $ do
+ let testCache = newPollingCache (testOptions' (DelayDynamically $ testDynamicDelay 17) EvictImmediately ts)
+ it "will modify the delay period" $ do
+ cache <- evalStateT (testCache alwaysSucceeds) ts
+ val <- cachedValues cache
+ val `shouldBe` Right (123, testTime 24)
diff --git a/test/Spec.hs b/test/Spec.hs
new file mode 100644
--- /dev/null
+++ b/test/Spec.hs
@@ -0,0 +1,1 @@
+{-# OPTIONS_GHC -F -pgmF hspec-discover #-}