1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
|
{- git-annex numcopies types
-
- Copyright 2014 Joey Hess <id@joeyh.name>
-
- Licensed under the GNU GPL version 3 or higher.
-}
module Types.NumCopies (
NumCopies(..),
fromNumCopies,
VerifiedCopy(..),
checkVerifiedCopy,
invalidateVerifiedCopy,
strongestVerifiedCopy,
deDupVerifiedCopies,
mkVerifiedCopy,
invalidatableVerifiedCopy,
) where
import Types.UUID
import qualified Data.Map as M
import Control.Concurrent.MVar
newtype NumCopies = NumCopies Int
deriving (Ord, Eq)
fromNumCopies :: NumCopies -> Int
fromNumCopies (NumCopies n) = n
-- A verification that a copy of a key exists in a repository.
data VerifiedCopy
{- Use when a repository cannot be accessed, but it's
- a trusted repository, which is on record as containing a key
- and is presumably not going to lose its copy.
- This is the weakest level of verification. -}
= TrustedCopy V
{- Represents a recent verification that a copy of an
- object exists in a repository with the given UUID. -}
| RecentlyVerifiedCopy V
{- The strongest proof of the existence of a copy.
- Until its associated action is called to unlock it,
- the copy is locked in the repository and is guaranteed
- not to be dropped by any git-annex process. -}
| VerifiedCopyLock V
deriving (Show)
instance ToUUID VerifiedCopy where
toUUID = _getUUID . toV
toV :: VerifiedCopy -> V
toV (TrustedCopy v) = v
toV (RecentlyVerifiedCopy v) = v
toV (VerifiedCopyLock v) = v
-- Checks that it's still valid.
checkVerifiedCopy :: VerifiedCopy -> IO Bool
checkVerifiedCopy = _checkVerifiedCopy . toV
invalidateVerifiedCopy :: VerifiedCopy -> IO ()
invalidateVerifiedCopy = _invalidateVerifiedCopy . toV
data V = V
{ _getUUID :: UUID
, _checkVerifiedCopy :: IO Bool
, _invalidateVerifiedCopy :: IO ()
}
instance Show V where
show v = show (_getUUID v)
strongestVerifiedCopy :: VerifiedCopy -> VerifiedCopy -> VerifiedCopy
strongestVerifiedCopy a@(VerifiedCopyLock _) _ = a
strongestVerifiedCopy _ b@(VerifiedCopyLock _) = b
strongestVerifiedCopy a@(RecentlyVerifiedCopy _) _ = a
strongestVerifiedCopy _ b@(RecentlyVerifiedCopy _) = b
strongestVerifiedCopy a@(TrustedCopy _) _ = a
-- Retains stronger verifications over weaker for the same uuid.
deDupVerifiedCopies :: [VerifiedCopy] -> [VerifiedCopy]
deDupVerifiedCopies l = M.elems $
M.fromListWith strongestVerifiedCopy (zip (map toUUID l) l)
mkVerifiedCopy :: ToUUID u => (V -> VerifiedCopy) -> u -> VerifiedCopy
mkVerifiedCopy mk u = mk $ V (toUUID u) (return True) (return ())
invalidatableVerifiedCopy :: ToUUID u => (V -> VerifiedCopy) -> u -> IO VerifiedCopy
invalidatableVerifiedCopy mk u = do
v <- newEmptyMVar
let invalidate = do
_ <- tryPutMVar v ()
return ()
let check = isEmptyMVar v
return $ mk $ V (toUUID u) check invalidate
|