cleanup
This commit is contained in:
parent
1e37c0c5fc
commit
7a86dc9443
2 changed files with 17 additions and 18 deletions
|
@ -65,35 +65,25 @@ transferScannerThread st dstatus scanremotes transferqueue = thread $ do
|
||||||
{- This is a cheap scan for failed transfers involving a remote. -}
|
{- This is a cheap scan for failed transfers involving a remote. -}
|
||||||
failedTransferScan :: ThreadState -> DaemonStatusHandle -> TransferQueue -> Remote -> IO ()
|
failedTransferScan :: ThreadState -> DaemonStatusHandle -> TransferQueue -> Remote -> IO ()
|
||||||
failedTransferScan st dstatus transferqueue r = do
|
failedTransferScan st dstatus transferqueue r = do
|
||||||
ts <- runThreadState st $
|
failed <- runThreadState st $ getFailedTransfers (Remote.uuid r)
|
||||||
getFailedTransfers $ Remote.uuid r
|
runThreadState st $ mapM_ removeFailedTransfer $ map fst failed
|
||||||
go ts
|
mapM_ retry failed
|
||||||
where
|
where
|
||||||
go [] = noop
|
retry (t, info)
|
||||||
go ((t, info):ts)
|
|
||||||
| transferDirection t == Download = do
|
| transferDirection t == Download = do
|
||||||
{- Check if the remote still has the key.
|
{- Check if the remote still has the key.
|
||||||
- If not, relies on the expensiveScan to
|
- If not, relies on the expensiveScan to
|
||||||
- get it queued from some other remote. -}
|
- get it queued from some other remote. -}
|
||||||
ifM (runThreadState st $ remoteHas r $ transferKey t)
|
whenM (runThreadState st $ remoteHas r $ transferKey t) $
|
||||||
( requeue t info
|
requeue t info
|
||||||
, dequeue t
|
|
||||||
)
|
|
||||||
go ts
|
|
||||||
| otherwise = do
|
| otherwise = do
|
||||||
{- The Transferrer checks when uploading
|
{- The Transferrer checks when uploading
|
||||||
- that the remote doesn't already have the
|
- that the remote doesn't already have the
|
||||||
- key, so it's not redundantly checked
|
- key, so it's not redundantly checked
|
||||||
- here. -}
|
- here. -}
|
||||||
requeue t info
|
requeue t info
|
||||||
go ts
|
requeue t info = queueTransferWhenSmall
|
||||||
|
transferqueue dstatus (associatedFile info) t r
|
||||||
requeue t info = do
|
|
||||||
queueTransferWhenSmall
|
|
||||||
transferqueue dstatus (associatedFile info) t r
|
|
||||||
dequeue t
|
|
||||||
dequeue t = void $ runThreadState st $ inRepo $
|
|
||||||
liftIO . tryIO . removeFile . failedTransferFile t
|
|
||||||
|
|
||||||
{- This is a expensive scan through the full git work tree, finding
|
{- This is a expensive scan through the full git work tree, finding
|
||||||
- files to download from or upload to any of the remotes.
|
- files to download from or upload to any of the remotes.
|
||||||
|
|
|
@ -10,6 +10,7 @@ module Logs.Transfer where
|
||||||
import Common.Annex
|
import Common.Annex
|
||||||
import Annex.Perms
|
import Annex.Perms
|
||||||
import Annex.Exception
|
import Annex.Exception
|
||||||
|
import Annex.UUID
|
||||||
import qualified Git
|
import qualified Git
|
||||||
import Types.Remote
|
import Types.Remote
|
||||||
import Types.Key
|
import Types.Key
|
||||||
|
@ -48,6 +49,9 @@ data TransferInfo = TransferInfo
|
||||||
}
|
}
|
||||||
deriving (Show, Eq, Ord)
|
deriving (Show, Eq, Ord)
|
||||||
|
|
||||||
|
stubTransferInfo :: TransferInfo
|
||||||
|
stubTransferInfo = TransferInfo Nothing Nothing Nothing Nothing Nothing Nothing False
|
||||||
|
|
||||||
data Direction = Upload | Download
|
data Direction = Upload | Download
|
||||||
deriving (Eq, Ord, Read, Show)
|
deriving (Eq, Ord, Read, Show)
|
||||||
|
|
||||||
|
@ -164,6 +168,11 @@ getFailedTransfers u = catMaybes <$> (liftIO . getpairs =<< concat <$> findfiles
|
||||||
=<< mapM (fromRepo . failedTransferDir u)
|
=<< mapM (fromRepo . failedTransferDir u)
|
||||||
[Download, Upload]
|
[Download, Upload]
|
||||||
|
|
||||||
|
removeFailedTransfer :: Transfer -> Annex ()
|
||||||
|
removeFailedTransfer t = do
|
||||||
|
f <- fromRepo $ failedTransferFile t
|
||||||
|
liftIO $ void $ tryIO $ removeFile f
|
||||||
|
|
||||||
{- The transfer information file to use for a given Transfer. -}
|
{- The transfer information file to use for a given Transfer. -}
|
||||||
transferFile :: Transfer -> Git.Repo -> FilePath
|
transferFile :: Transfer -> Git.Repo -> FilePath
|
||||||
transferFile (Transfer direction u key) r = transferDir direction r
|
transferFile (Transfer direction u key) r = transferDir direction r
|
||||||
|
|
Loading…
Add table
Add a link
Reference in a new issue