support invalidating existing VerifiedCopys
This commit is contained in:
parent
90f7c4b6a2
commit
c75c79864d
8 changed files with 73 additions and 23 deletions
|
@ -5,11 +5,22 @@
|
|||
- Licensed under the GNU GPL version 3 or higher.
|
||||
-}
|
||||
|
||||
module Types.NumCopies where
|
||||
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)
|
||||
|
@ -17,38 +28,67 @@ newtype NumCopies = NumCopies Int
|
|||
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 presumably not going to
|
||||
- lose a copy. This is the weakest level of verification. -}
|
||||
= TrustedCopy UUID
|
||||
- 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. -}
|
||||
| VerifiedCopy 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 UUID (IO ())
|
||||
| VerifiedCopyLock V
|
||||
deriving (Show)
|
||||
|
||||
instance ToUUID VerifiedCopy where
|
||||
toUUID (VerifiedCopy u) = u
|
||||
toUUID (VerifiedCopyLock u _) = u
|
||||
toUUID (TrustedCopy u) = u
|
||||
toUUID = _getUUID . toV
|
||||
|
||||
toV :: VerifiedCopy -> V
|
||||
toV (TrustedCopy v) = v
|
||||
toV (RecentlyVerifiedCopy v) = v
|
||||
toV (VerifiedCopyLock v) = v
|
||||
|
||||
instance Show VerifiedCopy where
|
||||
show (TrustedCopy u) = "TrustedCopy " ++ show u
|
||||
show (VerifiedCopy u) = "VerifiedCopy " ++ show u
|
||||
show (VerifiedCopyLock u _) = "VerifiedCopyLock " ++ show u
|
||||
-- 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@(VerifiedCopy _) _ = a
|
||||
strongestVerifiedCopy _ b@(VerifiedCopy _) = b
|
||||
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
|
||||
|
|
Loading…
Add table
Add a link
Reference in a new issue