diff options
author | 2012-11-29 14:49:20 -0400 | |
---|---|---|
committer | 2012-11-29 15:23:33 -0400 | |
commit | 1407c1afd2e4a86ddd58d403cd49782784a60fcd (patch) | |
tree | c74142fcf43bece5ab21a7b0f9bdac5205d6f5dc /Assistant/Threads/Glacier.hs | |
parent | ba7112ebba31192941671192fa28392101d46b98 (diff) |
assistant: Retrival from glacier now handled.
Diffstat (limited to 'Assistant/Threads/Glacier.hs')
-rw-r--r-- | Assistant/Threads/Glacier.hs | 43 |
1 files changed, 43 insertions, 0 deletions
diff --git a/Assistant/Threads/Glacier.hs b/Assistant/Threads/Glacier.hs new file mode 100644 index 000000000..3ccb57cbe --- /dev/null +++ b/Assistant/Threads/Glacier.hs @@ -0,0 +1,43 @@ +{- git-annex assistant Amazon Glacier retrieval + - + - Copyright 2012 Joey Hess <joey@kitenet.net> + - + - Licensed under the GNU GPL version 3 or higher. + -} + +{-# LANGUAGE CPP #-} +{-# LANGUAGE OverloadedStrings #-} + +module Assistant.Threads.Glacier where + +import Assistant.Common +import Utility.ThreadScheduler +import qualified Types.Remote as Remote +import qualified Remote.Glacier as Glacier +import Logs.Transfer +import Assistant.DaemonStatus +import Assistant.TransferQueue + +import qualified Data.Set as S + +{- Wakes up every half hour and checks if any glacier remotes have failed + - downloads. If so, runs glacier-cli to check if the files are now + - available, and queues the downloads. -} +glacierThread :: NamedThread +glacierThread = NamedThread "Glacier" $ runEvery (Seconds 3600) <~> go + where + isglacier r = Remote.remotetype r == Glacier.remote + go = do + rs <- filter isglacier . syncDataRemotes <$> getDaemonStatus + forM_ rs $ \r -> + check r =<< (liftAnnex $ getFailedTransfers $ Remote.uuid r) + check _ [] = noop + check r l = do + let keys = map getkey l + (availkeys, failedkeys) <- liftAnnex $ Glacier.jobList r keys + let s = S.fromList (failedkeys ++ availkeys) + let l' = filter (\p -> S.member (getkey p) s) l + forM_ l' $ \(t, info) -> do + liftAnnex $ removeFailedTransfer t + queueTransferWhenSmall (associatedFile info) t r + getkey = transferKey . fst |