blob: 272489755b0c1bff8bc4fafd4ba97c65e2e78564 (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
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
|
