webapp: S3 and Glacier forms now have a select list of all currently-supported AWS regions.
This commit is contained in:
Joey Hess
parent
08eedfef5d
commit
0b6c889012
5 changed files with 53 additions and 5 deletions
|
|
@ -49,7 +49,6 @@ instance Show StorageClass where
|
|||
data AWSInput = AWSInput
|
||||
{ accessKeyID :: Text
|
||||
, secretAccessKey :: Text
|
||||
-- Free form text for datacenter because Amazon adds new ones.
|
||||
, datacenter :: Text
|
||||
-- Only used for S3, not Glacier.
|
||||
, storageClass :: StorageClass
|
||||
|
|
@ -65,7 +64,7 @@ s3InputAForm :: AForm WebApp WebApp AWSInput
|
|||
s3InputAForm = AWSInput
|
||||
<$> areq textField "Access Key ID" Nothing
|
||||
<*> areq passwordField "Secret Access Key" Nothing
|
||||
<*> areq textField "Datacenter" (Just "US")
|
||||
<*> areq (selectFieldList $ M.toList $ AWS.regionMap AWS.S3) "Datacenter" (Just $ AWS.defaultRegion AWS.S3)
|
||||
<*> areq (selectFieldList storageclasses) "Storage class" (Just StandardRedundancy)
|
||||
<*> areq textField "Repository name" (Just "S3")
|
||||
where
|
||||
|
|
@ -79,7 +78,7 @@ glacierInputAForm :: AForm WebApp WebApp AWSInput
|
|||
glacierInputAForm = AWSInput
|
||||
<$> areq textField "Access Key ID" Nothing
|
||||
<*> areq passwordField "Secret Access Key" Nothing
|
||||
<*> areq textField "Datacenter" (Just "us-east-1")
|
||||
<*> areq (selectFieldList $ M.toList $ AWS.regionMap AWS.Glacier) "Datacenter" (Just $ AWS.defaultRegion AWS.Glacier)
|
||||
<*> pure StandardRedundancy
|
||||
<*> areq textField "Repository name" (Just "glacier")
|
||||
|
||||
|
|
|
|||
|
|
@ -8,6 +8,7 @@
|
|||
module Remote.Glacier (remote, jobList) where
|
||||
|
||||
import qualified Data.Map as M
|
||||
import qualified Data.Text as T
|
||||
import System.Environment
|
||||
|
||||
import Common.Annex
|
||||
|
|
@ -73,7 +74,7 @@ glacierSetup u c = do
|
|||
remotename = fromJust (M.lookup "name" c)
|
||||
defvault = remotename ++ "-" ++ fromUUID u
|
||||
defaults = M.fromList
|
||||
[ ("datacenter", "us-east-1")
|
||||
[ ("datacenter", T.unpack $ AWS.defaultRegion AWS.Glacier)
|
||||
, ("vault", defvault)
|
||||
]
|
||||
|
||||
|
|
|
|||
|
|
@ -5,11 +5,16 @@
|
|||
- Licensed under the GNU GPL version 3 or higher.
|
||||
-}
|
||||
|
||||
{-# LANGUAGE OverloadedStrings, TupleSections #-}
|
||||
|
||||
module Remote.Helper.AWS where
|
||||
|
||||
import Common.Annex
|
||||
import Creds
|
||||
|
||||
import qualified Data.Map as M
|
||||
import Data.Text (Text)
|
||||
|
||||
creds :: UUID -> CredPairStorage
|
||||
creds u = CredPairStorage
|
||||
{ credPairFile = fromUUID u
|
||||
|
|
@ -19,3 +24,43 @@ creds u = CredPairStorage
|
|||
|
||||
setCredsEnv :: CredPair -> IO ()
|
||||
setCredsEnv p = setEnvCredPair p $ creds undefined
|
||||
|
||||
data Service = S3 | Glacier
|
||||
deriving (Eq)
|
||||
|
||||
type Region = Text
|
||||
|
||||
regionMap :: Service -> M.Map Text Region
|
||||
regionMap = M.fromList . regionInfo
|
||||
|
||||
defaultRegion :: Service -> Region
|
||||
defaultRegion = snd . Prelude.head . regionInfo
|
||||
|
||||
{- S3 and Glacier use different names for some regions. Ie, "us-east-1"
|
||||
- cannot be used with S3, while "US" cannot be used with Glacier. Dunno why.
|
||||
- Also, Glacier is not yet available in all regions. -}
|
||||
regionInfo :: Service -> [(Text, Region)]
|
||||
regionInfo service = map (\(t, r) -> (t, fromServiceRegion r)) $
|
||||
filter (matchingService . snd) $
|
||||
concatMap (\(t, l) -> map (t,) l) regions
|
||||
where
|
||||
regions =
|
||||
[ ("US East (N. Virginia)", [S3Region "US", GlacierRegion "us-east-1"])
|
||||
, ("US West (Oregon)", [BothRegion "us-west-2"])
|
||||
, ("US West (N. California)", [BothRegion "us-west-1"])
|
||||
, ("EU (Ireland)", [S3Region "EU", GlacierRegion "eu-west-1"])
|
||||
, ("Asia Pacific (Singapore)", [S3Region "ap-southeast-1"])
|
||||
, ("Asia Pacific (Tokyo)", [BothRegion "ap-northeast-1"])
|
||||
, ("Asia Pacific (Sydney)", [S3Region "ap-southeast-2"])
|
||||
, ("South America (São Paulo)", [S3Region "sa-east-1"])
|
||||
]
|
||||
|
||||
fromServiceRegion (BothRegion s) = s
|
||||
fromServiceRegion (S3Region s) = s
|
||||
fromServiceRegion (GlacierRegion s) = s
|
||||
|
||||
matchingService (BothRegion _) = True
|
||||
matchingService (S3Region _) = service == S3
|
||||
matchingService (GlacierRegion _) = service == Glacier
|
||||
|
||||
data ServiceRegion = BothRegion Region | S3Region Region | GlacierRegion Region
|
||||
|
|
|
|||
|
|
@ -11,6 +11,7 @@ import Network.AWS.AWSConnection
|
|||
import Network.AWS.S3Object
|
||||
import Network.AWS.S3Bucket hiding (size)
|
||||
import Network.AWS.AWSResult
|
||||
import qualified Data.Text as T
|
||||
import qualified Data.ByteString.Lazy.Char8 as L
|
||||
import qualified Data.Map as M
|
||||
import Data.Char
|
||||
|
|
@ -68,7 +69,7 @@ s3Setup u c = handlehost $ M.lookup "host" c
|
|||
remotename = fromJust (M.lookup "name" c)
|
||||
defbucket = remotename ++ "-" ++ fromUUID u
|
||||
defaults = M.fromList
|
||||
[ ("datacenter", "US")
|
||||
[ ("datacenter", T.unpack $ AWS.defaultRegion AWS.S3)
|
||||
, ("storageclass", "STANDARD")
|
||||
, ("host", defaultAmazonS3Host)
|
||||
, ("port", show defaultAmazonS3Port)
|
||||
|
|
|
|||
2
debian/changelog
vendored
2
debian/changelog
vendored
|
|
@ -11,6 +11,8 @@ git-annex (3.20121128) UNRELEASED; urgency=low
|
|||
* Allow `git annex drop --from web`; of course this does not remove
|
||||
any file from the web, but it does make git-annex remove all urls
|
||||
associated with a file.
|
||||
* webapp: S3 and Glacier forms now have a select list of all
|
||||
currently-supported AWS regions.
|
||||
|
||||
-- Joey Hess <joeyh@debian.org> Wed, 28 Nov 2012 13:31:07 -0400
|
||||
|
||||
|
|
|
|||
Loading…
Reference in a new issue