plumb in LiveUpdate (WIP)
Each command that first checks preferred content (and/or required content) and then does something that can change the sizes of repositories needs to call prepareLiveUpdate, and plumb it through the preferred content check and the location log update. So far, only Command.Drop is done. Many other commands that don't need to do this have been updated to keep working. There may be some calls to NoLiveUpdate in places where that should be done. All will need to be double checked. Not currently in a compilable state.
This commit is contained in:
parent
4885073377
commit
c3d40b9ec3
58 changed files with 363 additions and 247 deletions
|
@ -95,7 +95,7 @@ seek' o = do
|
|||
annexdotfiles <- getGitConfigVal annexDotFiles
|
||||
let gofile includingsmall (si, file) = case largeFilesOverride o of
|
||||
Nothing -> ifM (pure (annexdotfiles || not (dotfile file))
|
||||
<&&> (checkFileMatcher largematcher file
|
||||
<&&> (checkFileMatcher NoLiveUpdate largematcher file
|
||||
<||> Annex.getRead Annex.force))
|
||||
( start dr si file addunlockedmatcher
|
||||
, if includingsmall
|
||||
|
@ -267,5 +267,5 @@ cleanup :: Key -> Bool -> CommandCleanup
|
|||
cleanup key hascontent = do
|
||||
maybeShowJSON $ JSONChunk [("key", serializeKey key)]
|
||||
when hascontent $
|
||||
logStatus key InfoPresent
|
||||
logStatus NoLiveUpdate key InfoPresent
|
||||
return True
|
||||
|
|
|
@ -32,7 +32,7 @@ start = startUnused go (other "bad") (other "tmp")
|
|||
(ActionItemTreeFile file)
|
||||
(SeekInput [show n]) $
|
||||
next $ do
|
||||
logStatus key InfoPresent
|
||||
logStatus NoLiveUpdate key InfoPresent
|
||||
addSymlink file key Nothing
|
||||
return True
|
||||
|
||||
|
|
|
@ -323,7 +323,7 @@ addUrlChecked o url file u checkexistssize key =
|
|||
Just (exists, samesize, url')
|
||||
| exists && (samesize || relaxedOption (downloadOptions o)) -> do
|
||||
setUrlPresent key url'
|
||||
logChange key u InfoPresent
|
||||
logChange NoLiveUpdate key u InfoPresent
|
||||
next $ return True
|
||||
| otherwise -> do
|
||||
warning $ UnquotedString $ "while adding a new url to an already annexed file, " ++ if exists
|
||||
|
@ -511,7 +511,7 @@ addWorkTree _ addunlockedmatcher u url file key mtmp = case mtmp of
|
|||
createWorkTreeDirectory (P.takeDirectory file)
|
||||
liftIO $ moveFile tmp file
|
||||
largematcher <- largeFilesMatcher
|
||||
large <- checkFileMatcher largematcher file
|
||||
large <- checkFileMatcher NoLiveUpdate largematcher file
|
||||
if large
|
||||
then do
|
||||
-- Move back to tmp because addAnnexedFile
|
||||
|
@ -525,11 +525,11 @@ addWorkTree _ addunlockedmatcher u url file key mtmp = case mtmp of
|
|||
go = do
|
||||
maybeShowJSON $ JSONChunk [("key", serializeKey key)]
|
||||
setUrlPresent key url
|
||||
logChange key u InfoPresent
|
||||
logChange NoLiveUpdate key u InfoPresent
|
||||
ifM (addAnnexedFile addunlockedmatcher file key mtmp)
|
||||
( do
|
||||
when (isJust mtmp) $
|
||||
logStatus key InfoPresent
|
||||
logStatus NoLiveUpdate key InfoPresent
|
||||
, maybe noop (\tmp -> pruneTmpWorkDirBefore tmp (liftIO . removeWhenExistsWith R.removeLink)) mtmp
|
||||
)
|
||||
|
||||
|
|
|
@ -83,15 +83,17 @@ start o from si file key = start' o from key afile ai si
|
|||
ai = mkActionItem (key, afile)
|
||||
|
||||
start' :: DropOptions -> Maybe Remote -> Key -> AssociatedFile -> ActionItem -> SeekInput -> CommandStart
|
||||
start' o from key afile ai si =
|
||||
checkDropAuto (autoMode o) from afile key $ \numcopies mincopies ->
|
||||
stopUnless wantdrop $
|
||||
start' o from key afile ai si = do
|
||||
checkDropAuto (autoMode o) from afile key $ \numcopies mincopies -> do
|
||||
lu <- prepareLiveUpdate remoteuuid key RemovingKey
|
||||
stopUnless (wantdrop lu) $
|
||||
case from of
|
||||
Nothing -> startLocal pcc afile ai si numcopies mincopies key [] ud
|
||||
Just remote -> startRemote pcc afile ai si numcopies mincopies key ud remote
|
||||
Nothing -> startLocal lu pcc afile ai si numcopies mincopies key [] ud
|
||||
Just remote -> startRemote lu pcc afile ai si numcopies mincopies key ud remote
|
||||
where
|
||||
wantdrop
|
||||
| autoMode o = wantDrop False (Remote.uuid <$> from) (Just key) afile Nothing
|
||||
remoteuuid = Remote.uuid <$> from
|
||||
wantdrop lu
|
||||
| autoMode o = wantDrop lu False remoteuuid (Just key) afile Nothing
|
||||
| otherwise = return True
|
||||
pcc = PreferredContentChecked (autoMode o)
|
||||
ud = case (batchOption o, keyOptions o) of
|
||||
|
@ -101,22 +103,22 @@ start' o from key afile ai si =
|
|||
startKeys :: DropOptions -> Maybe Remote -> (SeekInput, Key, ActionItem) -> CommandStart
|
||||
startKeys o from (si, key, ai) = start' o from key (AssociatedFile Nothing) ai si
|
||||
|
||||
startLocal :: PreferredContentChecked -> AssociatedFile -> ActionItem -> SeekInput -> NumCopies -> MinCopies -> Key -> [VerifiedCopy] -> DroppingUnused -> CommandStart
|
||||
startLocal pcc afile ai si numcopies mincopies key preverified ud =
|
||||
startLocal :: LiveUpdate -> PreferredContentChecked -> AssociatedFile -> ActionItem -> SeekInput -> NumCopies -> MinCopies -> Key -> [VerifiedCopy] -> DroppingUnused -> CommandStart
|
||||
startLocal lu pcc afile ai si numcopies mincopies key preverified ud =
|
||||
starting "drop" (OnlyActionOn key ai) si $
|
||||
performLocal pcc key afile numcopies mincopies preverified ud
|
||||
performLocal lu pcc key afile numcopies mincopies preverified ud
|
||||
|
||||
startRemote :: PreferredContentChecked -> AssociatedFile -> ActionItem -> SeekInput -> NumCopies -> MinCopies -> Key -> DroppingUnused -> Remote -> CommandStart
|
||||
startRemote pcc afile ai si numcopies mincopies key ud remote =
|
||||
startRemote :: LiveUpdate -> PreferredContentChecked -> AssociatedFile -> ActionItem -> SeekInput -> NumCopies -> MinCopies -> Key -> DroppingUnused -> Remote -> CommandStart
|
||||
startRemote lu pcc afile ai si numcopies mincopies key ud remote =
|
||||
starting "drop" (OnlyActionOn key ai) si $ do
|
||||
showAction $ UnquotedString $ "from " ++ Remote.name remote
|
||||
performRemote pcc key afile numcopies mincopies remote ud
|
||||
performRemote lu pcc key afile numcopies mincopies remote ud
|
||||
|
||||
performLocal :: PreferredContentChecked -> Key -> AssociatedFile -> NumCopies -> MinCopies -> [VerifiedCopy] -> DroppingUnused -> CommandPerform
|
||||
performLocal pcc key afile numcopies mincopies preverified ud = lockContentForRemoval key fallback $ \contentlock -> do
|
||||
performLocal :: LiveUpdate -> PreferredContentChecked -> Key -> AssociatedFile -> NumCopies -> MinCopies -> [VerifiedCopy] -> DroppingUnused -> CommandPerform
|
||||
performLocal lu pcc key afile numcopies mincopies preverified ud = lockContentForRemoval key fallback $ \contentlock -> do
|
||||
u <- getUUID
|
||||
(tocheck, verified) <- verifiableCopies key [u]
|
||||
doDrop pcc u (Just contentlock) key afile numcopies mincopies [] (preverified ++ verified) tocheck
|
||||
doDrop lu pcc u (Just contentlock) key afile numcopies mincopies [] (preverified ++ verified) tocheck
|
||||
( \proof -> do
|
||||
fastDebug "Command.Drop" $ unwords
|
||||
[ "Dropping from here"
|
||||
|
@ -125,7 +127,7 @@ performLocal pcc key afile numcopies mincopies preverified ud = lockContentForRe
|
|||
]
|
||||
removeAnnex contentlock
|
||||
notifyDrop afile True
|
||||
next $ cleanupLocal key ud
|
||||
next $ cleanupLocal lu key ud
|
||||
, do
|
||||
notifyDrop afile False
|
||||
stop
|
||||
|
@ -136,14 +138,14 @@ performLocal pcc key afile numcopies mincopies preverified ud = lockContentForRe
|
|||
-- is present, but due to buffering, may find it present for the
|
||||
-- second file before the first is dropped. If so, nothing remains
|
||||
-- to be done except for cleaning up.
|
||||
fallback = next $ cleanupLocal key ud
|
||||
fallback = next $ cleanupLocal lu key ud
|
||||
|
||||
performRemote :: PreferredContentChecked -> Key -> AssociatedFile -> NumCopies -> MinCopies -> Remote -> DroppingUnused -> CommandPerform
|
||||
performRemote pcc key afile numcopies mincopies remote ud = do
|
||||
performRemote :: LiveUpdate -> PreferredContentChecked -> Key -> AssociatedFile -> NumCopies -> MinCopies -> Remote -> DroppingUnused -> CommandPerform
|
||||
performRemote lu pcc key afile numcopies mincopies remote ud = do
|
||||
-- Filter the uuid it's being dropped from out of the lists of
|
||||
-- places assumed to have the key, and places to check.
|
||||
(tocheck, verified) <- verifiableCopies key [uuid]
|
||||
doDrop pcc uuid Nothing key afile numcopies mincopies [uuid] verified tocheck
|
||||
doDrop lu pcc uuid Nothing key afile numcopies mincopies [uuid] verified tocheck
|
||||
( \proof -> do
|
||||
fastDebug "Command.Drop" $ unwords
|
||||
[ "Dropping from remote"
|
||||
|
@ -152,21 +154,21 @@ performRemote pcc key afile numcopies mincopies remote ud = do
|
|||
, show proof
|
||||
]
|
||||
ok <- Remote.action (Remote.removeKey remote proof key)
|
||||
next $ cleanupRemote key remote ud ok
|
||||
next $ cleanupRemote lu key remote ud ok
|
||||
, stop
|
||||
)
|
||||
where
|
||||
uuid = Remote.uuid remote
|
||||
|
||||
cleanupLocal :: Key -> DroppingUnused -> CommandCleanup
|
||||
cleanupLocal key ud = do
|
||||
logStatus key (dropStatus ud)
|
||||
cleanupLocal :: LiveUpdate -> Key -> DroppingUnused -> CommandCleanup
|
||||
cleanupLocal lu key ud = do
|
||||
logStatus lu key (dropStatus ud)
|
||||
return True
|
||||
|
||||
cleanupRemote :: Key -> Remote -> DroppingUnused -> Bool -> CommandCleanup
|
||||
cleanupRemote key remote ud ok = do
|
||||
cleanupRemote :: LiveUpdate -> Key -> Remote -> DroppingUnused -> Bool -> CommandCleanup
|
||||
cleanupRemote lu key remote ud ok = do
|
||||
when ok $
|
||||
Remote.logStatus remote key (dropStatus ud)
|
||||
Remote.logStatus lu remote key (dropStatus ud)
|
||||
return ok
|
||||
|
||||
{- Set when the user explicitly chose to operate on unused content.
|
||||
|
@ -189,7 +191,8 @@ dropStatus (DroppingUnused True) = InfoDead
|
|||
- --force overrides and always allows dropping.
|
||||
-}
|
||||
doDrop
|
||||
:: PreferredContentChecked
|
||||
:: LiveUpdate
|
||||
-> PreferredContentChecked
|
||||
-> UUID
|
||||
-> Maybe ContentRemovalLock
|
||||
-> Key
|
||||
|
@ -201,10 +204,10 @@ doDrop
|
|||
-> [UnVerifiedCopy]
|
||||
-> (Maybe SafeDropProof -> CommandPerform, CommandPerform)
|
||||
-> CommandPerform
|
||||
doDrop pcc dropfrom contentlock key afile numcopies mincopies skip preverified check (dropaction, nodropaction) =
|
||||
doDrop lu pcc dropfrom contentlock key afile numcopies mincopies skip preverified check (dropaction, nodropaction) =
|
||||
ifM (Annex.getRead Annex.force)
|
||||
( dropaction Nothing
|
||||
, ifM (checkRequiredContent pcc dropfrom key afile)
|
||||
, ifM (checkRequiredContent lu pcc dropfrom key afile)
|
||||
( verifyEnoughCopiesToDrop nolocmsg key (Just dropfrom)
|
||||
contentlock numcopies mincopies
|
||||
skip preverified check
|
||||
|
@ -225,10 +228,10 @@ doDrop pcc dropfrom contentlock key afile numcopies mincopies skip preverified c
|
|||
- providing this avoids that extra work. -}
|
||||
newtype PreferredContentChecked = PreferredContentChecked Bool
|
||||
|
||||
checkRequiredContent :: PreferredContentChecked -> UUID -> Key -> AssociatedFile -> Annex Bool
|
||||
checkRequiredContent (PreferredContentChecked True) _ _ _ = return True
|
||||
checkRequiredContent (PreferredContentChecked False) u k afile =
|
||||
checkDrop isRequiredContent False (Just u) (Just k) afile Nothing >>= \case
|
||||
checkRequiredContent :: LiveUpdate -> PreferredContentChecked -> UUID -> Key -> AssociatedFile -> Annex Bool
|
||||
checkRequiredContent _ (PreferredContentChecked True) _ _ _ = return True
|
||||
checkRequiredContent lu (PreferredContentChecked False) u k afile =
|
||||
checkDrop isRequiredContent lu False (Just u) (Just k) afile Nothing >>= \case
|
||||
Nothing -> return True
|
||||
Just afile' -> do
|
||||
if afile == afile'
|
||||
|
|
|
@ -55,5 +55,5 @@ perform key = ifM (inAnnex key)
|
|||
|
||||
cleanup :: Key -> CommandCleanup
|
||||
cleanup key = do
|
||||
logStatus key InfoMissing
|
||||
logStatus NoLiveUpdate key InfoMissing
|
||||
return True
|
||||
|
|
|
@ -57,7 +57,8 @@ perform :: Maybe Remote -> NumCopies -> MinCopies -> Key -> CommandPerform
|
|||
perform from numcopies mincopies key = case from of
|
||||
Just r -> do
|
||||
showAction $ UnquotedString $ "from " ++ Remote.name r
|
||||
Command.Drop.performRemote pcc key (AssociatedFile Nothing) numcopies mincopies r ud
|
||||
Command.Drop.performRemote NoLiveUpdate pcc key
|
||||
(AssociatedFile Nothing) numcopies mincopies r ud
|
||||
Nothing -> ifM (inAnnex key)
|
||||
( droplocal
|
||||
, ifM (objectFileExists key)
|
||||
|
@ -71,7 +72,8 @@ perform from numcopies mincopies key = case from of
|
|||
)
|
||||
)
|
||||
where
|
||||
droplocal = Command.Drop.performLocal pcc key (AssociatedFile Nothing) numcopies mincopies [] ud
|
||||
droplocal = Command.Drop.performLocal NoLiveUpdate pcc
|
||||
key (AssociatedFile Nothing) numcopies mincopies [] ud
|
||||
pcc = Command.Drop.PreferredContentChecked False
|
||||
ud = Command.Drop.DroppingUnused True
|
||||
|
||||
|
|
|
@ -334,12 +334,12 @@ verifyLocationLog key keystatus ai = do
|
|||
whenM (annexSecureHashesOnly <$> Annex.getGitConfig) $
|
||||
warning $ "** Despite annex.securehashesonly being set, " <> QuotedPath obj <> " has content present in the annex using an insecure " <> UnquotedString (decodeBS (formatKeyVariety (fromKey keyVariety key))) <> " key"
|
||||
|
||||
verifyLocationLog' key ai present u (logChange key u)
|
||||
verifyLocationLog' key ai present u (logChange NoLiveUpdate key u)
|
||||
|
||||
verifyLocationLogRemote :: Key -> ActionItem -> Remote -> Bool -> Annex Bool
|
||||
verifyLocationLogRemote key ai remote present =
|
||||
verifyLocationLog' key ai present (Remote.uuid remote)
|
||||
(Remote.logStatus remote key)
|
||||
(Remote.logStatus NoLiveUpdate remote key)
|
||||
|
||||
verifyLocationLog' :: Key -> ActionItem -> Bool -> UUID -> (LogStatus -> Annex ()) -> Annex Bool
|
||||
verifyLocationLog' key ai present u updatestatus = do
|
||||
|
@ -385,7 +385,7 @@ verifyRequiredContent key ai@(ActionItemAssociatedFile afile _) = case afile of
|
|||
go requiredlocs = do
|
||||
presentlocs <- S.fromList <$> loggedLocations key
|
||||
missinglocs <- filterM
|
||||
(\u -> isRequiredContent (Just u) S.empty (Just key) afile False)
|
||||
(\u -> isRequiredContent NoLiveUpdate (Just u) S.empty (Just key) afile False)
|
||||
(S.toList $ S.difference requiredlocs presentlocs)
|
||||
if null missinglocs
|
||||
then return True
|
||||
|
@ -641,7 +641,7 @@ badContentRemote remote localcopy key = do
|
|||
|
||||
dropped <- tryNonAsync (Remote.removeKey remote Nothing key)
|
||||
when (isRight dropped) $
|
||||
Remote.logStatus remote key InfoMissing
|
||||
Remote.logStatus NoLiveUpdate remote key InfoMissing
|
||||
return $ case (movedbad, dropped) of
|
||||
(True, Right ()) -> "moved from " ++ Remote.name remote ++
|
||||
" to " ++ fromRawFilePath destbad
|
||||
|
|
|
@ -51,7 +51,6 @@ import qualified Limit
|
|||
import Messages.JSON (DualDisp(..), ObjectMap(..))
|
||||
import Annex.BloomFilter
|
||||
import Annex.RepoSize
|
||||
import Types.RepoSize
|
||||
import qualified Command.Unused
|
||||
import qualified Utility.RawFilePath as R
|
||||
|
||||
|
|
|
@ -98,7 +98,7 @@ perform file key = do
|
|||
)
|
||||
Nothing -> lostcontent
|
||||
|
||||
lostcontent = logStatus key InfoMissing
|
||||
lostcontent = logStatus NoLiveUpdate key InfoMissing
|
||||
|
||||
errorModified :: a
|
||||
errorModified = giveup "Locking this file would discard any changes you have made to it. Use 'git annex add' to stage your changes. (Or, use --force to override)"
|
||||
|
|
|
@ -90,7 +90,7 @@ seek o = do
|
|||
, liftIO exitFailure
|
||||
)
|
||||
where
|
||||
checkmatcher matcher = checkMatcher' matcher (matchinfo o) S.empty
|
||||
checkmatcher matcher = checkMatcher' matcher (matchinfo o) NoLiveUpdate S.empty
|
||||
|
||||
bail :: String -> IO a
|
||||
bail s = do
|
||||
|
|
|
@ -174,7 +174,7 @@ update oldkey newkey =
|
|||
starting "migrate" ai (SeekInput []) $
|
||||
ifM (Command.ReKey.linkKey' v oldkey newkey)
|
||||
( do
|
||||
logStatus newkey InfoPresent
|
||||
logStatus NoLiveUpdate newkey InfoPresent
|
||||
next $ return True
|
||||
, next $ return False
|
||||
)
|
||||
|
|
|
@ -213,7 +213,7 @@ storeReceived f = do
|
|||
Nothing -> do
|
||||
warning $ "Received a file " <> QuotedPath (toRawFilePath f) <> " that is not a git-annex key. Deleting this file."
|
||||
liftIO $ removeWhenExistsWith R.removeLink (toRawFilePath f)
|
||||
Just k -> void $ logStatusAfter k $
|
||||
Just k -> void $ logStatusAfter NoLiveUpdate k $
|
||||
getViaTmpFromDisk RetrievalVerifiableKeysSecure AlwaysVerify k (AssociatedFile Nothing) $ \dest -> unVerified $
|
||||
liftIO $ catchBoolIO $ do
|
||||
R.rename (toRawFilePath f) dest
|
||||
|
|
|
@ -149,6 +149,6 @@ cleanup file newkey a = do
|
|||
return (MigrationRecord sha)
|
||||
)
|
||||
whenM (inAnnex newkey) $
|
||||
logStatus newkey InfoPresent
|
||||
logStatus NoLiveUpdate newkey InfoPresent
|
||||
a newkeyrec
|
||||
return True
|
||||
|
|
|
@ -30,7 +30,7 @@ start (_, key) = fieldTransfer Download key $ \_p -> do
|
|||
let rsp = RetrievalAllKeysSecure
|
||||
ifM (getViaTmp rsp DefaultVerify key (AssociatedFile Nothing) Nothing go)
|
||||
( do
|
||||
logStatus key InfoPresent
|
||||
logStatus NoLiveUpdate key InfoPresent
|
||||
_ <- quiesce True
|
||||
return True
|
||||
, return False
|
||||
|
|
|
@ -86,5 +86,5 @@ registerUrl remote key url = do
|
|||
-- does not have an OtherDownloader, but this command needs to do
|
||||
-- it for urls claimed by other remotes as well.
|
||||
case snd (getDownloader url) of
|
||||
OtherDownloader -> logChange key (Remote.uuid remote) InfoPresent
|
||||
OtherDownloader -> logChange NoLiveUpdate key (Remote.uuid remote) InfoPresent
|
||||
_ -> return ()
|
||||
|
|
|
@ -133,5 +133,5 @@ perform src key = do
|
|||
|
||||
cleanup :: Key -> CommandCleanup
|
||||
cleanup key = do
|
||||
logStatus key InfoPresent
|
||||
logStatus NoLiveUpdate key InfoPresent
|
||||
return True
|
||||
|
|
|
@ -48,5 +48,5 @@ perform file key = do
|
|||
|
||||
cleanup :: Key -> CommandCleanup
|
||||
cleanup key = do
|
||||
logStatus key InfoPresent
|
||||
logStatus NoLiveUpdate key InfoPresent
|
||||
return True
|
||||
|
|
|
@ -54,5 +54,5 @@ start si (KeyStatus k u s) = starting "setpresentkey" ai si $ perform k u s
|
|||
|
||||
perform :: Key -> UUID -> LogStatus -> CommandPerform
|
||||
perform k u s = next $ do
|
||||
logChange k u s
|
||||
logChange NoLiveUpdate k u s
|
||||
return True
|
||||
|
|
|
@ -191,7 +191,7 @@ clean' file mk passthrough discardreststdin emitpointer =
|
|||
=<< lockDown cfg (fromRawFilePath file)
|
||||
|
||||
postingest (Just k, _) = do
|
||||
logStatus k InfoPresent
|
||||
logStatus NoLiveUpdate k InfoPresent
|
||||
return k
|
||||
postingest _ = giveup "could not add file to the annex"
|
||||
|
||||
|
@ -248,7 +248,7 @@ shouldAnnex file indexmeta moldkey = do
|
|||
where
|
||||
go = do
|
||||
matcher <- largeFilesMatcher
|
||||
checkFileMatcher' matcher file d
|
||||
checkFileMatcher' NoLiveUpdate matcher file d
|
||||
|
||||
checkwasannexed = pure $ isJust moldkey
|
||||
|
||||
|
|
|
@ -298,7 +298,7 @@ test runannex mkr mkk =
|
|||
Just verifier -> do
|
||||
loc <- Annex.calcRepo (gitAnnexLocation k)
|
||||
verifier k loc
|
||||
get r k = logStatusAfter k $ getViaTmp (Remote.retrievalSecurityPolicy r) (RemoteVerify r) k (AssociatedFile Nothing) Nothing $ \dest ->
|
||||
get r k = logStatusAfter NoLiveUpdate k $ getViaTmp (Remote.retrievalSecurityPolicy r) (RemoteVerify r) k (AssociatedFile Nothing) Nothing $ \dest ->
|
||||
tryNonAsync (Remote.retrieveKeyFile r k (AssociatedFile Nothing) (fromRawFilePath dest) nullMeterUpdate (RemoteVerify r)) >>= \case
|
||||
Right v -> return (True, v)
|
||||
Left _ -> return (False, UnVerified)
|
||||
|
@ -372,13 +372,13 @@ testUnavailable runannex mkr mkk =
|
|||
, check (`notElem` [Right True, Right False]) "checkPresent" $ \r k ->
|
||||
Remote.checkPresent r k
|
||||
, check (== Right False) "retrieveKeyFile" $ \r k ->
|
||||
logStatusAfter k $ getViaTmp (Remote.retrievalSecurityPolicy r) (RemoteVerify r) k (AssociatedFile Nothing) Nothing $ \dest ->
|
||||
logStatusAfter NoLiveUpdate k $ getViaTmp (Remote.retrievalSecurityPolicy r) (RemoteVerify r) k (AssociatedFile Nothing) Nothing $ \dest ->
|
||||
tryNonAsync (Remote.retrieveKeyFile r k (AssociatedFile Nothing) (fromRawFilePath dest) nullMeterUpdate (RemoteVerify r)) >>= \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 -> logStatusAfter k $ getViaTmp (Remote.retrievalSecurityPolicy r) (RemoteVerify r) k (AssociatedFile Nothing) Nothing $ \dest ->
|
||||
Just a -> logStatusAfter NoLiveUpdate k $ getViaTmp (Remote.retrievalSecurityPolicy r) (RemoteVerify r) k (AssociatedFile Nothing) Nothing $ \dest ->
|
||||
unVerified $ isRight
|
||||
<$> tryNonAsync (a k (AssociatedFile Nothing) (fromRawFilePath dest))
|
||||
]
|
||||
|
|
|
@ -54,7 +54,7 @@ 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
|
||||
Remote.logStatus NoLiveUpdate remote key InfoPresent
|
||||
return True
|
||||
Left e -> do
|
||||
warning (UnquotedString (show e))
|
||||
|
@ -63,7 +63,7 @@ toPerform key af remote = go Upload af $
|
|||
fromPerform :: Key -> AssociatedFile -> Remote -> CommandPerform
|
||||
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 ->
|
||||
logStatusAfter NoLiveUpdate 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
|
||||
|
|
|
@ -46,11 +46,11 @@ start = do
|
|||
warning (UnquotedString (show e))
|
||||
return False
|
||||
Right () -> do
|
||||
Remote.logStatus remote key InfoPresent
|
||||
Remote.logStatus NoLiveUpdate remote key InfoPresent
|
||||
return True
|
||||
| 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
|
||||
logStatusAfter NoLiveUpdate 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))
|
||||
|
|
|
@ -67,12 +67,12 @@ start = do
|
|||
warning (UnquotedString (show e))
|
||||
return False
|
||||
Right () -> do
|
||||
Remote.logStatus remote key InfoPresent
|
||||
Remote.logStatus NoLiveUpdate remote key InfoPresent
|
||||
return True
|
||||
runner (AssistantDownloadRequest _ key (TransferAssociatedFile file)) remote =
|
||||
notifyTransfer Download file $
|
||||
download' (Remote.uuid remote) key file Nothing stdRetry $ \p ->
|
||||
logStatusAfter key $ getViaTmp (Remote.retrievalSecurityPolicy remote) (RemoteVerify remote) key file Nothing $ \t -> do
|
||||
logStatusAfter NoLiveUpdate 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
|
||||
Left e -> do
|
||||
warning (UnquotedString (show e))
|
||||
|
|
Loading…
Add table
Add a link
Reference in a new issue