mirrors/git-annex
2
0
Fork 0
Code Issues Pull requests Projects Releases Packages 1 Wiki Activity Actions

add optional object file location to storeKey

Browse source 
This will be used by the next commit to simplify the proxy.
This commit is contained in:
Joey Hess 2024-07-01 10:42:27 -04:00
parent 0dfdc9f951
commit 8b5fc94d50
No known key found for this signature in database
GPG key ID: DB12DB0FF05F8F38
20 changed files with 93 additions and 79 deletions
Download patch file Download diff file Expand all files Collapse all files

2
Command/Export.hs
View file

@ -304,7 +304,7 @@ performExport r db ek af contentsha loc allfilledvar = do
alwaysUpload (uuid r) ek af Nothing stdRetry $ \pm -> do
let rollback = void $
performUnexport r db [ek] loc
sendAnnex ek rollback $ \f _sz ->
sendAnnex ek Nothing rollback $ \f _sz ->
Remote.action $
storer f ek loc pm
, do

2
Command/SendKey.hs
View file

@ -32,7 +32,7 @@ start (_, key) = do
<$> getField "RsyncOptions"
ifM (inAnnex key)
( fieldTransfer Upload key $ \_p ->
sendAnnex key rollback $ \f _sz ->
sendAnnex key Nothing rollback $ \f _sz ->
liftIO $ rsyncServerSend (map Param opts) f
, do
warning "requested key is not present"

4
Command/TestRemote.hs
View file

@ -302,7 +302,7 @@ test runannex mkr mkk =
tryNonAsync (Remote.retrieveKeyFile r k (AssociatedFile Nothing) (fromRawFilePath dest) nullMeterUpdate (RemoteVerify r)) >>= \case
Right v -> return (True, v)
Left _ -> return (False, UnVerified)
store r k = Remote.storeKey r k (AssociatedFile Nothing) nullMeterUpdate
store r k = Remote.storeKey r k (AssociatedFile Nothing) Nothing nullMeterUpdate
remove r k = Remote.removeKey r k
testExportTree :: RunAnnex -> Annex (Maybe Remote) -> Annex Key -> Annex Key -> [TestTree]
@ -368,7 +368,7 @@ testUnavailable runannex mkr mkk =
[ check isLeft "removeKey" $ \r k ->
Remote.removeKey r k
, check isLeft "storeKey" $ \r k ->
Remote.storeKey r k (AssociatedFile Nothing) nullMeterUpdate
Remote.storeKey r k (AssociatedFile Nothing) Nothing nullMeterUpdate
, check (`notElem` [Right True, Right False]) "checkPresent" $ \r k ->
Remote.checkPresent r k
, check (== Right False) "retrieveKeyFile" $ \r k ->

14
Command/TransferKey.hs
View file

@ -50,9 +50,9 @@ start o (_, key) = startingCustomOutput key $ case fromToOptions o of
FromRemote src -> fromPerform key (fileOption o) =<< getParsed src
toPerform :: Key -> AssociatedFile -> Remote -> CommandPerform
toPerform key file remote = go Upload file $
upload' (uuid remote) key file Nothing stdRetry $ \p -> do
tryNonAsync (Remote.storeKey remote key file p) >>= \case
toPerform key af remote = go Upload af $
upload' (uuid remote) key af Nothing stdRetry $ \p -> do
tryNonAsync (Remote.storeKey remote key af Nothing p) >>= \case
Right () -> do
Remote.logStatus remote key InfoPresent
return True
@ -61,10 +61,10 @@ toPerform key file remote = go Upload file $
return False
fromPerform :: Key -> AssociatedFile -> Remote -> CommandPerform
fromPerform key file remote = go Upload file $
download' (uuid remote) key file Nothing stdRetry $ \p ->
logStatusAfter key $ getViaTmp (retrievalSecurityPolicy remote) vc key file Nothing $ \t ->
tryNonAsync (Remote.retrieveKeyFile remote key file (fromRawFilePath t) p vc) >>= \case
fromPerform key af remote = go Upload af $
download' (uuid remote) key af Nothing stdRetry $ \p ->
logStatusAfter key $ getViaTmp (retrievalSecurityPolicy remote) vc key af Nothing $ \t ->
tryNonAsync (Remote.retrieveKeyFile remote key af (fromRawFilePath t) p vc) >>= \case
Right v -> return (True, v)
Left e -> do
warning (UnquotedString (show e))

16
Command/TransferKeys.hs
View file

@ -38,20 +38,20 @@ start = do
runRequests readh writeh runner
stop
where
runner (TransferRequest direction remote key file)
| direction == Upload = notifyTransfer direction file $
upload' (Remote.uuid remote) key file Nothing stdRetry $ \p -> do
tryNonAsync (Remote.storeKey remote key file p) >>= \case
runner (TransferRequest direction remote key af)
| direction == Upload = notifyTransfer direction af $
upload' (Remote.uuid remote) key af Nothing stdRetry $ \p -> do
tryNonAsync (Remote.storeKey remote key af Nothing p) >>= \case
Left e -> do
warning (UnquotedString (show e))
return False
Right () -> do
Remote.logStatus remote key InfoPresent
return True
| otherwise = notifyTransfer direction file $
download' (Remote.uuid remote) key file Nothing stdRetry $ \p ->
logStatusAfter key $ getViaTmp (Remote.retrievalSecurityPolicy remote) (RemoteVerify remote) key file Nothing $ \t -> do
r <- tryNonAsync (Remote.retrieveKeyFile remote key file (fromRawFilePath t) p (RemoteVerify remote)) >>= \case
| otherwise = notifyTransfer direction af $
download' (Remote.uuid remote) key af Nothing stdRetry $ \p ->
logStatusAfter key $ getViaTmp (Remote.retrievalSecurityPolicy remote) (RemoteVerify remote) key af Nothing $ \t -> do
r <- tryNonAsync (Remote.retrieveKeyFile remote key af (fromRawFilePath t) p (RemoteVerify remote)) >>= \case
Left e -> do
warning (UnquotedString (show e))
return (False, UnVerified)

22
Command/Transferrer.hs
View file

@ -42,27 +42,27 @@ start = do
runRequests readh writeh runner
stop
where
runner (UploadRequest _ key (TransferAssociatedFile file)) remote =
runner (UploadRequest _ key (TransferAssociatedFile af)) remote =
-- This is called by eg, Annex.Transfer.upload,
-- so caller is responsible for doing notification,
-- and for retrying, and updating location log,
-- and stall canceling.
upload' (Remote.uuid remote) key file Nothing noRetry
(Remote.action . Remote.storeKey remote key file)
upload' (Remote.uuid remote) key af Nothing noRetry
(Remote.action . Remote.storeKey remote key af Nothing)
noNotification
runner (DownloadRequest _ key (TransferAssociatedFile file)) remote =
runner (DownloadRequest _ key (TransferAssociatedFile af)) remote =
-- This is called by eg, Annex.Transfer.download
-- so caller is responsible for doing notification
-- and for retrying, and updating location log,
-- and stall canceling.
let go p = getViaTmp (Remote.retrievalSecurityPolicy remote) (RemoteVerify remote) key file Nothing $ \t -> do
Remote.verifiedAction (Remote.retrieveKeyFile remote key file (fromRawFilePath t) p (RemoteVerify remote))
in download' (Remote.uuid remote) key file Nothing noRetry go
let go p = getViaTmp (Remote.retrievalSecurityPolicy remote) (RemoteVerify remote) key af Nothing $ \t -> do
Remote.verifiedAction (Remote.retrieveKeyFile remote key af (fromRawFilePath t) p (RemoteVerify remote))
in download' (Remote.uuid remote) key af Nothing noRetry go
noNotification
runner (AssistantUploadRequest _ key (TransferAssociatedFile file)) remote =
notifyTransfer Upload file $
upload' (Remote.uuid remote) key file Nothing stdRetry $ \p -> do
tryNonAsync (Remote.storeKey remote key file p) >>= \case
runner (AssistantUploadRequest _ key (TransferAssociatedFile af)) remote =
notifyTransfer Upload af $
upload' (Remote.uuid remote) key af Nothing stdRetry $ \p -> do
tryNonAsync (Remote.storeKey remote key af Nothing p) >>= \case
Left e -> do
warning (UnquotedString (show e))
return False