make retrieveKeyFile and retrieveKeyFileCheap throw exceptions
Converted retrieveKeyFileCheap to a Maybe, to avoid needing to throw a exception when a remote doesn't support it.
This commit is contained in:
parent
a6adea4aaf
commit
d9c7f81ba4
32 changed files with 247 additions and 245 deletions
|
@ -189,15 +189,19 @@ downloadRemoteFile addunlockedmatcher r o uri file sz = checkCanAdd file $ do
|
|||
-- so that the remote knows what url it
|
||||
-- should use to download it.
|
||||
setTempUrl urlkey loguri
|
||||
let downloader = \dest p -> fst
|
||||
<$> Remote.retrieveKeyFile r urlkey
|
||||
(AssociatedFile (Just (toRawFilePath file))) dest p
|
||||
let downloader = \dest p ->
|
||||
tryNonAsync (Remote.retrieveKeyFile r urlkey af dest p) >>= \case
|
||||
Right _ -> return True
|
||||
Left e -> do
|
||||
warning (show e)
|
||||
return False
|
||||
ret <- downloadWith addunlockedmatcher downloader urlkey (Remote.uuid r) loguri file
|
||||
removeTempUrl urlkey
|
||||
return ret
|
||||
)
|
||||
where
|
||||
loguri = setDownloader uri OtherDownloader
|
||||
af = AssociatedFile (Just (toRawFilePath file))
|
||||
|
||||
startWeb :: AddUnlockedMatcher -> AddUrlOptions -> URLString -> CommandStart
|
||||
startWeb addunlockedmatcher o urlstring = go $ fromMaybe bad $ parseURI urlstring
|
||||
|
|
|
@ -41,6 +41,7 @@ import Data.Time.Clock.POSIX
|
|||
import System.Posix.Types (EpochTime)
|
||||
import qualified Data.Set as S
|
||||
import qualified Data.Map as M
|
||||
import Data.Either
|
||||
|
||||
cmd :: Command
|
||||
cmd = withGlobalOptions [jobsOption, jsonOptions, annexedMatchingOptions] $
|
||||
|
@ -174,17 +175,20 @@ performRemote key afile backend numcopies remote =
|
|||
cleanup
|
||||
cleanup `after` a tmp
|
||||
getfile tmp = ifM (checkDiskSpace (Just (takeDirectory tmp)) key 0 True)
|
||||
( ifM (Remote.retrieveKeyFileCheap remote key afile tmp)
|
||||
( ifM (getcheap tmp)
|
||||
( return (Just True)
|
||||
, ifM (Annex.getState Annex.fast)
|
||||
( return Nothing
|
||||
, Just . fst <$>
|
||||
Remote.retrieveKeyFile remote key (AssociatedFile Nothing) tmp dummymeter
|
||||
, Just . isRight <$> tryNonAsync (getfile' tmp)
|
||||
)
|
||||
)
|
||||
, return (Just False)
|
||||
)
|
||||
getfile' tmp = Remote.retrieveKeyFile remote key (AssociatedFile Nothing) tmp dummymeter
|
||||
dummymeter _ = noop
|
||||
getcheap tmp = case Remote.retrieveKeyFileCheap remote of
|
||||
Just a -> isRight <$> tryNonAsync (a key afile tmp)
|
||||
Nothing -> return False
|
||||
|
||||
startKey :: Maybe Remote -> Incremental -> (Key, ActionItem) -> NumCopies -> CommandStart
|
||||
startKey from inc (key, ai) numcopies =
|
||||
|
|
|
@ -112,5 +112,9 @@ getKey' key afile = dispatch
|
|||
download (Remote.uuid r) key afile stdRetry
|
||||
(\p -> do
|
||||
showAction $ "from " ++ Remote.name r
|
||||
Remote.retrieveKeyFile r key afile dest p
|
||||
tryNonAsync (Remote.retrieveKeyFile r key afile dest p) >>= \case
|
||||
Right v -> return (True, v)
|
||||
Left e -> do
|
||||
warning (show e)
|
||||
return (False, UnVerified)
|
||||
) witness
|
||||
|
|
|
@ -207,7 +207,11 @@ fromPerform src removewhen key afile = do
|
|||
go = notifyTransfer Download afile $
|
||||
download (Remote.uuid src) key afile stdRetry $ \p ->
|
||||
getViaTmp (Remote.retrievalSecurityPolicy src) (RemoteVerify src) key $ \t ->
|
||||
Remote.retrieveKeyFile src key afile t p
|
||||
tryNonAsync (Remote.retrieveKeyFile src key afile t p) >>= \case
|
||||
Right v -> return (True, v)
|
||||
Left e -> do
|
||||
warning (show e)
|
||||
return (False, UnVerified)
|
||||
dispatch _ _ False = stop -- failed
|
||||
dispatch RemoveNever _ True = next $ return True -- copy complete
|
||||
dispatch RemoveSafe deststartedwithcopy True = lockContentShared key $ \_lck -> do
|
||||
|
|
|
@ -274,8 +274,9 @@ test runannex mkr mkk =
|
|||
Nothing -> return True
|
||||
Just verifier -> verifier k (serializeKey k)
|
||||
get r k = getViaTmp (Remote.retrievalSecurityPolicy r) (RemoteVerify r) k $ \dest ->
|
||||
Remote.retrieveKeyFile r k (AssociatedFile Nothing)
|
||||
dest nullMeterUpdate
|
||||
tryNonAsync (Remote.retrieveKeyFile r k (AssociatedFile Nothing) dest nullMeterUpdate) >>= \case
|
||||
Right v -> return (True, v)
|
||||
Left _ -> return (False, UnVerified)
|
||||
store r k = Remote.storeKey r k (AssociatedFile Nothing) nullMeterUpdate
|
||||
remove r k = Remote.removeKey r k
|
||||
|
||||
|
@ -348,10 +349,14 @@ testUnavailable runannex mkr mkk =
|
|||
Remote.checkPresent r k
|
||||
, check (== Right False) "retrieveKeyFile" $ \r k ->
|
||||
getViaTmp (Remote.retrievalSecurityPolicy r) (RemoteVerify r) k $ \dest ->
|
||||
Remote.retrieveKeyFile r k (AssociatedFile Nothing) dest nullMeterUpdate
|
||||
, check (== Right False) "retrieveKeyFileCheap" $ \r k ->
|
||||
getViaTmp (Remote.retrievalSecurityPolicy r) (RemoteVerify r) k $ \dest -> unVerified $
|
||||
Remote.retrieveKeyFileCheap r k (AssociatedFile Nothing) dest
|
||||
tryNonAsync (Remote.retrieveKeyFile r k (AssociatedFile Nothing) dest nullMeterUpdate) >>= \case
|
||||
Right v -> return (True, v)
|
||||
Left _ -> return (False, UnVerified)
|
||||
, check (== Right False) "retrieveKeyFileCheap" $ \r k -> case Remote.retrieveKeyFileCheap r of
|
||||
Nothing -> return False
|
||||
Just a -> getViaTmp (Remote.retrievalSecurityPolicy r) (RemoteVerify r) k $ \dest ->
|
||||
unVerified $ isRight
|
||||
<$> tryNonAsync (a k (AssociatedFile Nothing) dest)
|
||||
]
|
||||
where
|
||||
check checkval desc a = testCase desc $
|
||||
|
|
|
@ -53,18 +53,22 @@ toPerform :: Key -> AssociatedFile -> Remote -> CommandPerform
|
|||
toPerform key file remote = go Upload file $
|
||||
upload (uuid remote) key file stdRetry $ \p -> do
|
||||
tryNonAsync (Remote.storeKey remote key file p) >>= \case
|
||||
Left e -> do
|
||||
warning (show e)
|
||||
return False
|
||||
Right () -> do
|
||||
Remote.logStatus remote key InfoPresent
|
||||
return True
|
||||
Left e -> do
|
||||
warning (show e)
|
||||
return False
|
||||
|
||||
fromPerform :: Key -> AssociatedFile -> Remote -> CommandPerform
|
||||
fromPerform key file remote = go Upload file $
|
||||
download (uuid remote) key file stdRetry $ \p ->
|
||||
getViaTmp (retrievalSecurityPolicy remote) (RemoteVerify remote) key $
|
||||
\t -> Remote.retrieveKeyFile remote key file t p
|
||||
getViaTmp (retrievalSecurityPolicy remote) (RemoteVerify remote) key $ \t ->
|
||||
tryNonAsync (Remote.retrieveKeyFile remote key file t p) >>= \case
|
||||
Right v -> return (True, v)
|
||||
Left e -> do
|
||||
warning (show e)
|
||||
return (False, UnVerified)
|
||||
|
||||
go :: Direction -> AssociatedFile -> (NotifyWitness -> Annex Bool) -> CommandPerform
|
||||
go direction file a = notifyTransfer direction file a >>= liftIO . exitBool
|
||||
|
|
|
@ -48,7 +48,11 @@ start = do
|
|||
| otherwise = notifyTransfer direction file $
|
||||
download (Remote.uuid remote) key file stdRetry $ \p ->
|
||||
getViaTmp (Remote.retrievalSecurityPolicy remote) (RemoteVerify remote) key $ \t -> do
|
||||
r <- Remote.retrieveKeyFile remote key file t p
|
||||
r <- tryNonAsync (Remote.retrieveKeyFile remote key file t p) >>= \case
|
||||
Left e -> do
|
||||
warning (show e)
|
||||
return (False, UnVerified)
|
||||
Right v -> return (True, v)
|
||||
-- Make sure we get the current
|
||||
-- associated files data for the key,
|
||||
-- not old cached data.
|
||||
|
|
Loading…
Add table
Add a link
Reference in a new issue