62e152f210
Checksum as content is received from a remote git-annex repository, rather than doing it in a second pass. Not tested at all yet, but I imagine it will work! Not implemented for any special remotes, and also not implemented for copies from local remotes. It may be that, for local remotes, it will suffice to use rsync, rely on its checksumming, and simply return Verified. (It would still make a checksumming pass when cp is used for COW, I guess.)
77 lines
2.6 KiB
Haskell
77 lines
2.6 KiB
Haskell
{- Helpers for remotes using the git-annex P2P protocol.
|
|
-
|
|
- Copyright 2016-2021 Joey Hess <id@joeyh.name>
|
|
-
|
|
- Licensed under the GNU AGPL version 3 or higher.
|
|
-}
|
|
|
|
{-# LANGUAGE RankNTypes #-}
|
|
|
|
module Remote.Helper.P2P where
|
|
|
|
import Annex.Common
|
|
import qualified P2P.Protocol as P2P
|
|
import P2P.IO
|
|
import Types.Remote
|
|
import Annex.Content
|
|
import Messages.Progress
|
|
import Utility.Metered
|
|
import Types.NumCopies
|
|
import Backend
|
|
|
|
import Control.Concurrent
|
|
|
|
-- Runs a Proto action using a connection it sets up.
|
|
type ProtoRunner a = P2P.Proto a -> Annex (Maybe a)
|
|
|
|
-- Runs a Proto action using a ClosableConnection.
|
|
type ProtoConnRunner c = forall a. P2P.Proto a -> ClosableConnection c -> Annex (ClosableConnection c, Maybe a)
|
|
|
|
-- Runs an Annex action with a connection from the pool, adding it back to
|
|
-- the pool when done.
|
|
type WithConn a c = (ClosableConnection c -> Annex (ClosableConnection c, a)) -> Annex a
|
|
|
|
store :: (MeterUpdate -> ProtoRunner Bool) -> Key -> AssociatedFile -> MeterUpdate -> Annex ()
|
|
store runner k af p = do
|
|
let sizer = KeySizer k (fmap (toRawFilePath . fst) <$> prepSendAnnex k)
|
|
metered (Just p) sizer $ \_ p' ->
|
|
runner p' (P2P.put k af p') >>= \case
|
|
Just True -> return ()
|
|
Just False -> giveup "transfer failed"
|
|
Nothing -> remoteUnavail
|
|
|
|
retrieve :: VerifyConfig -> (MeterUpdate -> ProtoRunner (Bool, Verification)) -> Key -> AssociatedFile -> FilePath -> MeterUpdate -> Annex Verification
|
|
retrieve verifyconfig runner k af dest p = do
|
|
iv <- startVerifyKeyContentIncrementally verifyconfig k
|
|
metered (Just p) k $ \m p' ->
|
|
runner p' (P2P.get dest k iv af m p') >>= \case
|
|
Just (True, v) -> return v
|
|
Just (False, _) -> giveup "transfer failed"
|
|
Nothing -> remoteUnavail
|
|
|
|
remove :: ProtoRunner Bool -> Key -> Annex ()
|
|
remove runner k = runner (P2P.remove k) >>= \case
|
|
Just True -> return ()
|
|
Just False -> giveup "removing content from remote failed"
|
|
Nothing -> remoteUnavail
|
|
|
|
checkpresent :: ProtoRunner Bool -> Key -> Annex Bool
|
|
checkpresent runner k = maybe remoteUnavail return =<< runner (P2P.checkPresent k)
|
|
|
|
lock :: WithConn a c -> ProtoConnRunner c -> UUID -> Key -> (VerifiedCopy -> Annex a) -> Annex a
|
|
lock withconn connrunner u k callback = withconn $ \conn -> do
|
|
connv <- liftIO $ newMVar conn
|
|
let runproto d p = do
|
|
c <- liftIO $ takeMVar connv
|
|
(c', mr) <- connrunner p c
|
|
liftIO $ putMVar connv c'
|
|
return (fromMaybe d mr)
|
|
r <- P2P.lockContentWhile runproto k go
|
|
conn' <- liftIO $ takeMVar connv
|
|
return (conn', r)
|
|
where
|
|
go False = giveup "can't lock content"
|
|
go True = withVerifiedCopy LockedCopy u (return True) callback
|
|
|
|
remoteUnavail :: a
|
|
remoteUnavail = giveup "can't connect to remote"
|