summaryrefslogtreecommitdiff
path: root/src/Network/BitTorrent/Tracker/Cache.hs
diff options
context:
space:
mode:
Diffstat (limited to 'src/Network/BitTorrent/Tracker/Cache.hs')
-rw-r--r--src/Network/BitTorrent/Tracker/Cache.hs164
1 files changed, 0 insertions, 164 deletions
diff --git a/src/Network/BitTorrent/Tracker/Cache.hs b/src/Network/BitTorrent/Tracker/Cache.hs
deleted file mode 100644
index 28a4adcb..00000000
--- a/src/Network/BitTorrent/Tracker/Cache.hs
+++ /dev/null
@@ -1,164 +0,0 @@
1-- |
2-- Copyright : (c) Sam Truzjan 2014
3-- License : BSD
4-- Maintainer : pxqr.sta@gmail.com
5-- Stability : experimental
6-- Portability : portable
7--
8-- Cached data for tracker responses.
9--
10module Network.BitTorrent.Tracker.Cache
11 ( -- * Cache
12 Cached
13 , lastUpdated
14 , updateInterval
15 , minUpdateInterval
16
17 -- * Construction
18 , newCached
19 , newCached_
20
21 -- * Query
22 , isAlive
23 , isStalled
24 , isExpired
25 , canUpdate
26 , shouldUpdate
27
28 -- * Cached data
29 , tryTakeData
30 , takeData
31 ) where
32
33import Control.Applicative
34import Data.Monoid
35import Data.Default
36import Data.Time
37import Data.Time.Clock.POSIX
38
39
40data Cached a = Cached
41 { -- | Time of resource creation.
42 lastUpdated :: !POSIXTime
43
44 -- | Minimum invalidation timeout.
45 , minUpdateInterval :: !NominalDiffTime
46
47 -- | Resource lifetime.
48 , updateInterval :: !NominalDiffTime
49
50 -- | Resource data.
51 , cachedData :: a
52 } deriving (Show, Eq)
53
54-- INVARIANT: minUpdateInterval <= updateInterval
55
56instance Default (Cached a) where
57 def = mempty
58
59instance Functor Cached where
60 fmap f (Cached t i m a) = Cached t i m (f a)
61
62posixEpoch :: NominalDiffTime
63posixEpoch = 1000000000000000000000000000000000000000000000000000000
64
65instance Applicative Cached where
66 pure = Cached 0 posixEpoch posixEpoch
67 f <*> c = Cached
68 { lastUpdated = undefined
69 , minUpdateInterval = undefined
70 , updateInterval = undefined
71 , cachedData = cachedData f (cachedData c)
72 }
73
74instance Alternative Cached where
75 empty = mempty
76 (<|>) = error "cached alternative instance: not implemented"
77
78instance Monad Cached where
79 return = pure
80 Cached {..} >>= f = Cached
81 { lastUpdated = undefined
82 , updateInterval = undefined
83 , minUpdateInterval = undefined
84 , cachedData = undefined
85 }
86
87instance Monoid (Cached a) where
88 mempty = Cached
89 { lastUpdated = 0
90 , minUpdateInterval = 0
91 , updateInterval = 0
92 , cachedData = error "cached mempty: impossible happen"
93 }
94
95 mappend a b
96 | expirationTime a > expirationTime b = a
97 | otherwise = b
98
99normalize :: NominalDiffTime -> NominalDiffTime
100 -> (NominalDiffTime, NominalDiffTime)
101normalize a b
102 | a < b = (a, b)
103 | otherwise = (b, a)
104{-# INLINE normalize #-}
105
106newCached :: NominalDiffTime -> NominalDiffTime -> a -> IO (Cached a)
107newCached minInterval interval x = do
108 t <- getPOSIXTime
109 let (mui, ui) = normalize minInterval interval
110 return Cached
111 { lastUpdated = t
112 , minUpdateInterval = mui
113 , updateInterval = ui
114 , cachedData = x
115 }
116
117newCached_ :: NominalDiffTime -> a -> IO (Cached a)
118newCached_ interval x = newCached interval interval x
119{-# INLINE newCached_ #-}
120
121expirationTime :: Cached a -> POSIXTime
122expirationTime Cached {..} = undefined
123
124isAlive :: Cached a -> IO Bool
125isAlive Cached {..} = do
126 currentTime <- getPOSIXTime
127 return $ lastUpdated + updateInterval > currentTime
128
129isExpired :: Cached a -> IO Bool
130isExpired Cached {..} = undefined
131
132isStalled :: Cached a -> IO Bool
133isStalled Cached {..} = undefined
134
135canUpdate :: Cached a -> IO (Maybe NominalDiffTime)
136canUpdate = undefined --isStaled
137
138shouldUpdate :: Cached a -> IO (Maybe NominalDiffTime)
139shouldUpdate = undefined -- isExpired
140
141tryTakeData :: Cached a -> IO (Maybe a)
142tryTakeData c = do
143 alive <- isAlive c
144 return $ if alive then Just (cachedData c) else Nothing
145
146invalidateData :: Cached a -> IO a -> IO (Cached a)
147invalidateData Cached {..} action = do
148 t <- getPOSIXTime
149 x <- action
150 return Cached
151 { lastUpdated = t
152 , updateInterval = updateInterval
153 , minUpdateInterval = minUpdateInterval
154 , cachedData = x
155 }
156
157takeData :: Cached a -> IO a -> IO a
158takeData c action = do
159 mdata <- tryTakeData c
160 case mdata of
161 Just a -> return a
162 Nothing -> do
163 c' <- invalidateData c action
164 takeData c' action