blob: 818cde2030db21415833bf96989acc1f026d9e2e (
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
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
|
{- Amazon S3 remotes.
-
- Copyright 2011 Joey Hess <joey@kitenet.net>
-
- Licensed under the GNU GPL version 3 or higher.
-}
module Remote.S3 (generate) where
import qualified Data.Map as Map
import Data.String.Utils
import Control.Monad (filterM, liftM)
import RemoteClass
import Types
import qualified GitRepo as Git
import qualified Annex
import UUID
import Config
generate :: Annex (RemoteGenerator Annex)
generate = do
g <- Annex.gitRepo
remotes <- filterM remoteNotIgnored $ findS3Remotes g
todo <- filterM cachedUUID remotes
let ok = filter (`notElem` todo) remotes
let actions = map genRemote ok ++
map (\r -> genRemote =<< tryS3ConfigRead r) todo
return (actions, map Git.repoDescribe todo)
where
cachedUUID r = liftM null $ getUUID r
genRemote :: Git.Repo -> Annex (Remote Annex)
genRemote r = do
return Remote {
uuid = error "TODO",
cost = error "TODO",
name = Git.repoDescribe r,
storeKey = error "TODO",
retrieveKeyFile = error "TODO",
removeKey = error "TODO",
hasKey = error "TODO",
hasKeyCheap = False
}
{- S3 remotes have a remote.<name>.annex-s3bucket config setting.
- Git.Repo does not normally generate remotes for things that
- have no configured url, so the Git.Repo objects have to be
- constructed as coming from an unknown location. -}
findS3Remotes :: Git.Repo -> [Git.Repo]
findS3Remotes r = map construct remotepairs
where
remotepairs = Map.toList $ filterremotes $ Git.configMap r
filterremotes = Map.filterWithKey (\k _ -> s3remote k)
construct (k,_) = Git.repoRemoteNameSet Git.repoFromUnknown k
s3remote k = startswith "remote." k && endswith ".annex-s3bucket" k
tryS3ConfigRead :: Git.Repo -> Annex Git.Repo
tryS3ConfigRead r = error "TODO"
|
