refactor p2p remote action code
Make a Remote.Helper.P2P using code that was in Remote.P2P, converted to use generic protocol runner actions. This will allow it to be reused in Remote.Git. This commit was sponsored by mo on Patreon.
This commit is contained in:
parent
c036a380b2
commit
16af259209
4 changed files with 83 additions and 55 deletions
67
Remote/Helper/P2P.hs
Normal file
67
Remote/Helper/P2P.hs
Normal file
|
@ -0,0 +1,67 @@
|
|||
{- Helpers for remotes using the git-annex P2P protocol.
|
||||
-
|
||||
- Copyright 2016-2018 Joey Hess <id@joeyh.name>
|
||||
-
|
||||
- Licensed under the GNU GPL 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 Config.Cost
|
||||
import Messages.Progress
|
||||
import Utility.Metered
|
||||
import Types.NumCopies
|
||||
|
||||
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 :: ProtoRunner Bool -> Key -> AssociatedFile -> MeterUpdate -> Annex Bool
|
||||
store runner k af p = do
|
||||
let getsrcfile = fmap fst <$> prepSendAnnex k
|
||||
metered (Just p) k getsrcfile $ \p' ->
|
||||
fromMaybe False
|
||||
<$> runner (P2P.put k af p')
|
||||
|
||||
retrieve :: ProtoRunner Bool -> Key -> AssociatedFile -> FilePath -> MeterUpdate -> Annex (Bool, Verification)
|
||||
retrieve runner k af dest p = unVerified $
|
||||
metered (Just p) k (return Nothing) $ \p' -> fromMaybe False
|
||||
<$> runner (P2P.get dest k af p')
|
||||
|
||||
remove :: ProtoRunner Bool -> Key -> Annex Bool
|
||||
remove runner k = fromMaybe False <$> runner (P2P.remove k)
|
||||
|
||||
checkpresent :: ProtoRunner Bool -> Key -> Annex Bool
|
||||
checkpresent runner k = maybe unavail return =<< runner (P2P.checkPresent k)
|
||||
where
|
||||
unavail = giveup "can't connect to remote"
|
||||
|
||||
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
|
Loading…
Add table
Add a link
Reference in a new issue