7f2bfd41d7
Avoids parse error when the fields are added to RemoteConfig at setup time and it then gets parsed, also at setup time. After setup time, such internally added fields are not a problem, because they're Accepted. So it may not be necessary in all cases to list such internally added fields, but I think it's a good idea to always do so.
87 lines
2.7 KiB
Haskell
87 lines
2.7 KiB
Haskell
{- Amazon Web Services common infrastructure.
|
|
-
|
|
- Copyright 2011-2014 Joey Hess <id@joeyh.name>
|
|
-
|
|
- Licensed under the GNU AGPL version 3 or higher.
|
|
-}
|
|
|
|
{-# LANGUAGE OverloadedStrings #-}
|
|
{-# LANGUAGE TupleSections #-}
|
|
|
|
module Remote.Helper.AWS where
|
|
|
|
import Annex.Common
|
|
import Creds
|
|
import Types.ProposedAccepted
|
|
import Types.RemoteConfig
|
|
|
|
import qualified Data.Map as M
|
|
import qualified Data.ByteString as B
|
|
import qualified Data.Text as T
|
|
import Data.Text.Encoding (encodeUtf8)
|
|
import Data.Text (Text)
|
|
|
|
creds :: UUID -> CredPairStorage
|
|
creds u = CredPairStorage
|
|
{ credPairFile = fromUUID u
|
|
, credPairEnvironment = ("AWS_ACCESS_KEY_ID", "AWS_SECRET_ACCESS_KEY")
|
|
, credPairRemoteField = s3credsField
|
|
}
|
|
|
|
s3credsField :: RemoteConfigField
|
|
s3credsField = Accepted "s3creds"
|
|
|
|
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
|
|
|
|
data ServiceRegion = BothRegion Region | S3Region Region | GlacierRegion Region
|
|
|
|
{- The "US" and "EU" names are used as location constraints when creating a
|
|
- S3 bucket. -}
|
|
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"])
|
|
-- These need signature V4 support, which has not landed in
|
|
-- the aws library.
|
|
-- See https://github.com/aristidb/aws/pull/199
|
|
-- , ("EU (Frankfurt)", [BothRegion "eu-central-1"])
|
|
-- , ("Asia Pacific (Seoul)", [S3Region "ap-northeast-2"])
|
|
-- , ("Asia Pacific (Mumbai)", [S3Region "ap-south-1"])
|
|
-- , ("US East (Ohio)", [S3Region "us-east-2"])
|
|
]
|
|
|
|
fromServiceRegion (BothRegion s) = s
|
|
fromServiceRegion (S3Region s) = s
|
|
fromServiceRegion (GlacierRegion s) = s
|
|
|
|
matchingService (BothRegion _) = True
|
|
matchingService (S3Region _) = service == S3
|
|
matchingService (GlacierRegion _) = service == Glacier
|
|
|
|
s3HostName :: Region -> B.ByteString
|
|
s3HostName "US" = "s3.amazonaws.com"
|
|
s3HostName "EU" = "s3-eu-west-1.amazonaws.com"
|
|
s3HostName "cn-north-1" = "s3.cn-north-1.amazonaws.com.cn"
|
|
s3HostName r = encodeUtf8 $ T.concat ["s3-", r, ".amazonaws.com"]
|
|
|
|
s3DefaultHost :: String
|
|
s3DefaultHost = "s3.amazonaws.com"
|