diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,3 +1,8 @@ +0.2.1 +===== + +* Add support for custom endpoints beyond the standard regions. + 0.2.0 ===== diff --git a/aws-general.cabal b/aws-general.cabal --- a/aws-general.cabal +++ b/aws-general.cabal @@ -3,7 +3,7 @@ -- ------------------------------------------------------ -- Name: aws-general -Version: 0.2.0 +Version: 0.2.1 Synopsis: Bindings for Amazon Web Services (AWS) General Reference description: Bindings for Amazon Web Services (AWS) General Reference including AWS Signature V4. @@ -38,7 +38,7 @@ source-repository this type: git location: https://github.com/alephcloud/hs-aws-general.git - tag: 0.2.0 + tag: 0.2.1 flag normalize-signature-v4-date Description: diff --git a/constraints b/constraints --- a/constraints +++ b/constraints @@ -24,17 +24,17 @@ parsec ==3.1.7, parsers ==0.12.1.1, pretty ==1.1.1.1, - primitive ==0.5.4.0, + primitive ==0.5.3.0, quickcheck-instances ==0.3.10, random ==1.1, rts ==1.0, - scientific ==0.3.3.7, + scientific ==0.3.3.5, semigroups ==0.16.0.1, - syb ==0.4.4, + syb ==0.4.2, template-haskell ==2.9.0.0, text ==1.2.0.3, tf-random ==0.5, - time ==1.4.2, - transformers ==0.4.2.0, + time ==1.5.0.1, + transformers ==0.4.1.0, unordered-containers ==0.2.5.1, - vector ==0.10.12.2 + vector ==0.10.11.0 diff --git a/src/Aws/General.hs b/src/Aws/General.hs --- a/src/Aws/General.hs +++ b/src/Aws/General.hs @@ -66,6 +66,7 @@ import Data.Aeson (ToJSON(..), FromJSON(..), withText) import qualified Data.Attoparsec.Text as AP import Data.Hashable (Hashable, hashWithSalt, hashUsing) +import qualified Data.List as L import Data.Monoid import Data.String import qualified Data.Text as T @@ -182,9 +183,13 @@ | UsEast1 | UsWest1 | UsWest2 - deriving (Show, Read, Eq, Ord, Enum, Bounded, Typeable) + | CustomEndpoint !T.Text !Int + -- ^ To override the region settings with a custom service endpoint, e.g. + -- for testing purpose -regionToText :: IsString a => Region -> a + deriving (Show, Read, Eq, Ord, Typeable) + +regionToText :: (Monoid a, IsString a) => Region -> a regionToText ApNortheast1 = "ap-northeast-1" regionToText ApSoutheast1 = "ap-southeast-1" regionToText ApSoutheast2 = "ap-southeast-2" @@ -193,7 +198,22 @@ regionToText UsEast1 = "us-east-1" regionToText UsWest1 = "us-west-1" regionToText UsWest2 = "us-west-2" +regionToText (CustomEndpoint e p) = "custom:" <> fromString (T.unpack e) <> ":" <> fromString (show p) +-- | Regions are parsed as follows: +-- +-- @ +-- 'ApNortheast1' ::= "ap-northeast-1" +-- 'ApSoutheast1' ::= "ap-southeast-1" +-- 'ApSoutheast2' ::= "ap-southeast-2" +-- 'EuWest1' ::= "eu-west-1" +-- 'SaEast1' ::= "sa-east-1" +-- 'UsEast1' ::= "us-east-1" +-- 'UsWest1' ::= "us-west-1" +-- 'UsWest2' ::= "us-west-2" +-- 'CustomEndpoint' ::= "custom:" 'T.Text' ":" 'Int' +-- @ +-- parseRegion :: P.CharParsing m => m Region parseRegion = ApNortheast1 <$ P.text "ap-northeast-1" @@ -204,12 +224,30 @@ <|> UsEast1 <$ P.text "us-east-1" <|> UsWest1 <$ P.text "us-west-1" <|> UsWest2 <$ P.text "us-west-2" + <|> parseCustomEndpoint "Region" + where + parseCustomEndpoint = CustomEndpoint + <$> (fmap T.pack $ P.text "custom:" *> many (P.notChar ':')) + <*> (fmap read $ P.text ":" *> some P.digit) instance AwsType Region where toText = regionToText parse = parseRegion +standardRegions :: [Region] +standardRegions = + [ ApNortheast1 + , ApSoutheast1 + , ApSoutheast2 + , EuWest1 + , SaEast1 + , UsEast1 + , UsWest1 + , UsWest2 + ] + + {- instance FromJSON Ec2Region where parseJSON = withText "Ec2Region" $ either fail return ∘ readEither ∘ T.unpack @@ -219,10 +257,20 @@ -} instance Hashable Region where - hashWithSalt = hashUsing fromEnum + hashWithSalt s (CustomEndpoint e p) = s `hashWithSalt` (0 :: Int) `hashWithSalt` (e, p) + hashWithSalt s r = + case L.elemIndex r standardRegions of + Just i -> hashWithSalt s (succ i) + Nothing -> hashWithSalt s (length standardRegions + 1) instance Q.Arbitrary Region where - arbitrary = Q.elements [minBound..maxBound] + arbitrary = Q.oneof + [ Q.elements standardRegions + , CustomEndpoint <$> arbitraryEndpoint <*> arbitraryPort + ] + where + arbitraryEndpoint = fmap T.pack . Q.listOf . Q.elements $ '.' : ['a'..'z'] + arbitraryPort = Q.choose (0, 10000) -- -------------------------------------------------------------------------- -- -- AWS Account Id diff --git a/src/Aws/SignatureV4.hs b/src/Aws/SignatureV4.hs --- a/src/Aws/SignatureV4.hs +++ b/src/Aws/SignatureV4.hs @@ -119,7 +119,6 @@ import qualified Data.Text as T import qualified Data.Text.Encoding as T import Data.Time.Clock (UTCTime, getCurrentTime, utctDay) -import Data.Time.Format (formatTime, parseTime) import Data.Typeable import qualified Test.QuickCheck as Q @@ -129,8 +128,9 @@ import qualified Text.Parser.Combinators as P #if MIN_VERSION_time(1,5,0) -import Data.Time.Format +import Data.Time.Format (defaultTimeLocale, formatTime, parseTimeM) #else +import Data.Time.Format (formatTime, parseTime) import System.Locale #endif @@ -342,8 +342,12 @@ <|> p "%Y-%m-%dT%H:%M:%S%QZ" s -- iso 8601 <|> p "%Y-%m-%dT%H:%M:%S%Q%Z" s -- iso 8601 where +#if MIN_VERSION_time(1,5,0) + p = parseTimeM True defaultTimeLocale +#else p = parseTime defaultTimeLocale #endif +#endif -- | Normalization of the date header breaks the AWS test suite, since the -- tests in that test suite use an invalid date. @@ -451,9 +455,14 @@ where time = do str <- P.count 8 P.digit - case parseTime defaultTimeLocale credentialScopeDateFormat str of + case p credentialScopeDateFormat str of Nothing -> fail $ "failed to parse credential scope date: " <> str Just t -> return t +#if MIN_VERSION_time(1,5,0) + p = parseTimeM True defaultTimeLocale +#else + p = parseTime defaultTimeLocale +#endif terminationString :: IsString a => a terminationString = "aws4_request"