blob: 2fd025df178aa60e6f19f13e4cdb06468e90a4da (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
|
{- git-annex assistant Amazon Glacier retrieval
-
- Copyright 2012 Joey Hess <id@joeyh.name>
-
- 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 Types.Transfer
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 . downloadRemotes <$> 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 "object available from glacier" (associatedFile info) t r
getkey = transferKey . fst
|
