diff options
Diffstat (limited to 'Assistant/CredPairCache.hs')
-rw-r--r-- | Assistant/CredPairCache.hs | 53 |
1 files changed, 53 insertions, 0 deletions
diff --git a/Assistant/CredPairCache.hs b/Assistant/CredPairCache.hs new file mode 100644 index 000000000..2b8f72e7c --- /dev/null +++ b/Assistant/CredPairCache.hs @@ -0,0 +1,53 @@ +{- git-annex assistant CredPair cache. + - + - Copyright 2014 Joey Hess <joey@kitenet.net> + - + - Licensed under the GNU GPL version 3 or higher. + -} + +{-# LANGUAGE BangPatterns #-} + +module Assistant.CredPairCache ( + cacheCred, + getCachedCred, + expireCachedCred, +) where + +import Assistant.Types.CredPairCache +import Types.Creds +import Assistant.Common +import Utility.ThreadScheduler + +import qualified Data.Map as M +import Control.Concurrent + +{- Caches a CredPair, but only for a limited time, after which it + - will expire. + - + - Note that repeatedly caching the same CredPair + - does not reset its expiry time. + -} +cacheCred :: CredPair -> Seconds -> Assistant () +cacheCred (login, password) expireafter = do + cache <- getAssistant credPairCache + liftIO $ do + changeStrict cache $ M.insert login password + void $ forkIO $ do + threadDelaySeconds expireafter + changeStrict cache $ M.delete login + +getCachedCred :: Login -> Assistant (Maybe Password) +getCachedCred login = do + cache <- getAssistant credPairCache + liftIO $ M.lookup login <$> readMVar cache + +expireCachedCred :: Login -> Assistant () +expireCachedCred login = do + cache <- getAssistant credPairCache + liftIO $ changeStrict cache $ M.delete login + +{- Update map strictly to avoid keeping references to old creds in memory. -} +changeStrict :: CredPairCache -> (M.Map Login Password -> M.Map Login Password) -> IO () +changeStrict cache a = modifyMVar_ cache $ \m -> do + let !m' = a m + return m' |