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.1.4 +version: 0.2.0 synopsis: Core functionality and data types for Amazonka libraries. homepage: https://github.com/brendanhay/amazonka license: OtherLicense @@ -111,6 +111,15 @@ main-is: Main.hs ghc-options: -Wall -threaded -with-rtsopts=-N + + other-modules: + Test.AWS.Data + , Test.AWS.Data.List + , Test.AWS.Data.Map + , Test.AWS.Data.Numeric + , Test.AWS.Data.Time + , Test.AWS.TH + , Test.AWS.Types build-depends: amazonka-core diff --git a/src/Network/AWS/Data/Internal/Numeric.hs b/src/Network/AWS/Data/Internal/Numeric.hs --- a/src/Network/AWS/Data/Internal/Numeric.hs +++ b/src/Network/AWS/Data/Internal/Numeric.hs @@ -34,7 +34,6 @@ , Num , Real , Integral - , Whole , ToByteString , FromText , ToText diff --git a/src/Network/AWS/Prelude.hs b/src/Network/AWS/Prelude.hs --- a/src/Network/AWS/Prelude.hs +++ b/src/Network/AWS/Prelude.hs @@ -36,7 +36,6 @@ , Generic , IsString (..) , Semigroup - , Whole -- * Retries , Retry (..) @@ -75,7 +74,7 @@ import Network.HTTP.Client (HttpException, RequestBody) import Network.HTTP.Types.Method (StdMethod(..)) import Network.HTTP.Types.Status (Status(..)) -import Numeric.Natural (Natural, Whole) +import Numeric.Natural (Natural) import Control.Applicative as Export import Data.Bifunctor as Export diff --git a/src/Network/AWS/Signing/Internal/V4.hs b/src/Network/AWS/Signing/Internal/V4.hs --- a/src/Network/AWS/Signing/Internal/V4.hs +++ b/src/Network/AWS/Signing/Internal/V4.hs @@ -26,7 +26,7 @@ import qualified Data.ByteString.Char8 as BS import qualified Data.CaseInsensitive as CI import qualified Data.Foldable as Fold -import Data.Function +import Data.Function hiding ((&)) import Data.List (groupBy, intersperse, sortBy, sort) import Data.Maybe import Data.Monoid diff --git a/test/Test/AWS/Data.hs b/test/Test/AWS/Data.hs new file mode 100644 --- /dev/null +++ b/test/Test/AWS/Data.hs @@ -0,0 +1,25 @@ +-- Module : Test.AWS.Data +-- 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 Test.AWS.Data (tests) where + +import qualified Test.AWS.Data.List as List +import qualified Test.AWS.Data.Map as Map +import qualified Test.AWS.Data.Numeric as Numeric +import qualified Test.AWS.Data.Time as Time +import Test.Tasty + +tests :: TestTree +tests = testGroup "data types" + [ List.tests + , Map.tests + , Numeric.tests + , Time.tests + ] diff --git a/test/Test/AWS/Data/List.hs b/test/Test/AWS/Data/List.hs new file mode 100644 --- /dev/null +++ b/test/Test/AWS/Data/List.hs @@ -0,0 +1,99 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE QuasiQuotes #-} + +-- Module : Test.AWS.Data.List +-- 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 Test.AWS.Data.List (tests) where + +import Network.AWS.Prelude +import Test.AWS.TH +import Test.AWS.Types +import Test.Tasty +import Test.Tasty.HUnit + +tests :: TestTree +tests = testGroup "list" + [ testGroup "deserialise xml" + [ testCase "entries" $ + assertXML unflattened (Entries items) + , testCase "flattened" $ + assertXML flattened items + ] + ] + +data Item = Item + { itemText :: Text + , itemDate :: Text + , itemInt :: Int + } deriving (Eq, Show) + +instance FromXML Item where + parseXML x = Item + <$> x .@ "Text" + <*> x .@ "Date" + <*> x .@ "Int" + +items :: List "Item" Item +items = List + [ Item + { itemText = "828ef3fdfa96f00ad9f27c383fc9ac7" + , itemDate = "2006-01-01T12:00:00.000Z" + , itemInt = 5 + } + , Item + { itemText = "fe3f123jfa96f00ad9f27c383fc9sd1" + , itemDate = "2014-11-02T01:20:12" + , itemInt = 123 + } + ] + +unflattened :: LazyByteString +unflattened = [doc| + + + foo + N + Ned + + + 2006-01-01T12:00:00.000Z + 828ef3fdfa96f00ad9f27c383fc9ac7 + 5 + + + 2014-11-02T01:20:12 + fe3f123jfa96f00ad9f27c383fc9sd1 + 123 + + + + |] + +flattened :: LazyByteString +flattened = [doc| + + + foo + N + Ned + + 2006-01-01T12:00:00.000Z + 828ef3fdfa96f00ad9f27c383fc9ac7 + 5 + + + 2014-11-02T01:20:12 + fe3f123jfa96f00ad9f27c383fc9sd1 + 123 + + + |] diff --git a/test/Test/AWS/Data/Map.hs b/test/Test/AWS/Data/Map.hs new file mode 100644 --- /dev/null +++ b/test/Test/AWS/Data/Map.hs @@ -0,0 +1,84 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE QuasiQuotes #-} + +-- Module : Test.AWS.Data.Map +-- 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 Test.AWS.Data.Map (tests) where + +import GHC.Exts +import Network.AWS.Prelude +import Test.AWS.TH +import Test.AWS.Types +import Test.Tasty +import Test.Tasty.HUnit + +tests :: TestTree +tests = testGroup "map" + [ testGroup "deserialise xml" + [ testCase "entries" $ + assertXML unflattened (Entries entries) + , testCase "flattened" $ + assertXML flattened entries + ] + ] + +entries :: EMap "entry" "key" "value" Text Text +entries = fromList + [ ("foo", "828ef3fdfa96f00ad9f27c383fc9ac7") + , ("bar", "fe3f123jfa96f00ad9f27c383fc9sd1") + , ("baz", "e50e9ce187d0a3a62f2ac0a5d89bf0a") + ] + +unflattened :: LazyByteString +unflattened = [doc| + + + N + + + baz + e50e9ce187d0a3a62f2ac0a5d89bf0a + + + foo + 828ef3fdfa96f00ad9f27c383fc9ac7 + + + bar + fe3f123jfa96f00ad9f27c383fc9sd1 + + + test + + |] + +flattened :: LazyByteString +flattened = [doc| + + + foo + N + + foo + 828ef3fdfa96f00ad9f27c383fc9ac7 + + + bar + fe3f123jfa96f00ad9f27c383fc9sd1 + + + baz + e50e9ce187d0a3a62f2ac0a5d89bf0a + + Ned + + |] diff --git a/test/Test/AWS/Data/Numeric.hs b/test/Test/AWS/Data/Numeric.hs new file mode 100644 --- /dev/null +++ b/test/Test/AWS/Data/Numeric.hs @@ -0,0 +1,103 @@ +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE RecordWildCards #-} + +-- Module : Test.AWS.Data.Numeric +-- 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 Test.AWS.Data.Numeric (tests) where + +import Data.Aeson +import Network.AWS.Prelude +import Test.Tasty +import Test.Tasty.HUnit + +tests :: TestTree +tests = testGroup "numeric" + [ testGroup "JSON serialization" + [ testEncode encodeItems + , testDecode decodeItems + ] + ] + +-- With a basic record, checks several serialization edge cases +-- between String, Int, and Nat values for numbers. +data Item = Item + { itemNat :: Maybe Nat + , itemInt :: Maybe Int + , itemStr :: Maybe String + } deriving (Eq, Show) + +instance ToJSON Item where + toJSON Item{..} = object + [ "item_nat" .= itemNat + , "item_int" .= itemInt + , "item_str" .= itemStr + ] + +instance FromJSON Item where + parseJSON = withObject "Item" $ \o -> Item + <$> o .:? "item_nat" + <*> o .:? "item_int" + <*> o .:? "item_str" + +encodeItems :: [(Item, LazyByteString)] +encodeItems = + [ ( Item (Just $ Nat 1) (Just 1) Nothing + , "{\"item_str\":null,\"item_nat\":1,\"item_int\":1}" + ) + + , ( Item (Just $ Nat 1) (Just 1) (Just "1") + , "{\"item_str\":\"1\",\"item_nat\":1,\"item_int\":1}" + ) + ] + +testEncode :: [(Item, LazyByteString)] -> TestTree +testEncode = testCase "Numeric JSON Encoding" + . mapM_ (\(input, e) -> e @=? encode input) + +decodeItems :: [(Maybe Item, LazyByteString)] +decodeItems = + [ ( Just (Item (Just $ Nat 1) (Just 1) Nothing) + , "{\"item_nat\":1,\"item_int\":1}" + ) + + , ( Just (Item (Just $ Nat 1) (Just (-1)) (Just "1")) + , "{\"item_nat\":1,\"item_int\":-1, \"item_str\":\"1\"}" + ) + + , ( Nothing + , "{\"item_nat\":1,\"item_int\":-1, \"item_str\":1}" + ) + + , ( Just (Item (Just $ Nat 1) (Just (-1)) Nothing) + , "{\"item_nat\":1,\"item_int\":-1}" + ) + + , ( Just (Item (Just $ Nat 1) (Just (-1)) Nothing) + , "{\"item_nat\":1.0,\"item_int\":-1}" + ) + + , ( Nothing + , "{\"item_nat\":-1,\"item_int\":1}" + ) + + , ( Nothing + , "{\"item_nat\":1.2,\"item_int\":1}" + ) + + , ( Nothing + , "{\"item_nat\":\"1\",\"item_int\":1}" + ) + ] + +testDecode :: [(Maybe Item, LazyByteString)] -> TestTree +testDecode = testCase "Numeric JSON Decoding" . mapM_ check + where + check (e, input) = e @=? (decode input :: Maybe Item) diff --git a/test/Test/AWS/Data/Time.hs b/test/Test/AWS/Data/Time.hs new file mode 100644 --- /dev/null +++ b/test/Test/AWS/Data/Time.hs @@ -0,0 +1,94 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE QuasiQuotes #-} +{-# LANGUAGE RecordWildCards #-} + +-- Module : Test.AWS.Data.Time +-- 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 Test.AWS.Data.Time (tests) where + +import Data.Aeson +import Data.Time +import Network.AWS.Prelude +import Test.AWS.Types +import Test.Tasty +import Test.Tasty.HUnit + +tests :: TestTree +tests = testGroup "time" + [ testGroup "deserialise xml" + [ testCase "RFC822" $ + assertXML "Fri, 07 Nov 2014 04:42:13 GMT" (ref :: RFC822) + , testCase "ISO8601" $ + assertXML "2014-11-07T04:42:13.000Z" (ref :: ISO8601) + , testCase "AWS" $ + assertXML "20141107T044213Z" (ref :: AWSTime) + , testCase "POSIX integer" $ + assertXML "1415335333" (ref :: POSIX) + , testCase "POSIX scientific" $ + assertXML "1.415335333E9" (ref :: POSIX) + ] + , testGroup "deserialise json" + [ testCase "RFC822" $ + assertJSON "{\"time_rfc\":\"Fri, 07 Nov 2014 04:42:13 GMT\"}" + (defaultTimeItem {timeRFC = Just ref}) + , testCase "ISO8601" $ + assertJSON "{\"time_iso\":\"2014-11-07T04:42:13.000Z\"}" + (defaultTimeItem {timeISO = Just ref}) + , testCase "AWS" $ + assertJSON "{\"time_aws\":\"20141107T044213Z\"}" + (defaultTimeItem {timeAWS = Just ref}) + , testCase "POSIX integer" $ + assertJSON "{\"time_posix\":1415335333}" + (defaultTimeItem {timePOSIX = Just ref}) + , testCase "POSIX scientific" $ + assertJSON "{\"time_posix\":1.415335333E9}" + (defaultTimeItem {timePOSIX = Just ref}) + ] + , testGroup "serialise json" + [ testCase "POSIX integer" $ + (@?=) (encode $ defaultTimeItem {timePOSIX = Just ref}) + "{\"time_aws\":null,\"time_iso\":null,\ + \\"time_posix\":1415335333,\"time_rfc\":null}" + ] + ] + +ref :: Time a +ref = Time $ fromMaybe (error "Unable to parse time") (parseTime locale format ts) + where + locale = defaultTimeLocale + format = iso8601DateFormat (Just "%H:%M:%S") + ts = "2014-11-07T04:42:13" + +data TimeItem = TimeItem + { timeRFC :: Maybe RFC822 + , timeISO :: Maybe ISO8601 + , timeAWS :: Maybe AWSTime + , timePOSIX :: Maybe POSIX + } deriving (Eq, Show) + +defaultTimeItem :: TimeItem +defaultTimeItem = TimeItem Nothing Nothing Nothing Nothing + +instance ToJSON TimeItem where + toJSON TimeItem{..} = object + [ "time_rfc" .= timeRFC + , "time_iso" .= timeISO + , "time_aws" .= timeAWS + , "time_posix" .= timePOSIX + ] + +instance FromJSON TimeItem where + parseJSON = withObject "TimeItem" $ \o -> TimeItem + <$> o .:? "time_rfc" + <*> o .:? "time_iso" + <*> o .:? "time_aws" + <*> o .:? "time_posix" diff --git a/test/Test/AWS/TH.hs b/test/Test/AWS/TH.hs new file mode 100644 --- /dev/null +++ b/test/Test/AWS/TH.hs @@ -0,0 +1,17 @@ +-- Module : Test.AWS.TH +-- 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 Test.AWS.TH where + +import Language.Haskell.TH +import Language.Haskell.TH.Quote + +doc :: QuasiQuoter +doc = QuasiQuoter { quoteExp = stringE } diff --git a/test/Test/AWS/Types.hs b/test/Test/AWS/Types.hs new file mode 100644 --- /dev/null +++ b/test/Test/AWS/Types.hs @@ -0,0 +1,30 @@ +{-# LANGUAGE OverloadedStrings #-} + +-- Module : Test.AWS.Types +-- 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 Test.AWS.Types where + +import Data.Aeson +import Network.AWS.Data +import Network.AWS.Prelude +import Test.Tasty.HUnit + +newtype Entries a = Entries a + deriving (Eq, Show) + +instance FromXML a => FromXML (Entries a) where + parseXML x = Entries <$> x .@ "Entries" + +assertXML :: (FromXML a, Show a, Eq a) => LazyByteString -> a -> Assertion +assertXML s x = (decodeXML s >>= parseXML) @?= Right x + +assertJSON :: (FromJSON a, Show a, Eq a) => LazyByteString -> a -> Assertion +assertJSON s x = eitherDecode' s @?= Right x