4ca3d1d584
and one tail Removed head from Utility.PartialPrelude in order to avoid the build warning with recent ghc versions as well.
86 lines
2.8 KiB
Haskell
86 lines
2.8 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 . fromMaybe (error "internal") . headMaybe . 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 to be used, and currently v2 is
|
|
-- the default, so to add these would need other changes.
|
|
-- , ("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"
|