module Database.Redis.Utils.Lock ( acquire, acquire', acquireOnce, release )
where
import Control.Concurrent (threadDelay)
import Database.Redis.Redis
import Database.Redis.ByteStringClass
import System.Time
acquire :: BS s =>
Redis
-> s
-> Int
-> Int
-> IO Bool
acquire r name 0 _ = acquireOnce r name
acquire r name timeout retry_timeout = do res <- acquireOnce r name
if res then return True else getClockTime >>= trylock
where trylock t = do now <- getClockTime
if diffClockTimesMs t now >= timeout
then return False
else do res <- acquireOnce r name
if res
then return True
else threadDelay rt >> trylock t
rt = retry_timeout * 1000
acquire' r name timeout = acquire r name timeout 50
acquireOnce r name = do res <- setNx r name "1" >>= fromRInt
return (res == 1)
release :: BS s => Redis -> s -> IO ()
release r name = del r name >>= noError
diffClockTimesMs :: ClockTime -> ClockTime -> Int
diffClockTimesMs (TOD t1s t1m) (TOD t2s t2m) = fromIntegral $ (t2s - t1s) * 1000 + (t2m - t1m) `div` 1000000000