diff --git a/amazonka-core.cabal b/amazonka-core.cabal --- a/amazonka-core.cabal +++ b/amazonka-core.cabal @@ -1,5 +1,5 @@ name: amazonka-core -version: 0.0.2 +version: 0.0.3 synopsis: Core functionality, serialisation primitives, and data types for the Amazonka Amazon Web Services SDKs. homepage: https://github.com/brendanhay/amazonka license: OtherLicense @@ -36,6 +36,7 @@ , Network.AWS.Error , Network.AWS.Pagination , Network.AWS.Prelude + , Network.AWS.Request.Internal , Network.AWS.Request.JSON , Network.AWS.Request.Query , Network.AWS.Request.RestJSON @@ -64,7 +65,6 @@ , Network.AWS.Data.Internal.Time , Network.AWS.Data.Internal.URI , Network.AWS.Data.Internal.XML - , Network.AWS.Request.Internal build-depends: aeson >= 0.8 && < 0.9 @@ -97,3 +97,21 @@ , unordered-containers >= 0.2.3 , vector >= 0.10.9 , xml-conduit == 1.2.* + +test-suite tests + type: exitcode-stdio-1.0 + default-language: Haskell2010 + hs-source-dirs: test + main-is: Main.hs + + ghc-options: -Wall -threaded -with-rtsopts=-N + + build-depends: + amazonka-core + , base + , old-locale + , tasty + , tasty-hunit + , template-haskell + , text + , time diff --git a/src/Network/AWS/Data/Internal/ByteString.hs b/src/Network/AWS/Data/Internal/ByteString.hs --- a/src/Network/AWS/Data/Internal/ByteString.hs +++ b/src/Network/AWS/Data/Internal/ByteString.hs @@ -24,7 +24,6 @@ import Crypto.Hash import Data.ByteString (ByteString) -import qualified Data.ByteString.Base64 as Base64 import Data.ByteString.Builder (Builder) import qualified Data.ByteString.Builder as Build import qualified Data.ByteString.Char8 as BS diff --git a/src/Network/AWS/Data/Internal/List.hs b/src/Network/AWS/Data/Internal/List.hs --- a/src/Network/AWS/Data/Internal/List.hs +++ b/src/Network/AWS/Data/Internal/List.hs @@ -23,8 +23,6 @@ module Network.AWS.Data.Internal.List where -import Debug.Trace - import Control.Lens hiding (coerce, element) import Control.Monad import Data.Aeson diff --git a/src/Network/AWS/Data/Internal/Map.hs b/src/Network/AWS/Data/Internal/Map.hs --- a/src/Network/AWS/Data/Internal/Map.hs +++ b/src/Network/AWS/Data/Internal/Map.hs @@ -143,15 +143,9 @@ ) => FromXML (EMap e i j k v) where parseXML = fmap fromList . traverse go . mapMaybe (childNodes e) where - go ns - | length ns == 2 = - (,) <$> withElement i parseXML ns - <*> withElement j parseXML ns - | otherwise = - Left $ "Expected two elements named " - ++ show i ++ " and " - ++ show j ++ " within " - ++ show e + go ns = (,) + <$> withElement i parseXML ns + <*> withElement j parseXML ns i = fromString $ symbolVal (Proxy :: Proxy i) j = fromString $ symbolVal (Proxy :: Proxy j) diff --git a/src/Network/AWS/Data/Internal/Query.hs b/src/Network/AWS/Data/Internal/Query.hs --- a/src/Network/AWS/Data/Internal/Query.hs +++ b/src/Network/AWS/Data/Internal/Query.hs @@ -7,6 +7,7 @@ {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TypeOperators #-} +{-# LANGUAGE ViewPatterns #-} -- Module : Network.AWS.Data.Internal.Query -- Copyright : (c) 2013-2014 Brendan Hay @@ -23,7 +24,6 @@ , renderQuery , Query - , keysOf , valuesOf , pair @@ -43,6 +43,7 @@ import qualified Data.Text.Encoding as Text import Network.AWS.Data.Internal.ByteString import Network.AWS.Data.Internal.Text +import Network.HTTP.Types.URI (urlEncode) import Numeric.Natural data Query @@ -74,9 +75,6 @@ instance IsString Query where fromString = toQuery . BS.pack -keysOf :: Traversal' Query ByteString -keysOf = deep (_Pair . _1) - valuesOf :: Traversal' Query (Maybe ByteString) valuesOf = deep _Value @@ -90,10 +88,10 @@ renderQuery = intercalate . sort . enc Nothing where enc k (List xs) = concatMap (enc k) xs - enc k (Pair k' x) + enc k (Pair (urlEncode False -> k') x) | Just n <- k = enc (Just $ n <> "." <> k') x | otherwise = enc (Just k') x - enc k (Value (Just v)) + enc k (Value (Just (urlEncode False -> v))) | Just n <- k = [n <> vsep <> v] | otherwise = [v] enc k _ diff --git a/src/Network/AWS/Data/Internal/URI.hs b/src/Network/AWS/Data/Internal/URI.hs --- a/src/Network/AWS/Data/Internal/URI.hs +++ b/src/Network/AWS/Data/Internal/URI.hs @@ -12,15 +12,12 @@ module Network.AWS.Data.Internal.URI ( collapseURI - , encodeURI ) where -import Data.ByteString.Char8 (ByteString) -import qualified Data.ByteString.Char8 as BS -import Data.Char -import qualified Data.Foldable as Fold +import Data.ByteString.Char8 (ByteString) +import qualified Data.ByteString.Char8 as BS +import qualified Data.Foldable as Fold import Data.Monoid -import Network.AWS.Data.Internal.ByteString collapseURI :: ByteString -> ByteString collapseURI bs @@ -57,27 +54,3 @@ slash = BS.singleton sep sep = '/' - -encodeURI :: Bool -> ByteString -> ByteString -encodeURI p = toBS . BS.foldr (mappend . enc) mempty - where - enc ' ' = "%20" - enc c@'/' - | p = "%2F" - | otherwise = build c - enc c - | reserved c = build c - enc c = char2hex c - - reserved c = - isAsciiUpper c - || isAsciiLower c - || isDigit c - || c `elem` "-_.~" - - char2hex c = - let (a, b) = fromEnum c `divMod` 16 - in build ['%', hex a, hex b] - - hex i | i < 10 = toEnum (48 + i) - | otherwise = toEnum (65 + i - 10) diff --git a/src/Network/AWS/Data/Internal/XML.hs b/src/Network/AWS/Data/Internal/XML.hs --- a/src/Network/AWS/Data/Internal/XML.hs +++ b/src/Network/AWS/Data/Internal/XML.hs @@ -24,6 +24,7 @@ , withContent , withElement , withNode + , localName , (.@) , (.@?) diff --git a/src/Network/AWS/Signing/V4.hs b/src/Network/AWS/Signing/V4.hs --- a/src/Network/AWS/Signing/V4.hs +++ b/src/Network/AWS/Signing/V4.hs @@ -27,7 +27,6 @@ import Control.Applicative import Control.Lens -import Crypto.Hash (digestToHexByteString) import qualified Crypto.Hash.SHA256 as SHA256 import Data.ByteString (ByteString) import qualified Data.ByteString.Base16 as Base16 @@ -151,9 +150,7 @@ region | isGlobal s = def | otherwise = r - canonicalQuery = toBS $ query - & valuesOf %~ Just . maybe "" (encodeURI True) - & keysOf %~ encodeURI False + canonicalQuery = toBS (query & valuesOf %~ Just . fromMaybe "") headers = sortBy (comparing fst) . hdr hHost host' @@ -163,13 +160,14 @@ joinedHeaders = map f $ groupBy ((==) `on` fst) headers where f [] = ("", "") - f (h:hs) = (fst h, g $ h : hs) + f (h:hs) = (fst h, g (h : hs)) g = BS.intercalate "," . sort . map snd signedHeaders = mconcat . intersperse ";" - $ map (CI.foldedCase . fst) joinedHeaders + . map (CI.foldedCase . fst) + $ joinedHeaders canonicalHeaders = Fold.foldMap f joinedHeaders where @@ -180,7 +178,7 @@ canonicalRequest = mconcat $ intersperse "\n" [ meth - , collapseURI (encodeURI False _rqPath) + , collapseURI _rqPath , canonicalQuery , canonicalHeaders , signedHeaders diff --git a/test/Main.hs b/test/Main.hs new file mode 100644 --- /dev/null +++ b/test/Main.hs @@ -0,0 +1,19 @@ +-- Module : Main +-- Copyright : (c) 2013-2014 Brendan Hay +-- License : This Source Code Form is subject to the terms of +-- the Mozilla Public License, v. 2.0. +-- A copy of the MPL can be found in the LICENSE file or +-- you can obtain it at http://mozilla.org/MPL/2.0/. +-- Maintainer : Brendan Hay +-- Stability : experimental +-- Portability : non-portable (GHC extensions) + +module Main (main) where + +import qualified Test.AWS.Data as Data +import Test.Tasty + +main :: IO () +main = defaultMain $ testGroup "amazonka" + [ Data.tests + ]