diff options
Diffstat (limited to 'Remote/P2P.hs')
| -rw-r--r-- | Remote/P2P.hs | 66 |
1 files changed, 13 insertions, 53 deletions
diff --git a/Remote/P2P.hs b/Remote/P2P.hs index cfed5c604..95c7f6ede 100644 --- a/Remote/P2P.hs +++ b/Remote/P2P.hs @@ -1,6 +1,6 @@ {- git remotes using the git-annex P2P protocol - - - Copyright 2016 Joey Hess <id@joeyh.name> + - Copyright 2016-2018 Joey Hess <id@joeyh.name> - - Licensed under the GNU GPL version 3 or higher. -} @@ -21,17 +21,13 @@ import Types.Remote import Types.GitConfig import qualified Git import Annex.UUID -import Annex.Content import Config import Config.Cost import Remote.Helper.Git import Remote.Helper.Export -import Messages.Progress -import Utility.Metered +import Remote.Helper.P2P import Utility.AuthToken -import Types.NumCopies -import Control.Concurrent import Control.Concurrent.STM remote :: RemoteType @@ -49,16 +45,18 @@ chainGen :: P2PAddress -> Git.Repo -> UUID -> RemoteConfig -> RemoteGitConfig -> chainGen addr r u c gc = do connpool <- mkConnectionPool cst <- remoteCost gc veryExpensiveRemoteCost + let protorunner = runProto u addr connpool + let withconn = withConnection u addr connpool let this = Remote { uuid = u , cost = cst , name = Git.repoDescribe r - , storeKey = store u addr connpool - , retrieveKeyFile = retrieve u addr connpool + , storeKey = store protorunner + , retrieveKeyFile = retrieve protorunner , retrieveKeyFileCheap = \_ _ _ -> return False - , removeKey = remove u addr connpool - , lockContent = Just (lock u addr connpool) - , checkPresent = checkpresent u addr connpool + , removeKey = remove protorunner + , lockContent = Just $ lock withconn runProtoConn u + , checkPresent = checkpresent protorunner , checkPresentCheap = False , exportActions = exportUnsupported , whereisKey = Nothing @@ -78,44 +76,6 @@ chainGen addr r u c gc = do } return (Just this) -store :: UUID -> P2PAddress -> ConnectionPool -> Key -> AssociatedFile -> MeterUpdate -> Annex Bool -store u addr connpool k af p = do - let getsrcfile = fmap fst <$> prepSendAnnex k - metered (Just p) k getsrcfile $ \p' -> - fromMaybe False - <$> runProto u addr connpool (P2P.put k af p') - -retrieve :: UUID -> P2PAddress -> ConnectionPool -> Key -> AssociatedFile -> FilePath -> MeterUpdate -> Annex (Bool, Verification) -retrieve u addr connpool k af dest p = unVerified $ - metered (Just p) k (return Nothing) $ \p' -> fromMaybe False - <$> runProto u addr connpool (P2P.get dest k af p') - -remove :: UUID -> P2PAddress -> ConnectionPool -> Key -> Annex Bool -remove u addr connpool k = fromMaybe False - <$> runProto u addr connpool (P2P.remove k) - -checkpresent :: UUID -> P2PAddress -> ConnectionPool -> Key -> Annex Bool -checkpresent u addr connpool k = maybe unavail return - =<< runProto u addr connpool (P2P.checkPresent k) - where - unavail = giveup "can't connect to peer" - -lock :: UUID -> P2PAddress -> ConnectionPool -> Key -> (VerifiedCopy -> Annex r) -> Annex r -lock u addr connpool k callback = - withConnection u addr connpool $ \conn -> do - connv <- liftIO $ newMVar conn - let runproto d p = do - c <- liftIO $ takeMVar connv - (c', mr) <- runProto' 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 - -- | A connection to the peer, which can be closed. type Connection = ClosableConnection P2PConnection @@ -126,11 +86,11 @@ mkConnectionPool = liftIO $ newTVarIO [] -- Runs the Proto action. runProto :: UUID -> P2PAddress -> ConnectionPool -> P2P.Proto a -> Annex (Maybe a) -runProto u addr connpool a = withConnection u addr connpool (runProto' a) +runProto u addr connpool a = withConnection u addr connpool (runProtoConn a) -runProto' :: P2P.Proto a -> Connection -> Annex (Connection, Maybe a) -runProto' _ ClosedConnection = return (ClosedConnection, Nothing) -runProto' a (OpenConnection conn) = do +runProtoConn :: P2P.Proto a -> Connection -> Annex (Connection, Maybe a) +runProtoConn _ ClosedConnection = return (ClosedConnection, Nothing) +runProtoConn a (OpenConnection conn) = do v <- runFullProto Client conn a -- When runFullProto fails, the connection is no longer usable, -- so close it. |