diff options
author | Joey Hess <joey@kitenet.net> | 2012-07-05 10:21:22 -0600 |
---|---|---|
committer | Joey Hess <joey@kitenet.net> | 2012-07-05 10:21:22 -0600 |
commit | 83c66ccaf88a10e8f4b16fc2162cbed2656b95e0 (patch) | |
tree | 6b1807e02096a81c96f788d3fd4305f89ea2018e /Assistant/TransferQueue.hs | |
parent | b0894f00c075e4dd93a692880e8eb0ea865b6c28 (diff) |
queue Uploads of newly added files to remotes
Added knownRemotes to DaemonStatus. This list is not entirely trivial to
calculate, and having it here should make it easier to add/remove remotes
on the fly later on. It did require plumbing the daemonstatus through to
some more threads.
Diffstat (limited to 'Assistant/TransferQueue.hs')
-rw-r--r-- | Assistant/TransferQueue.hs | 29 |
1 files changed, 22 insertions, 7 deletions
diff --git a/Assistant/TransferQueue.hs b/Assistant/TransferQueue.hs index 979cbb80f..fc25b057d 100644 --- a/Assistant/TransferQueue.hs +++ b/Assistant/TransferQueue.hs @@ -8,9 +8,10 @@ module Assistant.TransferQueue where import Common.Annex -import Utility.TSet +import Assistant.DaemonStatus import Logs.Transfer import Types.Remote +import qualified Remote import Control.Concurrent.STM @@ -28,15 +29,29 @@ stubInfo f = TransferInfo , associatedFile = f } +{- Adds pending transfers to the end of the queue for some of the known + - remotes. (TBD: a smaller set of remotes that are sufficient to transfer to, + - rather than transferring to all.) -} +queueTransfers :: TransferQueue -> DaemonStatusHandle -> Key -> AssociatedFile -> Direction -> Annex () +queueTransfers q daemonstatus k f direction = + mapM_ (liftIO . queueTransfer q f . gentransfer) + =<< knownRemotes <$> getDaemonStatus daemonstatus + where + gentransfer r = Transfer + { transferDirection = direction + , transferKey = k + , transferRemote = Remote.uuid r + } + {- Adds a pending transfer to the end of the queue. -} -queueTransfer :: TransferQueue -> Transfer -> AssociatedFile -> IO () -queueTransfer q transfer f = void $ atomically $ - writeTChan q (transfer, stubInfo f) +queueTransfer :: TransferQueue -> AssociatedFile -> Transfer -> IO () +queueTransfer q f t = void $ atomically $ + writeTChan q (t, stubInfo f) {- Adds a pending transfer to the start of the queue, to be processed next. -} -queueNextTransfer :: TransferQueue -> Transfer -> AssociatedFile -> IO () -queueNextTransfer q transfer f = void $ atomically $ - unGetTChan q (transfer, stubInfo f) +queueNextTransfer :: TransferQueue -> AssociatedFile -> Transfer -> IO () +queueNextTransfer q f t = void $ atomically $ + unGetTChan q (t, stubInfo f) {- Blocks until a pending transfer is available in the queue. -} getNextTransfer :: TransferQueue -> IO (Transfer, TransferInfo) |