Remote.Git removeKey works with annex+http urls

Does not yet handle drop proof lock timestamp checking.

diff --git a/P2P/Http/Client.hs b/P2P/Http/Client.hs
index ed0773ddd999a0ae7990108caec70ccabee6a8c0..5d6d3f420a12a01d9ab172d24b25068e204e96ed 100644 (file)
--- a/P2P/Http/Client.hs
+++ b/P2P/Http/Client.hs
@@ -210,29 +210,26 @@ clientCheckPresent _ = ()
 
 #ifdef WITH_SERVANT
 clientRemove
-       :: ClientEnv
-       -> ProtocolVersion
-       -> B64Key
-       -> B64UUID ServerSide
-       -> B64UUID ClientSide
-       -> [B64UUID Bypass]
-       -> Maybe Auth
-       -> IO RemoveResultPlus
-clientRemove clientenv (ProtocolVersion ver) key su cu bypass auth =
-       withClientM cli clientenv $ \case
-               Left err -> throwM err
-               Right res -> return res
+       :: Maybe SafeDropProof
+       -> Key
+       -> ClientAction RemoveResultPlus
+clientRemove proof k clientenv (ProtocolVersion ver) su cu bypass auth =
+       liftIO $ withClientM cli clientenv return
   where
+       bk = B64Key k
+
        cli = case ver of
-               3 -> v3 su V3 key cu bypass auth
-               2 -> v2 su V2 key cu bypass auth
-               1 -> plus <$> v1 su V1 key cu bypass auth
-               0 -> plus <$> v0 su V0 key cu bypass auth
+               3 -> v3 su V3 bk cu bypass auth
+               2 -> v2 su V2 bk cu bypass auth
+               1 -> plus <$> v1 su V1 bk cu bypass auth
+               0 -> plus <$> v0 su V0 bk cu bypass auth
                _ -> error "unsupported protocol version"
        
        _ :<|> _ :<|> _ :<|> _ :<|>
                _ :<|> _ :<|> _ :<|> _ :<|>
                v3 :<|> v2 :<|> v1 :<|> v0 :<|> _ = client p2pHttpAPI
+#else
+clientRemove _ _ = ()
 #endif
 
 #ifdef WITH_SERVANT

diff --git a/Remote/Git.hs b/Remote/Git.hs
index a52884fee48ad60bf1f259bc7eb3b0c11bbb370c..8edb5f544995d60f4240882cf359b54f9971774d 100644 (file)
--- a/Remote/Git.hs
+++ b/Remote/Git.hs
@@ -475,11 +475,17 @@ dropKey r st proof key = do
 
 dropKey' :: Git.Repo -> Remote -> State -> Maybe SafeDropProof -> Key -> Annex ()
 dropKey' repo r st@(State connpool duc _ _ _) proof key
+       | isP2PHttp r = p2pHttpClient r giveup (clientRemove proof key) >>= \case
+               RemoveResultPlus True fanoutuuids ->
+                       storefanout fanoutuuids
+               RemoveResultPlus False fanoutuuids -> do
+                       storefanout fanoutuuids
+                       giveup "removing content from remote failed"
        | not $ Git.repoIsUrl repo = ifM duc
                ( guardUsable repo (giveup "cannot access remote") removelocal
                , giveup "remote does not have expected annex.uuid value"
                )
-       | Git.repoIsHttp repo = giveup "dropping from http remote not supported"
+       | Git.repoIsHttp repo = giveup "dropping from this remote is not supported"
        | otherwise = P2PHelper.remove (uuid r) p2prunner proof key
   where
        p2prunner = Ssh.runProto r connpool (return (Right False, Nothing))
@@ -505,6 +511,8 @@ dropKey' repo r st@(State connpool duc _ _ _) proof key
                                )
                unless proofunexpired
                        safeDropProofExpired
+                       
+       storefanout = P2PHelper.storeFanout key InfoMissing (uuid r) . map fromB64UUID
 
 lockKey :: Remote -> State -> Key -> (VerifiedCopy -> Annex r) -> Annex r
 lockKey r st key callback = do
@@ -570,7 +578,7 @@ copyFromRemote'' repo r st@(State connpool _ _ _ _) key af dest meterupdate vc
                        (gitconfig r)
                        (Ssh.runProto r connpool (return (False, UnVerified)))
                        key af dest meterupdate vc
-       | otherwise = giveup "copying from non-ssh, non-http remote not supported"
+       | otherwise = giveup "copying from this remote is not supported"
   where
        bwlimit = remoteAnnexBwLimitDownload (gitconfig r)
                <|> remoteAnnexBwLimit (gitconfig r)
@@ -674,14 +682,15 @@ copyToRemote' repo r st@(State connpool duc _ _ _) key af o meterupdate
                                        res <- p2pHttpClient r giveup $
                                                clientPut p' key (Just offset) af object sz check'
                                        case res of
-                                               PutResultPlus False _ ->
+                                               PutResultPlus False fanoutuuids -> do
+                                                       storefanout fanoutuuids
                                                        failedsend
                                                PutResultPlus True fanoutuuids ->
                                                        storefanout fanoutuuids
                        PutOffsetResultAlreadyHavePlus fanoutuuids ->
                                storefanout fanoutuuids
        
-       storefanout = P2PHelper.storeFanout key (uuid r) . map fromB64UUID
+       storefanout = P2PHelper.storeFanout key InfoPresent (uuid r) . map fromB64UUID
 
 fsckOnRemote :: Git.Repo -> [CommandParam] -> Annex (IO Bool)
 fsckOnRemote r params

diff --git a/Remote/Helper/P2P.hs b/Remote/Helper/P2P.hs
index 9f614970417829b4e67fdc8b2777ee75b2af8569..a0b18646a0460183edc0701c1f59f6945e3ace91 100644 (file)
--- a/Remote/Helper/P2P.hs
+++ b/Remote/Helper/P2P.hs
@@ -43,17 +43,15 @@ store remoteuuid gc runner k af o p = do
        metered (Just p) sizer bwlimit $ \_ p' ->
                runner (P2P.put k af p') >>= \case
                        Just (Just fanoutuuids) -> 
-                               storeFanout k remoteuuid fanoutuuids
+                               storeFanout k InfoPresent remoteuuid fanoutuuids
                        Just Nothing -> giveup "Transfer failed"
                        Nothing -> remoteUnavail
 
-storeFanout :: Key -> UUID -> [UUID] -> Annex ()
-storeFanout k remoteuuid us = 
-       -- Storing on the remote can cause it to be stored on additional UUIDs, 
-       -- so record those.
+storeFanout :: Key -> LogStatus -> UUID -> [UUID] -> Annex ()
+storeFanout k logstatus remoteuuid us = 
        forM_ us $ \u ->
                when (u /= remoteuuid) $
-                       logChange k u InfoPresent
+                       logChange k u logstatus
 
 retrieve :: RemoteGitConfig -> (ProtoRunner (Bool, Verification)) -> Key -> AssociatedFile -> FilePath -> MeterUpdate -> VerifyConfig -> Annex Verification
 retrieve gc runner k af dest p verifyconfig = do
@@ -67,20 +65,16 @@ retrieve gc runner k af dest p verifyconfig = do
 
 remove :: UUID -> ProtoRunner (Either String Bool, Maybe [UUID]) -> Maybe SafeDropProof -> Key -> Annex ()
 remove remoteuuid runner proof k = runner (P2P.remove proof k) >>= \case
-       Just (Right True, alsoremoveduuids) -> note alsoremoveduuids
+       Just (Right True, alsoremoveduuids) -> 
+               storeFanout k InfoMissing remoteuuid
+                       (fromMaybe [] alsoremoveduuids)
        Just (Right False, alsoremoveduuids) -> do
-               note alsoremoveduuids
+               storeFanout k InfoMissing remoteuuid
+                       (fromMaybe [] alsoremoveduuids)
                giveup "removing content from remote failed"
        Just (Left err, _) -> do
                giveup (safeOutput err)
        Nothing -> remoteUnavail
-  where
-       -- The remote reports removal from other UUIDs than its own,
-       -- so record those.
-       note alsoremoveduuids = 
-               forM_ (fromMaybe [] alsoremoveduuids) $ \u ->
-                       when (u /= remoteuuid) $
-                               logChange k u InfoMissing
 
 checkpresent :: ProtoRunner (Either String Bool) -> Key -> Annex Bool
 checkpresent runner k =

diff --git a/doc/todo/git-annex_proxies.mdwn b/doc/todo/git-annex_proxies.mdwn
index d5cb62fc01a1a8681d9c441e1a3fcacc2326be9e..529092b4db289776d451a2c01e02b83524405531 100644 (file)
--- a/doc/todo/git-annex_proxies.mdwn
+++ b/doc/todo/git-annex_proxies.mdwn
@@ -28,7 +28,9 @@ Planned schedule of work:
 
 ## work notes
 
-* Rest of Remote.Git needs implementing: drop, lock
+* Drop needs to check the proof and use timestamps.
+
+* Rest of Remote.Git needs implementing: lock
 
 * A Locker should expire the lock on its own after 10 minutes,
   initially. Once keeplocked is called, the lock will expire at the end