amazonka-core 0.0.0 → 0.0.1

raw patch · 11 files changed

+91/−41 lines, 11 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• amazonka-core.cabal +3/−3
• src/Network/AWS/Auth.hs +4/−2
• src/Network/AWS/Data/Internal/ByteString.hs +5/−0
• src/Network/AWS/Data/Internal/Header.hs +18/−0
• src/Network/AWS/Data/Internal/Query.hs +13/−2
• src/Network/AWS/Data/Internal/Text.hs +11/−0
• src/Network/AWS/Data/Internal/XML.hs +8/−2
• src/Network/AWS/Error.hs +25/−27
• src/Network/AWS/Signing/Internal.hs +1/−1
• src/Network/AWS/Signing/V4.hs +2/−3
• src/Network/AWS/Types.hs +1/−1

@@ -1,6 +1,6 @@ name:                  amazonka-core-version:               0.0.0-synopsis:              Core functionality, serialisation primitives, and data types for the amazonka Amazon Web Services SDKs.+version:               0.0.1+synopsis:              Core functionality, serialisation primitives, and data types for the Amazonka Amazon Web Services SDKs. homepage:              https://github.com/brendanhay/amazonka license:               OtherLicense license-file:          LICENSE@@ -14,7 +14,7 @@  description:     Core functionality, serialisation primitives, and data types for-    amazonka related Amazon Web Services SDKs.+    Amazonka related Amazon Web Services SDKs.     .     /Warning:/ This is an experimental preview release which is still under     heavy development and not intended for public consumption, caveat emptor!

@@ -108,8 +108,10 @@     FromSession a s t -> return (fromSession a s t)     FromProfile n     -> show `withExceptT` fromProfileName m n     FromEnv     a s   -> fromEnvVars a s-    Discover          ->-        fromEnv `catchError` const (show `withExceptT` fromProfile m)+    Discover          -> fromEnv `catchError` const (iam `catchError` (const err))+      where+        iam = show `withExceptT` fromProfile m+        err = throwError "Unable to read environment variables or IAM profile."  -- | Retrieve access and secret keys from the default environment variables. --

@@ -48,12 +48,14 @@  showBS :: ToByteString a => a -> String showBS = BS.unpack . toBS+{-# INLINE showBS #-}  class ToByteString a where     toBS :: a -> ByteString      default toBS :: ToText a => a -> ByteString     toBS = Text.encodeUtf8 . toText+    {-# INLINE toBS #-}  instance ToByteString Builder    where toBS = buildBS instance ToByteString ByteString where toBS = id@@ -71,12 +73,14 @@  buildBS :: ToBuilder a => a -> ByteString buildBS = LBS.toStrict . Build.toLazyByteString . build+{-# INLINE buildBS #-}  class ToBuilder a where     build :: a -> Builder      default build :: ToByteString a => a -> Builder     build = build . toBS+    {-# INLINE build #-}  instance ToBuilder Builder    where build = id instance ToBuilder ByteString where build = Build.byteString@@ -92,3 +96,4 @@  stripBS :: ByteString -> ByteString stripBS = BS.dropWhile isSpace . fst . BS.spanEnd isSpace+{-# INLINE stripBS #-}

@@ -53,37 +53,55 @@   where     note Nothing  = Left (BS.unpack $ "Unable to find header: " <> CI.original k)     note (Just x) = Right x+{-# INLINE (~:) #-}  (~:?) :: FromText a => ResponseHeaders -> HeaderName -> Either String (Maybe a) hs ~:? k =     maybe (Right Nothing)           (fmap Just . fromText . Text.decodeUtf8)           (k `lookup` hs)+{-# INLINE (~:?) #-}  class ToHeaders a where     toHeaders :: a -> [Header]     toHeaders = const mempty+    {-# INLINE toHeaders #-}  (=:) :: ToHeader a => HeaderName -> a -> [Header] (=:) = toHeader+{-# INLINE toHeaderText #-} +-- FIXME: Improve complexity hdr :: HeaderName -> ByteString -> [Header] -> [Header] hdr k v hs = let h = (k, v) in deleteBy ((==) `on` fst) h hs ++ [h]+{-# INLINE hdr #-}  hdrs :: [Header] -> [Header] -> [Header] hdrs xs ys = Fold.foldr' (uncurry hdr) ys xs+{-# INLINE hdrs #-} +toHeaderText :: ToText a => HeaderName -> a -> [Header]+toHeaderText k = toHeader k . toText+ class ToHeader a where     toHeader :: HeaderName -> a -> [Header] +    default toHeader :: ToText a => HeaderName -> a -> [Header]+    toHeader k = toHeader k . toText+    {-# INLINE toHeader #-}+ instance ToHeader Text where     toHeader k = toHeader k . Text.encodeUtf8+    {-# INLINE toHeader #-}  instance ToHeader ByteString where     toHeader k = toHeader k . Just+    {-# INLINE toHeader #-}  instance ToByteString a => ToHeader (Maybe a) where     toHeader k = maybe [] (\v -> [(k, toBS v)])+    {-# INLINE toHeader #-}  instance (ToByteString k, ToByteString v) => ToHeader (HashMap k v) where     toHeader p = map (\(k, v) -> (p <> CI.mk (toBS k), toBS v)) . Map.toList+    {-# INLINE toHeader #-}

@@ -109,25 +109,33 @@  class ToQuery a where     toQuery :: a -> Query-    toQuery = const mempty +    default toQuery :: ToText a => a -> Query+    toQuery = toQuery . toText+    {-# INLINE toQuery #-}+ instance ToQuery Query where     toQuery = id+    {-# INLINE toQuery #-}  instance (ToByteString k, ToQuery v) => ToQuery (k, v) where     toQuery (k, v) = Pair (toBS k) (toQuery v)+    {-# INLINE toQuery #-}  instance (ToByteString k, ToByteString v) => ToQuery (k, Maybe v) where     toQuery (k, v) = Pair (toBS k) . Value $ toBS <$> v+    {-# INLINE toQuery #-}  instance ToQuery Char where     toQuery = toQuery . BS.singleton+    {-# INLINE toQuery #-}  instance ToQuery ByteString where     toQuery "" = Value Nothing     toQuery bs = Value (Just bs)+    {-# INLINE toQuery #-} -instance ToQuery Text    where toQuery = toQuery . toBS+instance ToQuery Text    where toQuery = toQuery . Text.encodeUtf8 instance ToQuery Int     where toQuery = toQuery . toBS instance ToQuery Integer where toQuery = toQuery . toBS instance ToQuery Double  where toQuery = toQuery . toBS@@ -137,11 +145,14 @@     toQuery = List . zipWith (\n v -> Pair (toBS n) (toQuery v)) idx       where         idx = [1..] :: [Integer]+    {-# INLINE toQuery #-}  instance ToQuery a => ToQuery (Maybe a) where     toQuery (Just x) = toQuery x     toQuery Nothing  = mempty+    {-# INLINE toQuery #-}  instance ToQuery Bool where     toQuery True  = toQuery ("true"  :: ByteString)     toQuery False = toQuery ("false" :: ByteString)+    {-# INLINE toQuery #-}

@@ -46,13 +46,16 @@  fromText :: FromText a => Text -> Either String a fromText = AText.parseOnly parser+{-# INLINE fromText #-}  -- FIXME: improve the error messages for partial match, or extra input etc. match :: Text -> a -> Parser a match x y = AText.string x <* AText.endOfInput >> return y+{-# INLINE match #-}  matchCI :: Text -> a -> Parser a matchCI x y = AText.asciiCI x <* AText.endOfInput >> return y+{-# INLINE matchCI #-}  class FromText a where     parser :: Parser a@@ -66,24 +69,30 @@  instance FromText Bool where     parser = matchCI "false" False <|> matchCI "true" True+    {-# INLINE parser #-}  showText :: ToText a => a -> String showText = Text.unpack . toText+{-# INLINE showText #-}  class ToText a where     toText :: a -> Text  instance (ToText a, ToText b) => ToText (a, b) where     toText (a, b) = "(" <> toText a <> ", " <> toText b <> ")"+    {-# INLINE toText #-}  instance ToText a => ToText [a] where     toText xs = "[" <> Text.intercalate ", " (map toText xs) <> "]"+    {-# INLINE toText #-}  instance ToText a => ToText (CI a) where     toText = toText . CI.original+    {-# INLINE toText #-}  instance ToText (Response a) where     toText rs = Text.pack . show $ rs { responseBody = () }+    {-# INLINE toText #-}  instance ToText Text       where toText = id instance ToText ByteString where toText = Text.decodeUtf8@@ -98,6 +107,8 @@ instance ToText Bool where     toText True  = "true"     toText False = "false"+    {-# INLINE toText #-}  shortText :: Builder -> Text shortText = LText.toStrict . Build.toLazyTextWith 32+{-# INLINE shortText #-}

@@ -138,9 +138,15 @@ {-# INLINE withElement #-}  findElement :: Text -> [Node] -> Either String [Node]-findElement n = maybe err Right . listToMaybe . mapMaybe (childNodes n)+findElement n ns = maybe err Right . listToMaybe $ mapMaybe (childNodes n) ns   where-    err = Left $ "unable to find element " ++ show n+    err = Left $ "unable to find element "+        ++ show n+        ++ " in nodes "+        ++ show (mapMaybe name ns)++    name (NodeElement e) = Just (nameLocalName (elementName e))+    name _               = Nothing {-# INLINE findElement #-}  childNodes :: Text -> Node -> Maybe [Node]

@@ -2,6 +2,7 @@ {-# LANGUAGE FlexibleContexts  #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RecordWildCards   #-}+{-# LANGUAGE TemplateHaskell   #-} {-# LANGUAGE TypeFamilies      #-} {-# LANGUAGE ViewPatterns      #-} @@ -18,10 +19,12 @@ module Network.AWS.Error where  import           Control.Applicative+import           Control.Lens import           Control.Monad import           Data.Aeson-import qualified Data.ByteString.Lazy as LBS-import           Data.Text            (Text)+import qualified Data.ByteString.Lazy       as LBS+import           Data.ByteString.Lazy.Char8 (unpack)+import           Data.Text                  (Text) import           GHC.Generics import           Network.AWS.Data import           Network.AWS.Types@@ -48,6 +51,8 @@     , _msgRESTMessage :: Text     } deriving (Eq, Ord, Show, Generic) +makeLenses ''RESTMessage+ instance FromXML RESTMessage where     parseXML x = RESTMessage         <$> x .@ "Type"@@ -59,6 +64,8 @@     , _errRequestId :: Text     } deriving (Eq, Show, Generic) +makeLenses ''RESTError+ instance FromXML RESTError where     parseXML x = RESTError         <$> x .@ "Error"@@ -71,33 +78,24 @@           -> Maybe (LBS.ByteString -> ServiceError (Er a)) restError f Service{..} s     | f s       = Nothing-    | otherwise = Just (either failure success . (decodeXML >=> parseXML))+    | otherwise = Just go   where-    success = ServiceError _svcAbbrev s-    failure = SerializerError _svcAbbrev---- cloudfront--- autoscaling---- <ErrorResponse xmlns="http://cloudfront.amazonaws.com/doc/2014-10-21/">---    <Error>---       <Type>Sender</Type>---       <Code>InvalidURI</Code>---       <Message>Could not parse the specified URI.</Message>---    </Error>---    <RequestId>410c2a4b-e435-49c9-8382-3770d80d7d4c</RequestId>--- </ErrorResponse>+    go x = either failure success (decodeXML x >>= parseXML)+      where+        failure e = SerializerError _svcAbbrev (e ++ ":\n" ++ unpack x)+        success   = ServiceError _svcAbbrev s  data JSONError = JSONError-    { _errType    :: Text+    { _errType    :: Maybe Text     , _errMessage :: Text     } deriving (Eq, Show, Generic) +makeLenses ''JSONError+ instance FromJSON JSONError where-    parseJSON = withObject "JSONError" $ \o ->-        JSONError-            <$> o .: "__type"-            <*> o .: "message"+    parseJSON = withObject "JSONError" $ \o -> JSONError+        <$> (o .:? "__type"  <|> o .:? "Type")+        <*> (o .:  "message" <|> o .:  "Message")  jsonError :: FromJSON (Er a)           => (Status -> Bool)@@ -106,9 +104,9 @@           -> Maybe (LBS.ByteString -> ServiceError (Er a)) jsonError f Service{..} s     | f s       = Nothing-    | otherwise = Just (either failure success . eitherDecode')+    | otherwise = Just go   where-    success = ServiceError _svcAbbrev s-    failure = SerializerError _svcAbbrev---- {"__type":"ResourceNotFoundException","message":"Unable to find instance with ID 1"}+    go x = either failure success (eitherDecode' x)+      where+        failure e = SerializerError _svcAbbrev (e ++ ":\n" ++ unpack x)+        success   = ServiceError _svcAbbrev s

@@ -37,7 +37,7 @@         -> Region    -- ^ AWS Region.         -> Request a -- ^ Request to presign.         -> UTCTime   -- ^ Signing time.-        -> Int       -- ^ Expiry time in seconds.+        -> UTCTime   -- ^ Expiry time.         -> m (Signed a (Sg (Sv a))) presign a r rq t x = withAuth a $ \e -> return $     presigned e r rq defaultTimeLocale t x

@@ -81,8 +81,7 @@               pair "X-AMZ-Algorithm"      algorithm             . pair "X-AMZ-Credential"     cs             . pair "X-AMZ-Date"           (LocaleTime l t :: ISO8601)-            . pair "X-AMZ-Expires"        x-            . pair "X-AMZ-SignedHeaders"  sh+            . pair "X-AMZ-Expires"        (LocaleTime l x :: ISO8601)             . pair "X-AMZ-SignedHeaders"  sh             . pair "X-AMZ-Security-Token" (toBS <$> _authToken a) @@ -153,7 +152,7 @@      headers = sortBy (comparing fst)         . hdr hHost host'-        . hdr hDate (toBS (LocaleTime l t :: RFC822))+        . hdr hDate (toBS (LocaleTime l t :: ISO8601))         $ _rqHeaders      joinedHeaders = map f $ groupBy ((==) `on` fst) headers

@@ -240,7 +240,7 @@               -> Request a               -> TimeLocale               -> UTCTime-              -> Int+              -> UTCTime               -> Signed a v  -- | Access key credential.