diff --git a/Annex/AdjustedBranch.hs b/Annex/AdjustedBranch.hs index 99cd40e835..95bd8cfc34 100644 --- a/Annex/AdjustedBranch.hs +++ b/Annex/AdjustedBranch.hs @@ -308,16 +308,12 @@ updateAdjustedBranch adj (AdjBranch currbranch) origbranch -- adjustment is stable. return True -{- Passed an action that, if it succeeds may get or drop the Key associated - - with the file. When the adjusted branch needs to be refreshed to reflect +{- Passed an action that, if it succeeds may get or drop a key. + - When the adjusted branch needs to be refreshed to reflect - those changes, it's handled here. - - - - Note that the AssociatedFile must be verified by this to point to the - - Key. In some cases, the value was provided by the user and might not - - really be an associated file. -} -adjustedBranchRefresh :: AssociatedFile -> Annex a -> Annex a -adjustedBranchRefresh _af a = do +adjustedBranchRefresh :: Annex a -> Annex a +adjustedBranchRefresh a = do r <- a go return r diff --git a/Annex/Content.hs b/Annex/Content.hs index c4a0f8490c..f01432669e 100644 --- a/Annex/Content.hs +++ b/Annex/Content.hs @@ -376,16 +376,16 @@ lockContentUsing contentlocker key fallback a = withContentLockFile key $ \mlock {- Runs an action, passing it the temp file to get, - and if the action succeeds, verifies the file matches - the key and moves the file into the annex as a key's content. -} -getViaTmp :: RetrievalSecurityPolicy -> VerifyConfig -> Key -> AssociatedFile -> Maybe FileSize -> (OsPath -> Annex (Bool, Verification)) -> Annex Bool -getViaTmp rsp v key af sz action = +getViaTmp :: RetrievalSecurityPolicy -> VerifyConfig -> Key -> Maybe FileSize -> (OsPath -> Annex (Bool, Verification)) -> Annex Bool +getViaTmp rsp v key sz action = checkDiskSpaceToGet key sz False $ - getViaTmpFromDisk rsp v key af action + getViaTmpFromDisk rsp v key action {- Like getViaTmp, but does not check that there is enough disk space - for the incoming key. For use when the key content is already on disk - and not being copied into place. -} -getViaTmpFromDisk :: RetrievalSecurityPolicy -> VerifyConfig -> Key -> AssociatedFile -> (OsPath -> Annex (Bool, Verification)) -> Annex Bool -getViaTmpFromDisk rsp v key af action = checkallowed $ do +getViaTmpFromDisk :: RetrievalSecurityPolicy -> VerifyConfig -> Key -> (OsPath -> Annex (Bool, Verification)) -> Annex Bool +getViaTmpFromDisk rsp v key action = checkallowed $ do tmpfile <- prepTmp key resuming <- liftIO $ doesPathExist tmpfile (ok, verification) <- action tmpfile @@ -400,7 +400,7 @@ getViaTmpFromDisk rsp v key af action = checkallowed $ do else verification if ok then ifM (verifyKeyContentPostRetrieval rsp v verification' key tmpfile) - ( pruneTmpWorkDirBefore tmpfile (moveAnnex key af) + ( pruneTmpWorkDirBefore tmpfile (moveAnnex key) , do verificationOfContentFailed tmpfile return False @@ -507,8 +507,8 @@ withTmp key action = do - accepted into the repository. Will display a warning message in this - case. May also throw exceptions in some cases. -} -moveAnnex :: Key -> AssociatedFile -> OsPath -> Annex Bool -moveAnnex key af src = ifM (checkSecureHashes' key) +moveAnnex :: Key -> OsPath -> Annex Bool +moveAnnex key src = ifM (checkSecureHashes' key) ( do #ifdef mingw32_HOST_OS {- Windows prevents deletion of files that are not @@ -523,7 +523,7 @@ moveAnnex key af src = ifM (checkSecureHashes' key) where storeobject dest = ifM (liftIO $ doesPathExist dest) ( alreadyhave - , adjustedBranchRefresh af $ modifyContentDir dest $ do + , adjustedBranchRefresh $ modifyContentDir dest $ do liftIO $ moveFile src dest -- Freeze the object file now that it is in place. -- Waiting until now to freeze it allows for freeze @@ -776,7 +776,7 @@ removeAnnex (ContentRemovalLock key) = withObjectLoc key $ \file -> -- it's unmodified. resetpointer file = unlessM (liftIO $ isSymbolicLink <$> R.getSymbolicLinkStatus (fromOsPath file)) $ ifM (isUnmodified key file) - ( adjustedBranchRefresh (AssociatedFile (Just file)) $ + ( adjustedBranchRefresh $ depopulatePointerFile key file -- Modified file, so leave it alone. -- If it was a hard link to the annex object, diff --git a/Annex/Import.hs b/Annex/Import.hs index b351504ace..2e86df920d 100644 --- a/Annex/Import.hs +++ b/Annex/Import.hs @@ -863,7 +863,7 @@ importKeys remote importtreeconfig importcontent thirdpartypopulated importablec ia loc [cid] tmpfile (Left k) (combineMeterUpdate p' p) - ok <- moveAnnex k af tmpfile + ok <- moveAnnex k tmpfile when ok $ logStatus NoLiveUpdate k InfoPresent return (Just (k, ok)) @@ -906,7 +906,7 @@ importKeys remote importtreeconfig importcontent thirdpartypopulated importablec p case keyGitSha k of Nothing -> do - ok <- moveAnnex k af tmpfile + ok <- moveAnnex k tmpfile when ok $ do recordcidkey cidmap cid k logStatus NoLiveUpdate k InfoPresent diff --git a/Annex/Ingest.hs b/Annex/Ingest.hs index 695a0cb063..07b5dad282 100644 --- a/Annex/Ingest.hs +++ b/Annex/Ingest.hs @@ -198,17 +198,11 @@ ingest' preferredbackend meterupdate (Just (LockedDown cfg source)) mk restage = | otherwise = gounlocked key mcache golocked key mcache = - tryNonAsync (moveAnnex key naf (contentLocation source)) >>= \case + tryNonAsync (moveAnnex key (contentLocation source)) >>= \case Right True -> success key mcache Right False -> giveup "failed to add content to annex" Left e -> restoreFile (keyFilename source) key e - -- moveAnnex uses the AssociatedFile provided to it to unlock - -- locked files when getting a file in an adjusted branch. - -- That case does not apply here, where we're adding an unlocked - -- file, so provide it nothing. - naf = AssociatedFile Nothing - gounlocked key (Just cache) = do -- Remove temp directory hard link first because -- linkToAnnex falls back to copying if a file @@ -377,7 +371,7 @@ addAnnexedFile matcher file key mtmp = ifM (addUnlocked matcher mi (isJust mtmp) stagePointerFile file mode =<< hashPointerFile key Database.Keys.addAssociatedFile key =<< inRepo (toTopFilePath file) case mtmp of - Just tmp -> ifM (moveAnnex key af tmp) + Just tmp -> ifM (moveAnnex key tmp) ( linkunlocked mode >> return True , writepointer mode >> return False ) @@ -388,11 +382,10 @@ addAnnexedFile matcher file key mtmp = ifM (addUnlocked matcher mi (isJust mtmp) , do addSymlink file key Nothing case mtmp of - Just tmp -> moveAnnex key af tmp + Just tmp -> moveAnnex key tmp Nothing -> return True ) where - af = AssociatedFile (Just file) mi = case mtmp of Just tmp -> MatchingFile $ FileInfo { contentFile = tmp diff --git a/Annex/Transfer.hs b/Annex/Transfer.hs index 45969003ae..7ec629e442 100644 --- a/Annex/Transfer.hs +++ b/Annex/Transfer.hs @@ -78,7 +78,7 @@ download r key f d witness = Just StallDetectionDisabled -> go Nothing Just sd -> runTransferrer sd r key f d Download witness where - go sd = getViaTmp (Remote.retrievalSecurityPolicy r) vc key f Nothing $ \dest -> + go sd = getViaTmp (Remote.retrievalSecurityPolicy r) vc key Nothing $ \dest -> download' (Remote.uuid r) key f sd d (go' dest) witness go' dest p = verifiedAction $ Remote.retrieveKeyFile r key f dest p vc diff --git a/CmdLine/GitRemoteAnnex.hs b/CmdLine/GitRemoteAnnex.hs index 79d6befd5b..beacd137a3 100644 --- a/CmdLine/GitRemoteAnnex.hs +++ b/CmdLine/GitRemoteAnnex.hs @@ -927,7 +927,7 @@ downloadGitBundle rmt k = getKeyExportLocations rmt k >>= \case getexport loc = catchNonAsync (getexport' loc) (const (pure False)) getexport' loc = - getViaTmp rsp vc k (AssociatedFile Nothing) Nothing $ \tmp -> do + getViaTmp rsp vc k Nothing $ \tmp -> do v <- Remote.retrieveExport (Remote.exportActions rmt) k loc tmp nullMeterUpdate return (True, v) @@ -986,7 +986,7 @@ generateGitBundle rmt bs manifest = tmp nullMeterUpdate if (bundlekey `notElem` inManifest manifest) then do - unlessM (moveAnnex bundlekey (AssociatedFile Nothing) tmp) $ + unlessM (moveAnnex bundlekey tmp) $ giveup "Unable to push" return (bundlekey, uploadaction bundlekey) else return (bundlekey, noop) diff --git a/Command/Multicast.hs b/Command/Multicast.hs index 280f862fe4..f29db57e47 100644 --- a/Command/Multicast.hs +++ b/Command/Multicast.hs @@ -213,7 +213,7 @@ storeReceived f = do warning $ "Received a file " <> QuotedPath f <> " that is not a git-annex key. Deleting this file." liftIO $ removeWhenExistsWith removeFile f Just k -> void $ logStatusAfter NoLiveUpdate k $ - getViaTmpFromDisk RetrievalVerifiableKeysSecure AlwaysVerify k (AssociatedFile Nothing) $ \dest -> unVerified $ + getViaTmpFromDisk RetrievalVerifiableKeysSecure AlwaysVerify k $ \dest -> unVerified $ liftIO $ catchBoolIO $ do renameFile f dest return True diff --git a/Command/ReKey.hs b/Command/ReKey.hs index 3f02f2ab60..8688dff25c 100644 --- a/Command/ReKey.hs +++ b/Command/ReKey.hs @@ -128,7 +128,7 @@ linkKey file oldkey newkey = ifM (isJust <$> isAnnexLink file) - and vulnerable to corruption. -} linkKey' :: VerifyConfig -> Key -> Key -> Annex Bool linkKey' v oldkey newkey = - getViaTmpFromDisk RetrievalAllKeysSecure v newkey (AssociatedFile Nothing) $ \tmp -> unVerified $ do + getViaTmpFromDisk RetrievalAllKeysSecure v newkey $ \tmp -> unVerified $ do oldobj <- calcRepo (gitAnnexLocation oldkey) isJust <$> linkOrCopy' (return True) newkey oldobj tmp Nothing diff --git a/Command/RecvKey.hs b/Command/RecvKey.hs index b1cd926236..c3f0eb3289 100644 --- a/Command/RecvKey.hs +++ b/Command/RecvKey.hs @@ -28,7 +28,7 @@ start :: (SeekInput, Key) -> CommandStart start (_, key) = fieldTransfer Download key $ \_p -> do -- This matches the retrievalSecurityPolicy of Remote.Git let rsp = RetrievalAllKeysSecure - ifM (getViaTmp rsp DefaultVerify key (AssociatedFile Nothing) Nothing go) + ifM (getViaTmp rsp DefaultVerify key Nothing go) ( do logStatus NoLiveUpdate key InfoPresent _ <- quiesce True diff --git a/Command/Reinject.hs b/Command/Reinject.hs index 7ea45623fb..0e5d2651d3 100644 --- a/Command/Reinject.hs +++ b/Command/Reinject.hs @@ -129,7 +129,7 @@ perform src key = do ) where move = checkDiskSpaceToGet key Nothing False $ - moveAnnex key (AssociatedFile Nothing) src + moveAnnex key src cleanup :: Key -> CommandCleanup cleanup key = do diff --git a/Command/SetKey.hs b/Command/SetKey.hs index b7db0200df..0026f82295 100644 --- a/Command/SetKey.hs +++ b/Command/SetKey.hs @@ -36,7 +36,7 @@ perform file key = do -- the file might be on a different filesystem, so moveFile is used -- rather than simply calling moveAnnex; disk space is also -- checked this way. - ok <- getViaTmp RetrievalAllKeysSecure DefaultVerify key (AssociatedFile Nothing) Nothing $ \dest -> unVerified $ + ok <- getViaTmp RetrievalAllKeysSecure DefaultVerify key Nothing $ \dest -> unVerified $ if dest /= file then liftIO $ catchBoolIO $ do moveFile file dest diff --git a/Command/TestRemote.hs b/Command/TestRemote.hs index b35ee6ecb2..3bc161d3fe 100644 --- a/Command/TestRemote.hs +++ b/Command/TestRemote.hs @@ -301,7 +301,7 @@ test runannex mkr mkk = Just verifier -> do loc <- Annex.calcRepo (gitAnnexLocation k) verifier k loc - get r k = logStatusAfter NoLiveUpdate k $ getViaTmp (Remote.retrievalSecurityPolicy r) (RemoteVerify r) k (AssociatedFile Nothing) Nothing $ \dest -> + get r k = logStatusAfter NoLiveUpdate k $ getViaTmp (Remote.retrievalSecurityPolicy r) (RemoteVerify r) k Nothing $ \dest -> tryNonAsync (Remote.retrieveKeyFile r k (AssociatedFile Nothing) dest nullMeterUpdate (RemoteVerify r)) >>= \case Right v -> return (True, v) Left _ -> return (False, UnVerified) @@ -375,13 +375,13 @@ testUnavailable runannex mkr mkk = , check (`notElem` [Right True, Right False]) "checkPresent" $ \r k -> Remote.checkPresent r k , check (== Right False) "retrieveKeyFile" $ \r k -> - logStatusAfter NoLiveUpdate k $ getViaTmp (Remote.retrievalSecurityPolicy r) (RemoteVerify r) k (AssociatedFile Nothing) Nothing $ \dest -> + logStatusAfter NoLiveUpdate k $ getViaTmp (Remote.retrievalSecurityPolicy r) (RemoteVerify r) k Nothing $ \dest -> tryNonAsync (Remote.retrieveKeyFile r k (AssociatedFile Nothing) dest nullMeterUpdate (RemoteVerify r)) >>= \case Right v -> return (True, v) Left _ -> return (False, UnVerified) , check (== Right False) "retrieveKeyFileCheap" $ \r k -> case Remote.retrieveKeyFileCheap r of Nothing -> return False - Just a -> logStatusAfter NoLiveUpdate k $ getViaTmp (Remote.retrievalSecurityPolicy r) (RemoteVerify r) k (AssociatedFile Nothing) Nothing $ \dest -> + Just a -> logStatusAfter NoLiveUpdate k $ getViaTmp (Remote.retrievalSecurityPolicy r) (RemoteVerify r) k Nothing $ \dest -> unVerified $ isRight <$> tryNonAsync (a k (AssociatedFile Nothing) dest) ] @@ -443,7 +443,7 @@ randKey sz = withTmpFile (literalOsPath "randkey") $ \f h -> do k <- case Types.Backend.genKey Backend.Hash.testKeyBackend of Just a -> a ks nullMeterUpdate Nothing -> giveup "failed to generate random key (backend problem)" - _ <- moveAnnex k (AssociatedFile Nothing) f + _ <- moveAnnex k f return k getReadonlyKey :: Remote -> OsPath -> Annex Key diff --git a/Command/TransferKey.hs b/Command/TransferKey.hs index 9732e7d656..2425082305 100644 --- a/Command/TransferKey.hs +++ b/Command/TransferKey.hs @@ -63,7 +63,7 @@ toPerform key af remote = go Upload af $ fromPerform :: Key -> AssociatedFile -> Remote -> CommandPerform fromPerform key af remote = go Upload af $ download' (uuid remote) key af Nothing stdRetry $ \p -> - logStatusAfter NoLiveUpdate key $ getViaTmp (retrievalSecurityPolicy remote) vc key af Nothing $ \t -> + logStatusAfter NoLiveUpdate key $ getViaTmp (retrievalSecurityPolicy remote) vc key Nothing $ \t -> tryNonAsync (Remote.retrieveKeyFile remote key af t p vc) >>= \case Right v -> return (True, v) Left e -> do diff --git a/Command/TransferKeys.hs b/Command/TransferKeys.hs index f06a687c71..07a0051ed0 100644 --- a/Command/TransferKeys.hs +++ b/Command/TransferKeys.hs @@ -50,7 +50,7 @@ start = do return True | otherwise = notifyTransfer direction af $ download' (Remote.uuid remote) key af Nothing stdRetry $ \p -> - logStatusAfter NoLiveUpdate key $ getViaTmp (Remote.retrievalSecurityPolicy remote) (RemoteVerify remote) key af Nothing $ \t -> do + logStatusAfter NoLiveUpdate key $ getViaTmp (Remote.retrievalSecurityPolicy remote) (RemoteVerify remote) key Nothing $ \t -> do r <- tryNonAsync (Remote.retrieveKeyFile remote key af t p (RemoteVerify remote)) >>= \case Left e -> do warning (UnquotedString (show e)) diff --git a/Command/Transferrer.hs b/Command/Transferrer.hs index f84f783597..a87fedd2b2 100644 --- a/Command/Transferrer.hs +++ b/Command/Transferrer.hs @@ -55,7 +55,7 @@ start = do -- so caller is responsible for doing notification -- and for retrying, and updating location log, -- and stall canceling. - let go p = getViaTmp (Remote.retrievalSecurityPolicy remote) (RemoteVerify remote) key af Nothing $ \t -> do + let go p = getViaTmp (Remote.retrievalSecurityPolicy remote) (RemoteVerify remote) key Nothing $ \t -> do Remote.verifiedAction (Remote.retrieveKeyFile remote key af t p (RemoteVerify remote)) in download' (Remote.uuid remote) key af Nothing noRetry go noNotification @@ -72,7 +72,7 @@ start = do runner (AssistantDownloadRequest _ key (TransferAssociatedFile file)) remote = notifyTransfer Download file $ download' (Remote.uuid remote) key file Nothing stdRetry $ \p -> - logStatusAfter NoLiveUpdate key $ getViaTmp (Remote.retrievalSecurityPolicy remote) (RemoteVerify remote) key file Nothing $ \t -> do + logStatusAfter NoLiveUpdate key $ getViaTmp (Remote.retrievalSecurityPolicy remote) (RemoteVerify remote) key Nothing $ \t -> do r <- tryNonAsync (Remote.retrieveKeyFile remote key file t p (RemoteVerify remote)) >>= \case Left e -> do warning (UnquotedString (show e)) diff --git a/P2P/Annex.hs b/P2P/Annex.hs index a6beb64eb3..15a829550b 100644 --- a/P2P/Annex.hs +++ b/P2P/Annex.hs @@ -81,7 +81,7 @@ runLocal runst runner a = case a of iv <- startVerifyKeyContentIncrementally DefaultVerify k let runtransfer ti = Right <$> transfer download' k af Nothing (\p -> - logStatusAfter NoLiveUpdate k $ getViaTmp rsp DefaultVerify k af Nothing $ \tmp -> + logStatusAfter NoLiveUpdate k $ getViaTmp rsp DefaultVerify k Nothing $ \tmp -> storefile tmp o l getb iv validitycheck p ti) let fallback = return $ Left $ ProtoFailureMessage "transfer already in progress, or unable to take transfer lock" diff --git a/Remote/Git.hs b/Remote/Git.hs index 71c6571554..cda705cb0e 100644 --- a/Remote/Git.hs +++ b/Remote/Git.hs @@ -682,7 +682,7 @@ copyToRemote' repo r st@(State connpool duc _ _ _) key af o meterupdate let checksuccess = liftIO checkio >>= \case Just err -> giveup err Nothing -> return True - logStatusAfter NoLiveUpdate key $ Annex.Content.getViaTmp rsp verify key af (Just sz) $ \dest -> + logStatusAfter NoLiveUpdate key $ Annex.Content.getViaTmp rsp verify key (Just sz) $ \dest -> metered (Just (combineMeterUpdate meterupdate p)) key bwlimit $ \_ p' -> copier object dest key p' checksuccess verify ) diff --git a/Upgrade/V0.hs b/Upgrade/V0.hs index ea8c8e7de9..a5cf83e36e 100644 --- a/Upgrade/V0.hs +++ b/Upgrade/V0.hs @@ -25,8 +25,7 @@ upgrade = do olddir <- fromRepo gitAnnexDir keys <- getKeysPresent0 olddir forM_ keys $ \k -> - moveAnnex k (AssociatedFile Nothing) - (olddir toOsPath (keyFile0 k)) + moveAnnex k (olddir toOsPath (keyFile0 k)) -- update the symlinks to the key files -- No longer needed here; V1.upgrade does the same thing diff --git a/Upgrade/V1.hs b/Upgrade/V1.hs index b9ae3af8a8..d0aaba73a3 100644 --- a/Upgrade/V1.hs +++ b/Upgrade/V1.hs @@ -85,7 +85,7 @@ moveContent = do let d = parentDir f liftIO $ allowWrite d liftIO $ allowWrite f - _ <- moveAnnex k (AssociatedFile Nothing) f + _ <- moveAnnex k f liftIO $ removeDirectory d updateSymlinks :: Annex ()