resource-pool-0.4.0.0/0000755000000000000000000000000007346545000012640 5ustar0000000000000000resource-pool-0.4.0.0/CHANGELOG.md0000644000000000000000000000131707346545000014453 0ustar0000000000000000# resource-pool-0.4.0.0 (2023-01-16) * Require `poolMaxResources` to be not smaller than the number of stripes. * Add support for setting the number of stripes. * Hide the constructor of `PoolConfig` from the public API and provide `defaultPoolConfig` so that future additions to `PoolConfig` don't require major version bumps. # resource-pool-0.3.1.0 (2022-06-15) * Add `tryWithResource` and `tryTakeResource`. # resource-pool-0.3.0.0 (2022-06-01) * Rewrite based on `Control.Concurrent.QSem` for better throughput and latency. * Make release of resources asynchronous exceptions safe. * Remove dependency on `monad-control`. * Expose the `.Internal` module. * Add support for introspection. * Add `PoolConfig`. resource-pool-0.4.0.0/LICENSE0000644000000000000000000000266707346545000013660 0ustar0000000000000000Copyright (c) 2011, MailRank, Inc. All rights reserved. Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: 1. Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. 2. 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. 3. Neither the name of the author nor the names of his contributors may be used to endorse or promote products derived from this software without specific prior written permission. THIS SOFTWARE IS PROVIDED BY THE 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 AUTHORS 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. resource-pool-0.4.0.0/README.md0000644000000000000000000000153707346545000014125 0ustar0000000000000000# resource-pool [![Build Status](https://github.com/scrive/pool/workflows/Haskell-CI/badge.svg?branch=master)](https://github.com/scrive/pool/actions?query=branch%3Amaster) [![Hackage](https://img.shields.io/hackage/v/resource-pool.svg)](https://hackage.haskell.org/package/resource-pool) [![Dependencies](https://img.shields.io/hackage-deps/v/resource-pool.svg)](https://packdeps.haskellers.com/feed?needle=andrzej@rybczak.net) [![Stackage LTS](https://www.stackage.org/package/resource-pool/badge/lts)](https://www.stackage.org/lts/package/resource-pool) [![Stackage Nightly](https://www.stackage.org/package/resource-pool/badge/nightly)](https://www.stackage.org/nightly/package/resource-pool) A high-performance striped resource pooling implementation for Haskell based on [QSem](https://hackage.haskell.org/package/base/docs/Control-Concurrent-QSem.html). resource-pool-0.4.0.0/resource-pool.cabal0000644000000000000000000000247607346545000016433 0ustar0000000000000000cabal-version: 2.4 build-type: Simple name: resource-pool version: 0.4.0.0 license: BSD-3-Clause license-file: LICENSE category: Data, Database, Network maintainer: andrzej@rybczak.net author: Andrzej Rybczak, Bryan O'Sullivan synopsis: A high-performance striped resource pooling implementation description: A high-performance striped pooling abstraction for managing flexibly-sized collections of resources such as database connections. tested-with: GHC ==8.4.4 || ==8.6.5 || ==8.8.4 || ==8.10.7 || ==9.0.2 || ==9.2.5 || ==9.4.3 extra-doc-files: CHANGELOG.md README.md bug-reports: https://github.com/scrive/pool/issues source-repository head type: git location: https://github.com/scrive/pool.git library hs-source-dirs: src exposed-modules: Data.Pool Data.Pool.Internal Data.Pool.Introspection build-depends: base >= 4.11 && < 5 , hashable >= 1.1.0.0 , primitive >= 0.7 , time ghc-options: -Wall -Wcompat default-language: Haskell2010 default-extensions: DeriveGeneric , LambdaCase , RankNTypes , TypeApplications resource-pool-0.4.0.0/src/Data/0000755000000000000000000000000007346545000014300 5ustar0000000000000000resource-pool-0.4.0.0/src/Data/Pool.hs0000644000000000000000000001041707346545000015550 0ustar0000000000000000-- | A high-performance pooling abstraction for managing flexibly-sized -- collections of resources such as database connections. module Data.Pool ( -- * Pool Pool , LocalPool , newPool -- ** Configuration , PoolConfig , defaultPoolConfig , setNumStripes -- * Resource management , withResource , takeResource , tryWithResource , tryTakeResource , putResource , destroyResource , destroyAllResources -- * Compatibility with 0.2 , createPool ) where import Control.Concurrent import Control.Exception import Data.Time (NominalDiffTime) import Data.Pool.Internal -- | Take a resource from the pool, perform an action with it and return it to -- the pool afterwards. -- -- * If the pool has an idle resource available, it is used immediately. -- -- * Otherwise, if the maximum number of resources has not yet been reached, a -- new resource is created and used. -- -- * If the maximum number of resources has been reached, this function blocks -- until a resource becomes available. -- -- If the action throws an exception of any type, the resource is destroyed and -- not returned to the pool. -- -- It probably goes without saying that you should never manually destroy a -- pooled resource, as doing so will almost certainly cause a subsequent user -- (who expects the resource to be valid) to throw an exception. withResource :: Pool a -> (a -> IO r) -> IO r withResource pool act = mask $ \unmask -> do (res, localPool) <- takeResource pool r <- unmask (act res) `onException` destroyResource pool localPool res putResource localPool res pure r -- | Take a resource from the pool, following the same results as -- 'withResource'. -- -- /Note:/ this function returns both a resource and the 'LocalPool' it came -- from so that it may either be destroyed (via 'destroyResource') or returned -- to the pool (via 'putResource'). takeResource :: Pool a -> IO (a, LocalPool a) takeResource pool = mask_ $ do lp <- getLocalPool (localPools pool) stripe <- takeMVar (stripeVar lp) if available stripe == 0 then do q <- newEmptyMVar putMVar (stripeVar lp) $! stripe { queueR = Queue q (queueR stripe) } waitForResource (stripeVar lp) q >>= \case Just a -> pure (a, lp) Nothing -> do a <- createResource (poolConfig pool) `onException` restoreSize (stripeVar lp) pure (a, lp) else takeAvailableResource pool lp stripe -- | A variant of 'withResource' that doesn't execute the action and returns -- 'Nothing' instead of blocking if the local pool is exhausted. tryWithResource :: Pool a -> (a -> IO r) -> IO (Maybe r) tryWithResource pool act = mask $ \unmask -> tryTakeResource pool >>= \case Just (res, localPool) -> do r <- unmask (act res) `onException` destroyResource pool localPool res putResource localPool res pure (Just r) Nothing -> pure Nothing -- | A variant of 'takeResource' that returns 'Nothing' instead of blocking if -- the local pool is exhausted. tryTakeResource :: Pool a -> IO (Maybe (a, LocalPool a)) tryTakeResource pool = mask_ $ do lp <- getLocalPool (localPools pool) stripe <- takeMVar (stripeVar lp) if available stripe == 0 then do putMVar (stripeVar lp) stripe pure Nothing else Just <$> takeAvailableResource pool lp stripe {-# DEPRECATED createPool "Use newPool instead" #-} -- | Provided for compatibility with @resource-pool < 0.3@. -- -- Use 'newPool' instead. createPool :: IO a -> (a -> IO ()) -> Int -> NominalDiffTime -> Int -> IO (Pool a) createPool create free numStripes idleTime maxResources = newPool PoolConfig { createResource = create , freeResource = free , poolCacheTTL = realToFrac idleTime , poolMaxResources = numStripes * maxResources , poolNumStripes = Just numStripes } ---------------------------------------- -- Helpers takeAvailableResource :: Pool a -> LocalPool a -> Stripe a -> IO (a, LocalPool a) takeAvailableResource pool lp stripe = case cache stripe of [] -> do putMVar (stripeVar lp) $! stripe { available = available stripe - 1 } a <- createResource (poolConfig pool) `onException` restoreSize (stripeVar lp) pure (a, lp) Entry a _ : as -> do putMVar (stripeVar lp) $! stripe { available = available stripe - 1 , cache = as } pure (a, lp) resource-pool-0.4.0.0/src/Data/Pool/0000755000000000000000000000000007346545000015211 5ustar0000000000000000resource-pool-0.4.0.0/src/Data/Pool/Internal.hs0000644000000000000000000002776507346545000017342 0ustar0000000000000000-- | Internal implementation details for "Data.Pool". -- -- This module is intended for internal use only, and may change without warning -- in subsequent releases. {-# OPTIONS_HADDOCK not-home #-} module Data.Pool.Internal where import Control.Concurrent import Control.Exception import Control.Monad import Data.Hashable (hash) import Data.IORef import Data.Primitive.SmallArray import GHC.Clock import qualified Data.List as L -- | Striped resource pool based on "Control.Concurrent.QSem". data Pool a = Pool { poolConfig :: !(PoolConfig a) , localPools :: !(SmallArray (LocalPool a)) , reaperRef :: !(IORef ()) } -- | A single, local pool. data LocalPool a = LocalPool { stripeId :: !Int , stripeVar :: !(MVar (Stripe a)) , cleanerRef :: !(IORef ()) } -- | Stripe of a resource pool. If @available@ is 0, the list of threads waiting -- for a resource (each with an associated 'MVar') is @queue ++ reverse queueR@. data Stripe a = Stripe { available :: !Int , cache :: ![Entry a] , queue :: !(Queue a) , queueR :: !(Queue a) } -- | An existing resource currently sitting in a pool. data Entry a = Entry { entry :: a , lastUsed :: !Double } -- | A queue of MVarS corresponding to threads waiting for resources. -- -- Basically a monomorphic list to save two pointer indirections. data Queue a = Queue !(MVar (Maybe a)) (Queue a) | Empty -- | Configuration of a 'Pool'. data PoolConfig a = PoolConfig { createResource :: !(IO a) , freeResource :: !(a -> IO ()) , poolCacheTTL :: !Double , poolMaxResources :: !Int , poolNumStripes :: !(Maybe Int) } -- | Create a 'PoolConfig' with optional parameters having default values. -- -- For setting optional parameters have a look at: -- -- - 'setNumStripes' -- -- @since 0.4.0.0 defaultPoolConfig :: IO a -- ^ The action that creates a new resource. -> (a -> IO ()) -- ^ The action that destroys an existing resource. -> Double -- ^ The amount of seconds for which an unused resource is kept around. The -- smallest acceptable value is @0.5@. -- -- /Note:/ the elapsed time before destroying a resource may be a little -- longer than requested, as the collector thread wakes at 1-second intervals. -> Int -- ^ The maximum number of resources to keep open __across all stripes__. The -- smallest acceptable value is @1@. -- -- /Note:/ for each stripe the number of resources is divided by the number of -- stripes and rounded up, hence the pool might end up creating up to @N - 1@ -- resources more in total than specified, where @N@ is the number of stripes. -> PoolConfig a defaultPoolConfig create free cacheTTL maxResources = PoolConfig { createResource = create , freeResource = free , poolCacheTTL = cacheTTL , poolMaxResources = maxResources , poolNumStripes = Nothing } -- | Set the number of stripes in the pool. -- -- If set to 'Nothing' (the default value), the pool will create the amount of -- stripes equal to the number of capabilities. This ensures that threads never -- compete over access to the same stripe and results in a very good performance -- in a multi-threaded environment. -- -- @since 0.4.0.0 setNumStripes :: Maybe Int -> PoolConfig a -> PoolConfig a setNumStripes numStripes pc = pc { poolNumStripes = numStripes } -- | Create a new striped resource pool. -- -- /Note:/ although the runtime system will destroy all idle resources when the -- pool is garbage collected, it's recommended to manually call -- 'destroyAllResources' when you're done with the pool so that the resources -- are freed up as soon as possible. newPool :: PoolConfig a -> IO (Pool a) newPool pc = do when (poolCacheTTL pc < 0.5) $ do error "poolCacheTTL must be at least 0.5" when (poolMaxResources pc < 1) $ do error "poolMaxResources must be at least 1" numStripes <- maybe getNumCapabilities pure (poolNumStripes pc) when (numStripes < 1) $ do error "numStripes must be at least 1" when (poolMaxResources pc < numStripes) $ do error "poolMaxResources must not be smaller than numStripes" pools <- fmap (smallArrayFromListN numStripes) . forM [1..numStripes] $ \n -> do ref <- newIORef () stripe <- newMVar Stripe { available = poolMaxResources pc `quotCeil` numStripes , cache = [] , queue = Empty , queueR = Empty } -- When the local pool goes out of scope, free its resources. void . mkWeakIORef ref $ cleanStripe (const True) (freeResource pc) stripe pure LocalPool { stripeId = n , stripeVar = stripe , cleanerRef = ref } mask_ $ do ref <- newIORef () collectorA <- forkIOWithUnmask $ \unmask -> unmask $ collector pools void . mkWeakIORef ref $ do -- When the pool goes out of scope, stop the collector. Resources existing -- in stripes will be taken care by their cleaners. killThread collectorA pure Pool { poolConfig = pc , localPools = pools , reaperRef = ref } where quotCeil :: Int -> Int -> Int quotCeil x y = -- Basically ceiling (x / y) without going through Double. let (z, r) = x `quotRem` y in if r == 0 then z else z + 1 -- Collect stale resources from the pool once per second. collector pools = forever $ do threadDelay 1000000 now <- getMonotonicTime let isStale e = now - lastUsed e > poolCacheTTL pc mapM_ (cleanStripe isStale (freeResource pc) . stripeVar) pools -- | Destroy a resource. -- -- Note that this will ignore any exceptions in the destroy function. destroyResource :: Pool a -> LocalPool a -> a -> IO () destroyResource pool lp a = do uninterruptibleMask_ $ do -- Note [signal uninterruptible] stripe <- takeMVar (stripeVar lp) newStripe <- signal stripe Nothing putMVar (stripeVar lp) newStripe void . try @SomeException $ freeResource (poolConfig pool) a -- | Return a resource to the given 'LocalPool'. putResource :: LocalPool a -> a -> IO () putResource lp a = do uninterruptibleMask_ $ do -- Note [signal uninterruptible] stripe <- takeMVar (stripeVar lp) newStripe <- signal stripe (Just a) putMVar (stripeVar lp) newStripe -- | Destroy all resources in all stripes in the pool. -- -- Note that this will ignore any exceptions in the destroy function. -- -- This function is useful when you detect that all resources in the pool are -- broken. For example after a database has been restarted all connections -- opened before the restart will be broken. In that case it's better to close -- those connections so that 'takeResource' won't take a broken connection from -- the pool but will open a new connection instead. -- -- Another use-case for this function is that when you know you are done with -- the pool you can destroy all idle resources immediately instead of waiting on -- the garbage collector to destroy them, thus freeing up those resources -- sooner. destroyAllResources :: Pool a -> IO () destroyAllResources pool = forM_ (localPools pool) $ \lp -> do cleanStripe (const True) (freeResource (poolConfig pool)) (stripeVar lp) ---------------------------------------- -- Helpers -- | Get a local pool. getLocalPool :: SmallArray (LocalPool a) -> IO (LocalPool a) getLocalPool pools = do sid <- if stripes == 1 -- If there is just one stripe, there is no choice. then pure 0 else do capabilities <- getNumCapabilities -- If the number of stripes is smaller than the number of capabilities and -- doesn't divide it, selecting a stripe by a capability the current -- thread runs on wouldn't give equal load distribution across all stripes -- (e.g. if there are 2 stripes and 3 capabilities, stripe 0 would be used -- by capability 0 and 2, while stripe 1 would only be used by capability -- 1, a 100% load difference). In such case we select based on the id of a -- thread. if stripes < capabilities && capabilities `rem` stripes /= 0 then hash <$> myThreadId else fmap fst . threadCapability =<< myThreadId pure $ pools `indexSmallArray` (sid `rem` stripes) where stripes = sizeofSmallArray pools -- | Wait for the resource to be put into a given 'MVar'. waitForResource :: MVar (Stripe a) -> MVar (Maybe a) -> IO (Maybe a) waitForResource mstripe q = takeMVar q `onException` cleanup where cleanup = uninterruptibleMask_ $ do -- Note [signal uninterruptible] stripe <- takeMVar mstripe newStripe <- tryTakeMVar q >>= \case Just ma -> do -- Between entering the exception handler and taking ownership of -- the stripe we got the resource we wanted. We don't need it -- anymore though, so pass it to someone else. signal stripe ma Nothing -> do -- If we're still waiting, fill up the MVar with an undefined value -- so that 'signal' can discard our MVar from the queue. putMVar q $ error "unreachable" pure stripe putMVar mstripe newStripe -- | If an exception is received while a resource is being created, restore the -- original size of the stripe. restoreSize :: MVar (Stripe a) -> IO () restoreSize mstripe = uninterruptibleMask_ $ do -- 'uninterruptibleMask_' is used since 'takeMVar' might block. stripe <- takeMVar mstripe putMVar mstripe $! stripe { available = available stripe + 1 } -- | Free resource entries in the stripes that fulfil a given condition. cleanStripe :: (Entry a -> Bool) -> (a -> IO ()) -> MVar (Stripe a) -> IO () cleanStripe isStale free mstripe = mask $ \unmask -> do -- Asynchronous exceptions need to be masked here to prevent leaking of -- 'stale' resources before they're freed. stale <- modifyMVar mstripe $ \stripe -> unmask $ do let (stale, fresh) = L.partition isStale (cache stripe) -- There's no need to update 'available' here because it only tracks -- the number of resources taken from the pool. newStripe = stripe { cache = fresh } newStripe `seq` pure (newStripe, map entry stale) -- We need to ignore exceptions in the 'free' function, otherwise if an -- exception is thrown half-way, we leak the rest of the resources. Also, -- asynchronous exceptions need to be hard masked here since freeing a -- resource might in theory block. uninterruptibleMask_ . forM_ stale $ try @SomeException . free -- Note [signal uninterruptible] -- -- If we have -- -- bracket takeResource putResource (...) -- -- and an exception arrives at the putResource, then we must not lose the -- resource. The putResource is masked by bracket, but taking the MVar might -- block, and so it would be interruptible. Hence we need an uninterruptible -- variant of mask here. signal :: Stripe a -> Maybe a -> IO (Stripe a) signal stripe ma = if available stripe == 0 then loop (queue stripe) (queueR stripe) else do newCache <- case ma of Just a -> do now <- getMonotonicTime pure $ Entry a now : cache stripe Nothing -> pure $ cache stripe pure $! stripe { available = available stripe + 1 , cache = newCache } where loop Empty Empty = do newCache <- case ma of Just a -> do now <- getMonotonicTime pure [Entry a now] Nothing -> pure [] pure $! Stripe { available = 1 , cache = newCache , queue = Empty , queueR = Empty } loop Empty qR = loop (reverseQueue qR) Empty loop (Queue q qs) qR = tryPutMVar q ma >>= \case -- This fails when 'waitForResource' went into the exception handler and -- filled the MVar (with an undefined value) itself. In such case we -- simply ignore it. False -> loop qs qR True -> pure $! stripe { available = 0 , queue = qs , queueR = qR } reverseQueue :: Queue a -> Queue a reverseQueue = go Empty where go acc = \case Empty -> acc Queue x xs -> go (Queue x acc) xs resource-pool-0.4.0.0/src/Data/Pool/Introspection.hs0000644000000000000000000001200607346545000020404 0ustar0000000000000000-- | A variant of "Data.Pool" with introspection capabilities. module Data.Pool.Introspection ( -- * Pool Pool , LocalPool , newPool -- ** Configuration , PoolConfig , defaultPoolConfig , setNumStripes -- * Resource management , Resource(..) , Acquisition(..) , withResource , takeResource , tryWithResource , tryTakeResource , putResource , destroyResource , destroyAllResources ) where import Control.Concurrent import Control.Exception import GHC.Clock import GHC.Generics (Generic) import Data.Pool.Internal -- | A resource taken from the pool along with additional information. data Resource a = Resource { resource :: a , stripeNumber :: !Int , availableResources :: !Int , acquisition :: !Acquisition , acquisitionTime :: !Double , creationTime :: !(Maybe Double) } deriving (Eq, Show, Generic) -- | Describes how a resource was acquired from the pool. data Acquisition = Immediate -- ^ A resource was taken from the pool immediately. | Delayed -- ^ The thread had to wait until a resource was released. deriving (Eq, Show, Generic) -- | 'Data.Pool.withResource' with introspection capabilities. withResource :: Pool a -> (Resource a -> IO r) -> IO r withResource pool act = mask $ \unmask -> do (res, localPool) <- takeResource pool r <- unmask (act res) `onException` destroyResource pool localPool (resource res) putResource localPool (resource res) pure r -- | 'Data.Pool.takeResource' with introspection capabilities. takeResource :: Pool a -> IO (Resource a, LocalPool a) takeResource pool = mask_ $ do t1 <- getMonotonicTime lp <- getLocalPool (localPools pool) stripe <- takeMVar (stripeVar lp) if available stripe == 0 then do q <- newEmptyMVar putMVar (stripeVar lp) $! stripe { queueR = Queue q (queueR stripe) } waitForResource (stripeVar lp) q >>= \case Just a -> do t2 <- getMonotonicTime let res = Resource { resource = a , stripeNumber = stripeId lp , availableResources = 0 , acquisition = Delayed , acquisitionTime = t2 - t1 , creationTime = Nothing } pure (res, lp) Nothing -> do t2 <- getMonotonicTime a <- createResource (poolConfig pool) `onException` restoreSize (stripeVar lp) t3 <- getMonotonicTime let res = Resource { resource = a , stripeNumber = stripeId lp , availableResources = 0 , acquisition = Delayed , acquisitionTime = t2 - t1 , creationTime = Just $! t3 - t2 } pure (res, lp) else takeAvailableResource pool t1 lp stripe -- | A variant of 'withResource' that doesn't execute the action and returns -- 'Nothing' instead of blocking if the local pool is exhausted. tryWithResource :: Pool a -> (Resource a -> IO r) -> IO (Maybe r) tryWithResource pool act = mask $ \unmask -> tryTakeResource pool >>= \case Just (res, localPool) -> do r <- unmask (act res) `onException` destroyResource pool localPool (resource res) putResource localPool (resource res) pure (Just r) Nothing -> pure Nothing -- | A variant of 'takeResource' that returns 'Nothing' instead of blocking if -- the local pool is exhausted. tryTakeResource :: Pool a -> IO (Maybe (Resource a, LocalPool a)) tryTakeResource pool = mask_ $ do t1 <- getMonotonicTime lp <- getLocalPool (localPools pool) stripe <- takeMVar (stripeVar lp) if available stripe == 0 then do putMVar (stripeVar lp) stripe pure Nothing else Just <$> takeAvailableResource pool t1 lp stripe ---------------------------------------- -- Helpers takeAvailableResource :: Pool a -> Double -> LocalPool a -> Stripe a -> IO (Resource a, LocalPool a) takeAvailableResource pool t1 lp stripe = case cache stripe of [] -> do let newAvailable = available stripe - 1 putMVar (stripeVar lp) $! stripe { available = newAvailable } t2 <- getMonotonicTime a <- createResource (poolConfig pool) `onException` restoreSize (stripeVar lp) t3 <- getMonotonicTime let res = Resource { resource = a , stripeNumber = stripeId lp , availableResources = newAvailable , acquisition = Immediate , acquisitionTime = t2 - t1 , creationTime = Just $! t3 - t2 } pure (res, lp) Entry a _ : as -> do let newAvailable = available stripe - 1 putMVar (stripeVar lp) $! stripe { available = newAvailable, cache = as } t2 <- getMonotonicTime let res = Resource { resource = a , stripeNumber = stripeId lp , availableResources = newAvailable , acquisition = Immediate , acquisitionTime = t2 - t1 , creationTime = Nothing } pure (res, lp)