summaryrefslogtreecommitdiff
path: root/Types/NumCopies.hs
diff options
context:
space:
mode:
authorGravatar Joey Hess <joeyh@joeyh.name>2015-10-09 11:09:46 -0400
committerGravatar Joey Hess <joeyh@joeyh.name>2015-10-09 11:09:46 -0400
commit00ba3ec15d8e3a51545aed4c6e43771f2630a0f8 (patch)
treea6fa813ce14bb4ebbb40c7a58712c471ee880fcf /Types/NumCopies.hs
parentbd0c751b267c080ba28a6efeb88b1c0af293429f (diff)
improve drop proof code
Diffstat (limited to 'Types/NumCopies.hs')
-rw-r--r--Types/NumCopies.hs39
1 files changed, 39 insertions, 0 deletions
diff --git a/Types/NumCopies.hs b/Types/NumCopies.hs
index 38bce6818..23df6610a 100644
--- a/Types/NumCopies.hs
+++ b/Types/NumCopies.hs
@@ -16,6 +16,9 @@ module Types.NumCopies (
mkVerifiedCopy,
invalidatableVerifiedCopy,
withVerifiedCopy,
+ isSafeDrop,
+ SafeDropProof,
+ mkSafeDropProof,
) where
import Types.UUID
@@ -25,6 +28,7 @@ import qualified Data.Map as M
import Control.Concurrent.MVar
import Control.Monad.Catch (MonadMask)
import Control.Monad.IO.Class (MonadIO)
+import Control.Monad
newtype NumCopies = NumCopies Int
deriving (Ord, Eq)
@@ -108,3 +112,38 @@ withVerifiedCopy mk u = bracketIO setup cleanup
where
setup = invalidatableVerifiedCopy mk u
cleanup = invalidateVerifiedCopy
+
+{- Check whether enough verification has been done of copies to allow
+ - dropping content safely.
+ -
+ - Unless numcopies is 0, at least one VerifiedCopyLock or TrustedCopy
+ - is required. A VerifiedCopyLock prevents races between concurrent
+ - drops from dropping the last copy, no matter what.
+ -
+ - The other N-1 copies can be less strong verifications, like
+ - RecentlyVerifiedCopy. While those are subject to concurrent drop races,
+ - and so could be dropped all at once, causing numcopies to be violated,
+ - this is the best that can be done without requiring all special remotes
+ - to support locking.
+ -}
+isSafeDrop :: NumCopies -> [VerifiedCopy] -> Bool
+isSafeDrop (NumCopies n) l
+ | n == 0 = True
+ | otherwise = length (deDupVerifiedCopies l) >= n && any fullVerification l
+
+fullVerification :: VerifiedCopy -> Bool
+fullVerification (VerifiedCopyLock _) = True
+fullVerification (TrustedCopy _) = True
+fullVerification (RecentlyVerifiedCopy _) = False
+
+-- A proof that it's currently safe to drop an object.
+data SafeDropProof = SafeDropProof NumCopies [VerifiedCopy]
+
+-- Make sure that none of the VerifiedCopies have become invalidated
+-- before constructing proof.
+mkSafeDropProof :: NumCopies -> [VerifiedCopy] -> IO (Either [VerifiedCopy] SafeDropProof)
+mkSafeDropProof need have = do
+ stillhave <- filterM checkVerifiedCopy have
+ return $ if isSafeDrop need stillhave
+ then Right (SafeDropProof need stillhave)
+ else Left stillhave