amazonka-core (empty) → 0.0.0
raw patch · 36 files changed
+4177/−0 lines, 36 filesdep +aesondep +attoparsecdep +basesetup-changed
Dependencies added: aeson, attoparsec, base, base16-bytestring, base64-bytestring, bifunctors, bytestring, case-insensitive, conduit, conduit-extra, cryptohash, cryptohash-conduit, data-default-class, hashable, http-client, http-types, lens, mmorph, mtl, nats, old-locale, resourcet, semigroups, tagged, text, time, transformers, unordered-containers, vector, xml-conduit
Files
- LICENSE +373/−0
- README.md +20/−0
- Setup.hs +2/−0
- amazonka-core.cabal +98/−0
- src/Network/AWS/Auth.hs +201/−0
- src/Network/AWS/Data.hs +72/−0
- src/Network/AWS/Data/Internal/Base64.hs +46/−0
- src/Network/AWS/Data/Internal/Body.hs +113/−0
- src/Network/AWS/Data/Internal/ByteString.hs +94/−0
- src/Network/AWS/Data/Internal/Header.hs +89/−0
- src/Network/AWS/Data/Internal/JSON.hs +59/−0
- src/Network/AWS/Data/Internal/List.hs +113/−0
- src/Network/AWS/Data/Internal/Map.hs +178/−0
- src/Network/AWS/Data/Internal/Numeric.hs +53/−0
- src/Network/AWS/Data/Internal/Path.hs +23/−0
- src/Network/AWS/Data/Internal/Query.hs +147/−0
- src/Network/AWS/Data/Internal/Sensitive.hs +44/−0
- src/Network/AWS/Data/Internal/Text.hs +103/−0
- src/Network/AWS/Data/Internal/Time.hs +171/−0
- src/Network/AWS/Data/Internal/URI.hs +83/−0
- src/Network/AWS/Data/Internal/XML.hs +187/−0
- src/Network/AWS/EC2/Metadata.hs +328/−0
- src/Network/AWS/Error.hs +114/−0
- src/Network/AWS/Pagination.hs +64/−0
- src/Network/AWS/Prelude.hs +104/−0
- src/Network/AWS/Request/Internal.hs +66/−0
- src/Network/AWS/Request/JSON.hs +46/−0
- src/Network/AWS/Request/Query.hs +38/−0
- src/Network/AWS/Request/RestJSON.hs +58/−0
- src/Network/AWS/Request/RestXML.hs +52/−0
- src/Network/AWS/Response.hs +133/−0
- src/Network/AWS/Signing/Internal.hs +49/−0
- src/Network/AWS/Signing/V2.hs +98/−0
- src/Network/AWS/Signing/V3.hs +88/−0
- src/Network/AWS/Signing/V4.hs +205/−0
- src/Network/AWS/Types.hs +465/−0
+ LICENSE view
@@ -0,0 +1,373 @@+Mozilla Public License Version 2.0+==================================++1. Definitions+--------------++1.1. "Contributor"+ means each individual or legal entity that creates, contributes to+ the creation of, or owns Covered Software.++1.2. "Contributor Version"+ means the combination of the Contributions of others (if any) used+ by a Contributor and that particular Contributor's Contribution.++1.3. "Contribution"+ means Covered Software of a particular Contributor.++1.4. "Covered Software"+ means Source Code Form to which the initial Contributor has attached+ the notice in Exhibit A, the Executable Form of such Source Code+ Form, and Modifications of such Source Code Form, in each case+ including portions thereof.++1.5. "Incompatible With Secondary Licenses"+ means++ (a) that the initial Contributor has attached the notice described+ in Exhibit B to the Covered Software; or++ (b) that the Covered Software was made available under the terms of+ version 1.1 or earlier of the License, but not also under the+ terms of a Secondary License.++1.6. "Executable Form"+ means any form of the work other than Source Code Form.++1.7. "Larger Work"+ means a work that combines Covered Software with other material, in+ a separate file or files, that is not Covered Software.++1.8. "License"+ means this document.++1.9. "Licensable"+ means having the right to grant, to the maximum extent possible,+ whether at the time of the initial grant or subsequently, any and+ all of the rights conveyed by this License.++1.10. "Modifications"+ means any of the following:++ (a) any file in Source Code Form that results from an addition to,+ deletion from, or modification of the contents of Covered+ Software; or++ (b) any new file in Source Code Form that contains any Covered+ Software.++1.11. "Patent Claims" of a Contributor+ means any patent claim(s), including without limitation, method,+ process, and apparatus claims, in any patent Licensable by such+ Contributor that would be infringed, but for the grant of the+ License, by the making, using, selling, offering for sale, having+ made, import, or transfer of either its Contributions or its+ Contributor Version.++1.12. "Secondary License"+ means either the GNU General Public License, Version 2.0, the GNU+ Lesser General Public License, Version 2.1, the GNU Affero General+ Public License, Version 3.0, or any later versions of those+ licenses.++1.13. "Source Code Form"+ means the form of the work preferred for making modifications.++1.14. "You" (or "Your")+ means an individual or a legal entity exercising rights under this+ License. For legal entities, "You" includes any entity that+ controls, is controlled by, or is under common control with You. For+ purposes of this definition, "control" means (a) the power, direct+ or indirect, to cause the direction or management of such entity,+ whether by contract or otherwise, or (b) ownership of more than+ fifty percent (50%) of the outstanding shares or beneficial+ ownership of such entity.++2. License Grants and Conditions+--------------------------------++2.1. Grants++Each Contributor hereby grants You a world-wide, royalty-free,+non-exclusive license:++(a) under intellectual property rights (other than patent or trademark)+ Licensable by such Contributor to use, reproduce, make available,+ modify, display, perform, distribute, and otherwise exploit its+ Contributions, either on an unmodified basis, with Modifications, or+ as part of a Larger Work; and++(b) under Patent Claims of such Contributor to make, use, sell, offer+ for sale, have made, import, and otherwise transfer either its+ Contributions or its Contributor Version.++2.2. Effective Date++The licenses granted in Section 2.1 with respect to any Contribution+become effective for each Contribution on the date the Contributor first+distributes such Contribution.++2.3. Limitations on Grant Scope++The licenses granted in this Section 2 are the only rights granted under+this License. No additional rights or licenses will be implied from the+distribution or licensing of Covered Software under this License.+Notwithstanding Section 2.1(b) above, no patent license is granted by a+Contributor:++(a) for any code that a Contributor has removed from Covered Software;+ or++(b) for infringements caused by: (i) Your and any other third party's+ modifications of Covered Software, or (ii) the combination of its+ Contributions with other software (except as part of its Contributor+ Version); or++(c) under Patent Claims infringed by Covered Software in the absence of+ its Contributions.++This License does not grant any rights in the trademarks, service marks,+or logos of any Contributor (except as may be necessary to comply with+the notice requirements in Section 3.4).++2.4. Subsequent Licenses++No Contributor makes additional grants as a result of Your choice to+distribute the Covered Software under a subsequent version of this+License (see Section 10.2) or under the terms of a Secondary License (if+permitted under the terms of Section 3.3).++2.5. Representation++Each Contributor represents that the Contributor believes its+Contributions are its original creation(s) or it has sufficient rights+to grant the rights to its Contributions conveyed by this License.++2.6. Fair Use++This License is not intended to limit any rights You have under+applicable copyright doctrines of fair use, fair dealing, or other+equivalents.++2.7. Conditions++Sections 3.1, 3.2, 3.3, and 3.4 are conditions of the licenses granted+in Section 2.1.++3. Responsibilities+-------------------++3.1. Distribution of Source Form++All distribution of Covered Software in Source Code Form, including any+Modifications that You create or to which You contribute, must be under+the terms of this License. You must inform recipients that the Source+Code Form of the Covered Software is governed by the terms of this+License, and how they can obtain a copy of this License. You may not+attempt to alter or restrict the recipients' rights in the Source Code+Form.++3.2. Distribution of Executable Form++If You distribute Covered Software in Executable Form then:++(a) such Covered Software must also be made available in Source Code+ Form, as described in Section 3.1, and You must inform recipients of+ the Executable Form how they can obtain a copy of such Source Code+ Form by reasonable means in a timely manner, at a charge no more+ than the cost of distribution to the recipient; and++(b) You may distribute such Executable Form under the terms of this+ License, or sublicense it under different terms, provided that the+ license for the Executable Form does not attempt to limit or alter+ the recipients' rights in the Source Code Form under this License.++3.3. Distribution of a Larger Work++You may create and distribute a Larger Work under terms of Your choice,+provided that You also comply with the requirements of this License for+the Covered Software. If the Larger Work is a combination of Covered+Software with a work governed by one or more Secondary Licenses, and the+Covered Software is not Incompatible With Secondary Licenses, this+License permits You to additionally distribute such Covered Software+under the terms of such Secondary License(s), so that the recipient of+the Larger Work may, at their option, further distribute the Covered+Software under the terms of either this License or such Secondary+License(s).++3.4. Notices++You may not remove or alter the substance of any license notices+(including copyright notices, patent notices, disclaimers of warranty,+or limitations of liability) contained within the Source Code Form of+the Covered Software, except that You may alter any license notices to+the extent required to remedy known factual inaccuracies.++3.5. Application of Additional Terms++You may choose to offer, and to charge a fee for, warranty, support,+indemnity or liability obligations to one or more recipients of Covered+Software. However, You may do so only on Your own behalf, and not on+behalf of any Contributor. You must make it absolutely clear that any+such warranty, support, indemnity, or liability obligation is offered by+You alone, and You hereby agree to indemnify every Contributor for any+liability incurred by such Contributor as a result of warranty, support,+indemnity or liability terms You offer. You may include additional+disclaimers of warranty and limitations of liability specific to any+jurisdiction.++4. Inability to Comply Due to Statute or Regulation+---------------------------------------------------++If it is impossible for You to comply with any of the terms of this+License with respect to some or all of the Covered Software due to+statute, judicial order, or regulation then You must: (a) comply with+the terms of this License to the maximum extent possible; and (b)+describe the limitations and the code they affect. Such description must+be placed in a text file included with all distributions of the Covered+Software under this License. Except to the extent prohibited by statute+or regulation, such description must be sufficiently detailed for a+recipient of ordinary skill to be able to understand it.++5. Termination+--------------++5.1. The rights granted under this License will terminate automatically+if You fail to comply with any of its terms. However, if You become+compliant, then the rights granted under this License from a particular+Contributor are reinstated (a) provisionally, unless and until such+Contributor explicitly and finally terminates Your grants, and (b) on an+ongoing basis, if such Contributor fails to notify You of the+non-compliance by some reasonable means prior to 60 days after You have+come back into compliance. Moreover, Your grants from a particular+Contributor are reinstated on an ongoing basis if such Contributor+notifies You of the non-compliance by some reasonable means, this is the+first time You have received notice of non-compliance with this License+from such Contributor, and You become compliant prior to 30 days after+Your receipt of the notice.++5.2. If You initiate litigation against any entity by asserting a patent+infringement claim (excluding declaratory judgment actions,+counter-claims, and cross-claims) alleging that a Contributor Version+directly or indirectly infringes any patent, then the rights granted to+You by any and all Contributors for the Covered Software under Section+2.1 of this License shall terminate.++5.3. In the event of termination under Sections 5.1 or 5.2 above, all+end user license agreements (excluding distributors and resellers) which+have been validly granted by You or Your distributors under this License+prior to termination shall survive termination.++************************************************************************+* *+* 6. Disclaimer of Warranty *+* ------------------------- *+* *+* Covered Software is provided under this License on an "as is" *+* basis, without warranty of any kind, either expressed, implied, or *+* statutory, including, without limitation, warranties that the *+* Covered Software is free of defects, merchantable, fit for a *+* particular purpose or non-infringing. The entire risk as to the *+* quality and performance of the Covered Software is with You. *+* Should any Covered Software prove defective in any respect, You *+* (not any Contributor) assume the cost of any necessary servicing, *+* repair, or correction. This disclaimer of warranty constitutes an *+* essential part of this License. No use of any Covered Software is *+* authorized under this License except under this disclaimer. *+* *+************************************************************************++************************************************************************+* *+* 7. Limitation of Liability *+* -------------------------- *+* *+* Under no circumstances and under no legal theory, whether tort *+* (including negligence), contract, or otherwise, shall any *+* Contributor, or anyone who distributes Covered Software as *+* permitted above, be liable to You for any direct, indirect, *+* special, incidental, or consequential damages of any character *+* including, without limitation, damages for lost profits, loss of *+* goodwill, work stoppage, computer failure or malfunction, or any *+* and all other commercial damages or losses, even if such party *+* shall have been informed of the possibility of such damages. This *+* limitation of liability shall not apply to liability for death or *+* personal injury resulting from such party's negligence to the *+* extent applicable law prohibits such limitation. Some *+* jurisdictions do not allow the exclusion or limitation of *+* incidental or consequential damages, so this exclusion and *+* limitation may not apply to You. *+* *+************************************************************************++8. Litigation+-------------++Any litigation relating to this License may be brought only in the+courts of a jurisdiction where the defendant maintains its principal+place of business and such litigation shall be governed by laws of that+jurisdiction, without reference to its conflict-of-law provisions.+Nothing in this Section shall prevent a party's ability to bring+cross-claims or counter-claims.++9. Miscellaneous+----------------++This License represents the complete agreement concerning the subject+matter hereof. If any provision of this License is held to be+unenforceable, such provision shall be reformed only to the extent+necessary to make it enforceable. Any law or regulation which provides+that the language of a contract shall be construed against the drafter+shall not be used to construe this License against a Contributor.++10. Versions of the License+---------------------------++10.1. New Versions++Mozilla Foundation is the license steward. Except as provided in Section+10.3, no one other than the license steward has the right to modify or+publish new versions of this License. Each version will be given a+distinguishing version number.++10.2. Effect of New Versions++You may distribute the Covered Software under the terms of the version+of the License under which You originally received the Covered Software,+or under the terms of any subsequent version published by the license+steward.++10.3. Modified Versions++If you create software not governed by this License, and you want to+create a new license for such software, you may create and use a+modified version of this License if you rename the license and remove+any references to the name of the license steward (except to note that+such modified license differs from this License).++10.4. Distributing Source Code Form that is Incompatible With Secondary+Licenses++If You choose to distribute Source Code Form that is Incompatible With+Secondary Licenses under the terms of this version of the License, the+notice described in Exhibit B of this License must be attached.++Exhibit A - Source Code Form License Notice+-------------------------------------------++ This Source Code Form is subject to the terms of the Mozilla Public+ License, v. 2.0. If a copy of the MPL was not distributed with this+ file, You can obtain one at http://mozilla.org/MPL/2.0/.++If it is not possible or desirable to put the notice in a particular+file, then You may include the notice in a location (such as a LICENSE+file in a relevant directory) where a recipient would be likely to look+for such a notice.++You may add additional accurate notices of copyright ownership.++Exhibit B - "Incompatible With Secondary Licenses" Notice+---------------------------------------------------------++ This Source Code Form is "Incompatible With Secondary Licenses", as+ defined by the Mozilla Public License, v. 2.0.
+ README.md view
@@ -0,0 +1,20 @@+# Amazonka Core++* [Description](#description)+* [Contribute](#contribute)+* [Licence](#licence)++## Description++Core data types, signing, (de)serialisation routines, and HTTP plumbing for all+`amazonka-*` libraries.+++## Contribute++For any problems, comments, or feedback please create an issue [here on GitHub](https://github.com/brendanhay/amazonka/issues).+++## Licence++`amazonka-core` is released under the [Mozilla Public License Version 2.0](http://www.mozilla.org/MPL/).
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ amazonka-core.cabal view
@@ -0,0 +1,98 @@+name: amazonka-core+version: 0.0.0+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+author: Brendan Hay+maintainer: Brendan Hay <brendan.g.hay@gmail.com>+copyright: Copyright (c) 2013-2014 Brendan Hay+category: Network, AWS, Cloud+build-type: Simple+extra-source-files: README.md+cabal-version: >= 1.10++description:+ Core functionality, serialisation primitives, and data types for+ 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!++source-repository head+ type: git+ location: git://github.com/brendanhay/amazonka.git++library+ default-language: Haskell2010+ hs-source-dirs: src++ ghc-options: -Wall++ exposed-modules:+ Network.AWS.Auth+ , Network.AWS.Data+ , Network.AWS.EC2.Metadata+ , Network.AWS.Error+ , Network.AWS.Pagination+ , Network.AWS.Prelude+ , Network.AWS.Request.JSON+ , Network.AWS.Request.Query+ , Network.AWS.Request.RestJSON+ , Network.AWS.Request.RestXML+ , Network.AWS.Response+ , Network.AWS.Signing.Internal+ , Network.AWS.Signing.V2+ , Network.AWS.Signing.V3+ , Network.AWS.Signing.V4+ , Network.AWS.Types++ other-modules:+ Network.AWS.Data.Internal.Base64+ , Network.AWS.Data.Internal.Body+ , Network.AWS.Data.Internal.ByteString+ , Network.AWS.Data.Internal.Header+ , Network.AWS.Data.Internal.JSON+ , Network.AWS.Data.Internal.List+ , Network.AWS.Data.Internal.Map+ , Network.AWS.Data.Internal.Numeric+ , Network.AWS.Data.Internal.Path+ , Network.AWS.Data.Internal.Query+ , Network.AWS.Data.Internal.Sensitive+ , Network.AWS.Data.Internal.Text+ , 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+ , attoparsec >= 0.12 && < 0.15+ , base >= 4.7 && < 5+ , base16-bytestring >= 0.1 && < 1+ , base64-bytestring >= 1 && < 2+ , bifunctors >= 0.3+ , bytestring >= 0.9+ , case-insensitive >= 1.1+ , conduit >= 1.1 && < 1.3+ , conduit-extra == 1.1.*+ , cryptohash == 0.11.*+ , cryptohash-conduit >= 0.1.1+ , data-default-class >= 0.0.1+ , hashable >= 1.2+ , http-client >= 0.3.6 && < 0.4+ , http-types >= 0.8+ , lens >= 4.4 && < 5+ , mmorph >= 1 && < 2+ , mtl >= 2.2.1 && < 2.3+ , nats >= 0.1.3+ , old-locale >= 1+ , resourcet == 1.1.*+ , semigroups >= 0.12+ , tagged >= 0.7+ , text >= 1.1+ , time >= 1.4+ , transformers == 0.4.*+ , unordered-containers >= 0.2.3+ , vector >= 0.10.9+ , xml-conduit == 1.2.*
+ src/Network/AWS/Auth.hs view
@@ -0,0 +1,201 @@+{-# LANGUAGE BangPatterns #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE ViewPatterns #-}++-- Module : Network.AWS.Auth+-- Copyright : (c) 2013-2014 Brendan Hay <brendan.g.hay@gmail.com>+-- 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 <brendan.g.hay@gmail.com>+-- Stability : experimental+-- Portability : non-portable (GHC extensions)++-- | Explicitly specify, or automatically retrieve your Amazon AWS security+-- credentials from the underlying host.+module Network.AWS.Auth+ (+ -- * Defaults+ accessKey+ , secretKey++ -- * Specifying credentials+ , fromKeys+ , fromSession++ -- * Retrieving credentials+ , Credentials (..)+ , getAuth+ ) where++import Control.Applicative+import Control.Concurrent+import Control.Monad.Except+import qualified Data.Aeson as Aeson+import qualified Data.ByteString.Char8 as BS+import qualified Data.ByteString.Lazy.Char8 as LBS+import Data.IORef+import Data.Monoid+import Data.Text (Text)+import qualified Data.Text as Text+import qualified Data.Text.Encoding as Text+import Data.Time+import Network.AWS.Data+import Network.AWS.EC2.Metadata+import Network.AWS.Types+import Network.HTTP.Client+import System.Environment+import System.Mem.Weak++-- | Default access key environment variable.+accessKey :: Text -- ^ 'AWS_ACCESS_KEY'+accessKey = "AWS_ACCESS_KEY"++-- | Default secret key environment variable.+secretKey :: Text -- ^ 'AWS_SECRET_KEY'+secretKey = "AWS_SECRET_KEY"++-- | Explicit access and secret keys.+fromKeys :: AccessKey -> SecretKey -> Auth+fromKeys a s = Auth (AuthEnv a s Nothing Nothing)++-- | A session containing the access key, secret key, and a security token.+fromSession :: AccessKey -> SecretKey -> SecurityToken -> Auth+fromSession a s t = Auth (AuthEnv a s (Just t) Nothing)++-- | Determines how authentication information is retrieved.+data Credentials+ = FromKeys AccessKey SecretKey+ -- ^ Explicit access and secret keys.+ -- Note: you can achieve the same result purely by using 'fromKeys'.+ | FromSession AccessKey SecretKey SecurityToken+ -- ^ A session containing the access key, secret key, and a security token.+ -- Note: you can achieve the same result purely by using 'fromSession'.+ | FromProfile Text+ -- ^ An IAM Profile name to lookup from the local EC2 instance-data.+ | FromEnv Text Text+ -- ^ Environment variables to lookup for the access and secret keys.+ | Discover+ -- ^ Attempt to read the default access and secret keys from the environment,+ -- falling back to the first available IAM profile if they are not set.+ --+ -- Note: This attempts to resolve <http://instance-data> rather than directly+ -- retrieving <http://169.254.169.254> for IAM profile information to ensure+ -- the dns lookup terminates promptly if not running on EC2.+ deriving (Eq)++instance ToText Credentials where+ toText = \case+ FromKeys a _ -> "FromKeys " <> toText a <> " ****"+ FromSession a _ _ -> "FromSession " <> toText a <> " **** ****"+ FromProfile n -> "FromProfile " <> n+ FromEnv a s -> "FromEnv " <> a <> " " <> s+ Discover -> "Discover"++instance Show Credentials where+ show = showText++-- | Retrieve authentication information from the environment or instance-data.+getAuth :: (Functor m, MonadIO m)+ => Manager+ -> Credentials+ -> ExceptT String m Auth+getAuth m = \case+ FromKeys a s -> return (fromKeys a s)+ 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)++-- | Retrieve access and secret keys from the default environment variables.+--+-- /See:/ 'accessKey' and 'secretKey'+fromEnv :: (Functor m, MonadIO m) => ExceptT String m Auth+fromEnv = fromEnvVars accessKey secretKey++-- | Retrieve access and secret keys from specific environment variables.+fromEnvVars :: (Functor m, MonadIO m) => Text -> Text -> ExceptT String m Auth+fromEnvVars a s = fmap Auth $ AuthEnv+ <$> (AccessKey <$> key a)+ <*> (SecretKey <$> key s)+ <*> pure Nothing+ <*> pure Nothing+ where+ key (Text.unpack -> k) = ExceptT $ do+ m <- liftIO (lookupEnv k)+ return $+ maybe (Left $ "Unable to read ENV variable: " ++ k)+ (Right . BS.pack)+ m++-- | Retrieve the default IAM Profile from the local EC2 instance-data.+--+-- This determined by Amazon as the first IAM profile found in the response from:+-- @http://169.254.169.254/latest/meta-data/iam/security-credentials/@+fromProfile :: MonadIO m => Manager -> ExceptT HttpException m Auth+fromProfile m = do+ !ls <- BS.lines `liftM` metadata m (IAM $ SecurityCredentials Nothing)+ case ls of+ (x:_) -> fromProfileName m (Text.decodeUtf8 x)+ _ -> throwError $+ HttpParserException "Unable to get default IAM Profile from EC2 metadata"++-- | Lookup a specific IAM Profile by name from the local EC2 instance-data.+--+-- The resulting IONewRef wrapper + timer is designed so that multiple concurrent+-- accesses of 'AuthEnv' from the 'AWS' environment are not required to calculate+-- expiry and sequentially queue to update it.+--+-- The forked timer ensures a singular owner and pre-emptive refresh of the+-- temporary session credentials.+--+-- A weak reference is used to ensure that the forked thread will eventually+-- terminate when 'Auth' is no longer referenced.+fromProfileName :: MonadIO m+ => Manager+ -> Text+ -> ExceptT HttpException m Auth+fromProfileName m name = auth >>= start+ where+ auth :: MonadIO m => ExceptT HttpException m AuthEnv+ auth = do+ !lbs <- LBS.fromStrict `liftM` metadata m+ (IAM . SecurityCredentials $ Just name)+ either (throwError . HttpParserException)+ return+ (Aeson.eitherDecode lbs)++ start !a = ExceptT . liftM Right . liftIO $+ case _authExpiry a of+ Nothing -> return (Auth a)+ Just x -> do+ r <- newIORef a+ p <- myThreadId+ s <- timer r p x+ return (Ref s r)++ timer r p x = forkIO $ do+ s <- myThreadId+ w <- mkWeakIORef r (killThread s)+ loop w p x++ loop w p x = do+ diff x <$> getCurrentTime >>= threadDelay+ ea <- runExceptT auth+ case ea of+ Left e -> throwTo p e+ Right !a -> do+ mr <- deRefWeak w+ case mr of+ Nothing -> return ()+ Just r -> do+ atomicWriteIORef r a+ maybe (return ()) (loop w p) (_authExpiry a)++ diff x y = (* 1000000) $+ let n = truncate (diffUTCTime x y) - 60+ in if n > 0 then n else 1
+ src/Network/AWS/Data.hs view
@@ -0,0 +1,72 @@+-- Module : Network.AWS.Data+-- Copyright : (c) 2013-2014 Brendan Hay <brendan.g.hay@gmail.com>+-- 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 <brendan.g.hay@gmail.com>+-- Stability : experimental+-- Portability : non-portable (GHC extensions)++-- | Serialisation classes and primitives for the various+-- formats used to communicate with AWS.+module Network.AWS.Data+ (+ -- * ByteString+ module Network.AWS.Data.Internal.ByteString+ , module Network.AWS.Data.Internal.Base64++ -- * Text+ , module Network.AWS.Data.Internal.Text++ -- * Numeric+ , module Network.AWS.Data.Internal.Numeric++ -- * Time+ , module Network.AWS.Data.Internal.Time++ -- * Sensitive+ , module Network.AWS.Data.Internal.Sensitive++ -- * HTTP+ -- ** Body+ , module Network.AWS.Data.Internal.Body++ -- ** Headers+ , module Network.AWS.Data.Internal.Header++ -- ** Path+ , module Network.AWS.Data.Internal.Path++ -- ** Query+ , module Network.AWS.Data.Internal.Query++ -- ** URI+ , module Network.AWS.Data.Internal.URI++ -- * XML+ , module Network.AWS.Data.Internal.XML++ -- * JSON+ , module Network.AWS.Data.Internal.JSON++ -- * Collections+ , module Network.AWS.Data.Internal.List+ , module Network.AWS.Data.Internal.Map+ ) where++import Network.AWS.Data.Internal.Base64+import Network.AWS.Data.Internal.Body+import Network.AWS.Data.Internal.ByteString+import Network.AWS.Data.Internal.Header+import Network.AWS.Data.Internal.JSON+import Network.AWS.Data.Internal.List+import Network.AWS.Data.Internal.Map+import Network.AWS.Data.Internal.Numeric+import Network.AWS.Data.Internal.Path+import Network.AWS.Data.Internal.Query+import Network.AWS.Data.Internal.Sensitive+import Network.AWS.Data.Internal.Text+import Network.AWS.Data.Internal.Time+import Network.AWS.Data.Internal.URI+import Network.AWS.Data.Internal.XML
+ src/Network/AWS/Data/Internal/Base64.hs view
@@ -0,0 +1,46 @@+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE TemplateHaskell #-}++-- Module : Network.AWS.Data.Internal.Base64+-- Copyright : (c) 2013-2014 Brendan Hay <brendan.g.hay@gmail.com>+-- 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 <brendan.g.hay@gmail.com>+-- Stability : experimental+-- Portability : non-portable (GHC extensions)++module Network.AWS.Data.Internal.Base64+ ( Base64+ ) where++import Data.Aeson.Types+import qualified Data.Attoparsec.Text as AText+import Data.ByteString (ByteString)+import qualified Data.ByteString.Base64 as Base64+import qualified Data.Text.Encoding as Text+import GHC.Generics+import Network.AWS.Data.Internal.ByteString+import Network.AWS.Data.Internal.JSON+import Network.AWS.Data.Internal.Query+import Network.AWS.Data.Internal.Text+import Network.AWS.Data.Internal.XML++-- | Base64 encoded binary data.+newtype Base64 = Base64 { unBase64 :: ByteString }+ deriving (Eq, Ord, Generic)++instance FromText Base64 where+ parser = AText.takeText >>=+ either fail (return . Base64) . Base64.decode . Text.encodeUtf8++instance Show Base64 where show = show . toBS+instance ToText Base64 where toText = Text.decodeUtf8 . toBS+instance ToByteString Base64 where toBS = Base64.encode . unBase64+instance ToQuery Base64 where toQuery = toQuery . toText+instance FromXML Base64 where parseXML = parseXMLText "Base64"+instance ToXML Base64 where toXML = toXMLText+instance FromJSON Base64 where parseJSON = parseJSONText "Base64"+instance ToJSON Base64 where toJSON = toJSONText
+ src/Network/AWS/Data/Internal/Body.hs view
@@ -0,0 +1,113 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TemplateHaskell #-}++-- Module : Network.AWS.Data.Internal.Body+-- Copyright : (c) 2013-2014 Brendan Hay <brendan.g.hay@gmail.com>+-- 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 <brendan.g.hay@gmail.com>+-- Stability : experimental+-- Portability : non-portable (GHC extensions)++module Network.AWS.Data.Internal.Body where++import Control.Lens+import Control.Applicative+import Control.Monad.IO.Class+import Control.Monad.Morph+import Control.Monad.Trans.Resource+import Crypto.Hash+import qualified Crypto.Hash.Conduit as Conduit+import Data.Aeson+import Data.ByteString (ByteString)+import qualified Data.ByteString as BS+import qualified Data.ByteString.Lazy as LBS+import qualified Data.ByteString.Lazy.Char8 as LBS8+import Data.Conduit+import qualified Data.Conduit.Binary as Conduit+import Data.IORef+import Data.Int+import Data.Monoid+import Data.String+import qualified Data.Text as Text+import Network.AWS.Data.Internal.Text+import Network.HTTP.Client+import System.IO++data RsBody = RsBody (ResumableSource (ResourceT IO) ByteString)++makePrisms ''RsBody++connectBody :: MonadResource m => RsBody -> Sink ByteString m a -> m a+connectBody (RsBody src) sink = hoist liftResourceT src $$+- sink++instance ToText RsBody where+ toText = const "RsBody <body>"++instance Show RsBody where+ show = Text.unpack . toText++data RqBody = RqBody+ { _bdyHash :: Digest SHA256+ , _bdyBody :: RequestBody+ }++makeLenses ''RqBody++instance ToText RqBody where+ toText (RqBody h _) = "RqBody " <> toText h <> " <body>"++instance Show RqBody where+ show = Text.unpack . toText++instance IsString RqBody where+ fromString = toBody . LBS8.pack++class ToBody a where+ toBody :: a -> RqBody+ toBody = const (RqBody (hash "") (RequestBodyLBS mempty))++instance ToBody RqBody where+ toBody = id++instance ToBody LBS.ByteString where+ toBody lbs = RqBody (hashlazy lbs) (RequestBodyLBS lbs)++instance ToBody ByteString where+ toBody = toBody . LBS.fromStrict++instance ToBody Value where+ toBody = toBody . encode++sourceBody :: Digest SHA256 -> Int64 -> Source IO ByteString -> RqBody+sourceBody h n = RqBody h . RequestBodyStream n . sourcePopper++sourceHandle :: Digest SHA256 -> Int64 -> Handle -> RqBody+sourceHandle h n = sourceBody h n . Conduit.sourceHandle++sourceFile :: Digest SHA256 -> Int64 -> FilePath -> RqBody+sourceFile h n = sourceBody h n . hoist runResourceT . Conduit.sourceFile++sourceFileIO :: MonadIO m => FilePath -> m RqBody+sourceFileIO f = liftIO $ sourceFile+ <$> runResourceT (Conduit.sourceFile f $$ Conduit.sinkHash)+ <*> (fromIntegral <$> withBinaryFile f ReadMode hFileSize)+ <*> pure f++sourcePopper :: Source IO ByteString -> GivesPopper ()+sourcePopper src f = do+ (rsrc0, ()) <- src $$+ return ()+ irsrc <- newIORef rsrc0+ let popper :: IO ByteString+ popper = do+ rsrc <- readIORef irsrc+ (rsrc', mres) <- rsrc $$++ await+ writeIORef irsrc rsrc'+ case mres of+ Nothing -> return mempty+ Just bs+ | BS.null bs -> popper+ | otherwise -> return bs+ f popper
+ src/Network/AWS/Data/Internal/ByteString.hs view
@@ -0,0 +1,94 @@+{-# LANGUAGE DefaultSignatures #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}++-- Copyright : (c) 2013-2014 Brendan Hay <brendan.g.hay@gmail.com>+-- 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 <brendan.g.hay@gmail.com>+-- Stability : experimental+-- Portability : non-portable (GHC extensions)++module Network.AWS.Data.Internal.ByteString+ ( LazyByteString++ , ToByteString (..)+ , showBS++ , ToBuilder (..)+ , buildBS++ , stripBS+ ) where++import Crypto.Hash+import Data.Aeson+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+import qualified Data.ByteString.Lazy.Char8 as LBS+import Data.CaseInsensitive (CI)+import qualified Data.CaseInsensitive as CI+import Data.Char+import Data.Int+import Data.Text (Text)+import qualified Data.Text.Encoding as Text+import Data.Time (UTCTime)+import GHC.Generics+import Network.AWS.Data.Internal.Text+import Network.HTTP.Types.Method+import Numeric.Natural++type LazyByteString = LBS.ByteString++showBS :: ToByteString a => a -> String+showBS = BS.unpack . toBS++class ToByteString a where+ toBS :: a -> ByteString++ default toBS :: ToText a => a -> ByteString+ toBS = Text.encodeUtf8 . toText++instance ToByteString Builder where toBS = buildBS+instance ToByteString ByteString where toBS = id+instance ToByteString Text where toBS = Text.encodeUtf8+instance ToByteString Int where toBS = buildBS+instance ToByteString Integer where toBS = buildBS+instance ToByteString Natural where toBS = buildBS+instance ToByteString Double where toBS = buildBS+instance ToByteString StdMethod where toBS = renderStdMethod+instance ToByteString (Digest a) where toBS = digestToHexByteString+instance ToByteString UTCTime where toBS = BS.pack . show++instance ToByteString a => ToByteString (CI a) where+ toBS = toBS . CI.original++buildBS :: ToBuilder a => a -> ByteString+buildBS = LBS.toStrict . Build.toLazyByteString . build++class ToBuilder a where+ build :: a -> Builder++ default build :: ToByteString a => a -> Builder+ build = build . toBS++instance ToBuilder Builder where build = id+instance ToBuilder ByteString where build = Build.byteString+instance ToBuilder Char where build = Build.charUtf8+instance ToBuilder [Char] where build = Build.stringUtf8+instance ToBuilder Int where build = Build.intDec+instance ToBuilder Int64 where build = Build.int64Dec+instance ToBuilder Integer where build = Build.integerDec+instance ToBuilder Natural where build = Build.integerDec . toInteger+instance ToBuilder Double where build = Build.doubleDec+instance ToBuilder StdMethod+instance ToBuilder (Digest a)++stripBS :: ByteString -> ByteString+stripBS = BS.dropWhile isSpace . fst . BS.spanEnd isSpace
+ src/Network/AWS/Data/Internal/Header.hs view
@@ -0,0 +1,89 @@+{-# LANGUAGE DefaultSignatures #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE OverloadedStrings #-}++-- Module : Network.AWS.Data.Internal.Header+-- Copyright : (c) 2013-2014 Brendan Hay <brendan.g.hay@gmail.com>+-- 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 <brendan.g.hay@gmail.com>+-- Stability : experimental+-- Portability : non-portable (GHC extensions)++module Network.AWS.Data.Internal.Header where++import Data.ByteString.Char8 (ByteString)+import qualified Data.ByteString.Char8 as BS+import qualified Data.CaseInsensitive as CI+import Data.Foldable as Fold+import Data.Function (on)+import Data.HashMap.Strict (HashMap)+import qualified Data.HashMap.Strict as Map+import Data.List (deleteBy)+import Data.Monoid+import Data.Text (Text)+import qualified Data.Text.Encoding as Text+import Network.AWS.Data.Internal.ByteString+import Network.AWS.Data.Internal.Text+import Network.HTTP.Types++hHost :: HeaderName+hHost = "Host"++hAMZToken :: HeaderName+hAMZToken = "X-Amz-Security-Token"++hAMZTarget :: HeaderName+hAMZTarget = "X-Amz-Target"++hAMZAuth :: HeaderName+hAMZAuth = "X-Amzn-Authorization"++hAMZDate :: HeaderName+hAMZDate = "X-Amz-Date"++hMetaPrefix :: HeaderName+hMetaPrefix = "X-Amz-"++(~:) :: FromText a => ResponseHeaders -> HeaderName -> Either String a+hs ~: k = hs ~:? k >>= note+ where+ note Nothing = Left (BS.unpack $ "Unable to find header: " <> CI.original k)+ note (Just x) = Right x++(~:?) :: FromText a => ResponseHeaders -> HeaderName -> Either String (Maybe a)+hs ~:? k =+ maybe (Right Nothing)+ (fmap Just . fromText . Text.decodeUtf8)+ (k `lookup` hs)++class ToHeaders a where+ toHeaders :: a -> [Header]+ toHeaders = const mempty++(=:) :: ToHeader a => HeaderName -> a -> [Header]+(=:) = toHeader++hdr :: HeaderName -> ByteString -> [Header] -> [Header]+hdr k v hs = let h = (k, v) in deleteBy ((==) `on` fst) h hs ++ [h]++hdrs :: [Header] -> [Header] -> [Header]+hdrs xs ys = Fold.foldr' (uncurry hdr) ys xs++class ToHeader a where+ toHeader :: HeaderName -> a -> [Header]++instance ToHeader Text where+ toHeader k = toHeader k . Text.encodeUtf8++instance ToHeader ByteString where+ toHeader k = toHeader k . Just++instance ToByteString a => ToHeader (Maybe a) where+ toHeader k = maybe [] (\v -> [(k, toBS v)])++instance (ToByteString k, ToByteString v) => ToHeader (HashMap k v) where+ toHeader p = map (\(k, v) -> (p <> CI.mk (toBS k), toBS v)) . Map.toList
+ src/Network/AWS/Data/Internal/JSON.hs view
@@ -0,0 +1,59 @@+{-# LANGUAGE OverloadedStrings #-}++-- Module : Network.AWS.Data.Internal.JSON+-- Copyright : (c) 2013-2014 Brendan Hay <brendan.g.hay@gmail.com>+-- 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 <brendan.g.hay@gmail.com>+-- Stability : experimental+-- Portability : non-portable (GHC extensions)++module Network.AWS.Data.Internal.JSON+ (+ -- * FromJSON+ FromJSON (..)+ , parseJSONText+ -- ** Parser a+ , withObject+ , (.:)+ , (.:?)+ -- ** Either String a+ , (.:>)+ , (.:?>)++ -- * ToJSON+ , ToJSON (..)+ , toJSONText+ , object+ , (.=)+ ) where++import Data.Aeson.Types+import Data.HashMap.Strict (HashMap)+import qualified Data.HashMap.Strict as Map+import Data.Text (Text)+import Network.AWS.Data.Internal.Text++parseJSONText :: FromText a => String -> Value -> Parser a+parseJSONText n = withText n (either fail return . fromText)+{-# INLINE parseJSONText #-}++toJSONText :: ToText a => a -> Value+toJSONText = String . toText+{-# INLINE toJSONText #-}++(.:>) :: FromJSON a => Object -> Text -> Either String a+(.:>) o k =+ case Map.lookup k o of+ Nothing -> Left $ "key " ++ show k ++ " not present"+ Just v -> parseEither parseJSON v+{-# INLINE (.:>) #-}++(.:?>) :: FromJSON a => Object -> Text -> Either String (Maybe a)+(.:?>) o k =+ case Map.lookup k o of+ Nothing -> Right Nothing+ Just v -> parseEither parseJSON v+{-# INLINE (.:?>) #-}
+ src/Network/AWS/Data/Internal/List.hs view
@@ -0,0 +1,113 @@+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE DeriveFoldable #-}+{-# LANGUAGE DeriveTraversable #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE KindSignatures #-}+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RoleAnnotations #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE StandaloneDeriving #-}+{-# LANGUAGE TypeFamilies #-}++-- Module : Network.AWS.Data.Internal.List+-- Copyright : (c) 2013-2014 Brendan Hay <brendan.g.hay@gmail.com>+-- 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 <brendan.g.hay@gmail.com>+-- Stability : experimental+-- Portability : non-portable (GHC extensions)++module Network.AWS.Data.Internal.List where++import Control.Lens hiding (coerce, element)+import Control.Monad+import Data.Aeson+import Data.Coerce+import Data.Foldable (Foldable)+import Data.List.NonEmpty (NonEmpty(..))+import Data.Maybe+import Data.Monoid+import Data.Proxy+import Data.Semigroup (Semigroup)+import Data.String+import qualified Data.Text as Text+import qualified Data.Vector as Vector+import GHC.Exts+import GHC.TypeLits+import Network.AWS.Data.Internal.Query+import Network.AWS.Data.Internal.XML+import Text.XML++newtype List (e :: Symbol) a = List { list :: [a] }+ deriving (Eq, Ord, Show, Semigroup, Monoid)++newtype List1 (e :: Symbol) a = List1 { list1 :: NonEmpty a }+ deriving (Eq, Ord, Show, Semigroup)++deriving instance Functor (List1 e)+deriving instance Foldable (List1 e)+deriving instance Traversable (List1 e)++type role List phantom representational+type role List1 phantom representational++_List :: (Coercible a b, Coercible b a) => Iso' (List e a) [b]+_List = iso (coerce . list) (List . coerce)++_List1 :: (Coercible a b, Coercible b a) => Iso' (List1 e a) (NonEmpty b)+_List1 = iso (coerce . list1) (List1 . coerce)++instance IsList (List e a) where+ type Item (List e a) = a++ fromList = List+ toList = list++fromList1 :: List1 e a -> List e a+fromList1 = List . toList . list1++toList1 :: List e a -> Either String (List1 e a)+toList1 (List (x:xs))+ = Right $ List1 (x :| xs)+toList1 _ = Left $ "Unexpected empty list, expected at least 1 element."++instance ToQuery a => ToQuery (List e a) where+ toQuery = toQuery . list++instance ToQuery a => ToQuery (List1 e a) where+ toQuery = toQuery . toList . list1++instance FromJSON a => FromJSON (List e a) where+ parseJSON = fmap List . parseJSON++instance FromJSON a => FromJSON (List1 e a) where+ parseJSON = withArray "List1" $ \case+ v | Vector.null v -> fail "Empty array, expected at least 1 element."+ v -> traverse parseJSON+ . List1 $ Vector.unsafeHead v :| Vector.toList (Vector.unsafeTail v)++instance ToJSON a => ToJSON (List e a) where+ toJSON = toJSON . list++instance ToJSON a => ToJSON (List1 e a) where+ toJSON = toJSON . toList . list1++instance (KnownSymbol e, FromXML a) => FromXML (List e a) where+ parseXML = fmap List . traverse parseXML . mapMaybe (childNodes n)+ where+ n = Text.pack $ symbolVal (Proxy :: Proxy e)++instance (KnownSymbol e, FromXML a) => FromXML (List1 e a) where+ parseXML = parseXML >=> toList1++instance (KnownSymbol e, ToXML a) => ToXML (List e a) where+ toXML = map (NodeElement . element n . toXML) . list+ where+ n = fromString $ symbolVal (Proxy :: Proxy e)++instance (KnownSymbol e, ToXML a) => ToXML (List1 e a) where+ toXML = toXML . fromList1
+ src/Network/AWS/Data/Internal/Map.hs view
@@ -0,0 +1,178 @@+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE KindSignatures #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RoleAnnotations #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TupleSections #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE ViewPatterns #-}++-- Module : Network.AWS.Data.Internal.Map+-- Copyright : (c) 2013-2014 Brendan Hay <brendan.g.hay@gmail.com>+-- 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 <brendan.g.hay@gmail.com>+-- Stability : experimental+-- Portability : non-portable (GHC extensions)++module Network.AWS.Data.Internal.Map+ ( Map (..)+ , _Map+ , (~::)++ , EMap (..)+ , _EMap+ ) where++import Control.Applicative+import Control.Lens hiding (coerce, element)+import Data.Aeson+import Data.Bifunctor+import qualified Data.ByteString.Char8 as BS+import Data.CaseInsensitive (CI)+import qualified Data.CaseInsensitive as CI+import Data.Coerce+import Data.HashMap.Strict (HashMap)+import qualified Data.HashMap.Strict as Map+import Data.Hashable (Hashable)+import Data.Maybe+import Data.Monoid+import Data.Proxy+import Data.Semigroup (Semigroup)+import Data.String+import Data.Text (Text)+import qualified Data.Text as Text+import qualified Data.Text.Encoding as Text+import GHC.Exts+import GHC.TypeLits+import Network.AWS.Data.Internal.ByteString+import Network.AWS.Data.Internal.Header+import Network.AWS.Data.Internal.Query+import Network.AWS.Data.Internal.Text+import Network.AWS.Data.Internal.XML+import Network.HTTP.Types.Header+import Text.XML++newtype Map k v = Map+ { fromMap :: HashMap k v+ } deriving (Eq, Show, Monoid, Semigroup)++type role Map nominal representational++_Map :: (Coercible a b, Coercible b a) => Iso' (Map k a) (HashMap k b)+_Map = iso (coerce . fromMap) (Map . coerce)++instance (Eq k, Hashable k) => IsList (Map k v) where+ type Item (Map k v) = (k, v)++ fromList = Map . Map.fromList+ toList = Map.toList . fromMap++instance (Eq k, Hashable k, FromText k, FromJSON v) => FromJSON (Map k v) where+ parseJSON = withObject "HashMap" $+ fmap (Map . Map.fromList)+ . traverse g+ . Map.toList+ where+ g (k, v) = (,)+ <$> either fail return (fromText k)+ <*> parseJSON v++instance (Eq k, Hashable k, ToText k, ToJSON v) => ToJSON (Map k v) where+ toJSON = Object . Map.fromList . map (bimap toText toJSON) . toList++(~::) :: ResponseHeaders+ -> CI Text+ -> Either String (Map (CI Text) Text)+hs ~:: (CI.foldedCase -> p) = Right . fromList $ mapMaybe f hs+ where+ f (CI.map Text.decodeUtf8 -> k, Text.decodeUtf8 -> v) =+ (,v) . CI.mk <$> Text.stripPrefix p (CI.foldedCase k)++instance ToHeader (Map (CI Text) Text) where+ toHeader (CI.foldedCase -> p) = map (first CI.mk . f) . toList+ where+ f (CI.foldedCase -> toBS -> k, toBS -> v)+ | BS.isPrefixOf p k = (k, v)+ | otherwise = (p <> k, v)++newtype EMap (e :: Symbol) (i :: Symbol) (j :: Symbol) k v = EMap+ { fromEMap :: HashMap k v+ } deriving (Eq, Show, Monoid, Semigroup)++type role EMap phantom phantom phantom nominal representational++_EMap :: (Coercible a b, Coercible b a) => Iso' (EMap e i j k a) (HashMap k b)+_EMap = iso (coerce . fromEMap) (EMap . coerce)++instance (Eq k, Hashable k) => IsList (EMap e i j k v) where+ type Item (EMap e i j k v) = (k, v)++ fromList = EMap . Map.fromList+ toList = Map.toList . fromEMap++instance ( KnownSymbol e+ , KnownSymbol i+ , KnownSymbol j+ , Eq k+ , Hashable k+ , ToQuery k+ , ToQuery v+ ) => ToQuery (EMap e i j k v) where+ toQuery m = toBS e =? (mconcat . zipWith go idx $ toList m)+ where+ go n (k, v) = toBS n =? toQuery (i, k) <> toQuery (j, v)++ idx = [1..] :: [Integer]++ i = BS.pack $ symbolVal (Proxy :: Proxy i)+ j = BS.pack $ symbolVal (Proxy :: Proxy j)+ e = BS.pack $ symbolVal (Proxy :: Proxy e)++instance ( KnownSymbol e+ , KnownSymbol i+ , KnownSymbol j+ , Eq k+ , Hashable k+ , FromXML k+ , FromXML v+ ) => FromXML (EMap e i j k v) where+ parseXML = fmap fromList . traverse (withElement e go . (:[]))+ 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++ i = fromString $ symbolVal (Proxy :: Proxy i)+ j = fromString $ symbolVal (Proxy :: Proxy j)+ e = fromString $ symbolVal (Proxy :: Proxy e)++instance ( KnownSymbol e+ , KnownSymbol i+ , KnownSymbol j+ , Eq k+ , Hashable k+ , ToXML k+ , ToXML v+ ) => ToXML (EMap e i j k v) where+ toXML = map (uncurry go) . toList+ where+ go k v =+ NodeElement $ element e+ [ NodeElement (element i (toXML k))+ , NodeElement (element j (toXML v))+ ]++ i = fromString $ symbolVal (Proxy :: Proxy i)+ j = fromString $ symbolVal (Proxy :: Proxy j)+ e = fromString $ symbolVal (Proxy :: Proxy e)
+ src/Network/AWS/Data/Internal/Numeric.hs view
@@ -0,0 +1,53 @@+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE TemplateHaskell #-}++-- Module : Network.AWS.Data.Internal.Numeric+-- Copyright : (c) 2013-2014 Brendan Hay <brendan.g.hay@gmail.com>+-- 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 <brendan.g.hay@gmail.com>+-- Stability : experimental+-- Portability : non-portable (GHC extensions)++module Network.AWS.Data.Internal.Numeric where++import Control.Applicative+import Control.Lens.TH+import Control.Monad+import Data.Aeson.Types+import Network.AWS.Data.Internal.ByteString+import Network.AWS.Data.Internal.Query+import Network.AWS.Data.Internal.Text+import Network.AWS.Data.Internal.XML+import Numeric.Natural++newtype Nat = Nat { unNat :: Natural }+ deriving+ ( Eq+ , Ord+ , Show+ , Enum+ , Num+ , Real+ , Integral+ , Whole+ , ToByteString+ , FromText+ , ToText+ , FromXML+ , ToXML+ , ToQuery+ )++instance FromJSON Nat where+ parseJSON = parseJSON >=> \n ->+ if n < 0+ then fail $ "Cannot convert negative number to Natural: " ++ show n+ else pure $ Nat (fromInteger n)++instance ToJSON Nat where+ toJSON = String . toText . unNat++makePrisms ''Nat
+ src/Network/AWS/Data/Internal/Path.hs view
@@ -0,0 +1,23 @@+-- Module : Network.AWS.Data.Internal.Path+-- Copyright : (c) 2013-2014 Brendan Hay <brendan.g.hay@gmail.com>+-- 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 <brendan.g.hay@gmail.com>+-- Stability : experimental+-- Portability : non-portable (GHC extensions)++module Network.AWS.Data.Internal.Path+ ( ToPath (..)+ ) where++import Data.Monoid+import Data.Text (Text)++class ToPath a where+ toPath :: a -> Text+ toPath = const mempty++instance ToPath Text where+ toPath = id
+ src/Network/AWS/Data/Internal/Query.hs view
@@ -0,0 +1,147 @@+{-# LANGUAGE DefaultSignatures #-}+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE TypeOperators #-}++-- Module : Network.AWS.Data.Internal.Query+-- Copyright : (c) 2013-2014 Brendan Hay <brendan.g.hay@gmail.com>+-- 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 <brendan.g.hay@gmail.com>+-- Stability : experimental+-- Portability : non-portable (GHC extensions)++module Network.AWS.Data.Internal.Query+ ( ToQuery (..)+ , renderQuery++ , Query+ , keysOf+ , valuesOf++ , pair+ , (=?)+ ) where++import Control.Applicative+import Control.Lens hiding (to, from)+import Data.ByteString (ByteString)+import qualified Data.ByteString.Char8 as BS+import Data.Data+import Data.Data.Lens+import Data.List (sort)+import Data.Monoid+import Data.String+import Data.Text (Text)+import qualified Data.Text.Encoding as Text+import Network.AWS.Data.Internal.ByteString+import Network.AWS.Data.Internal.Text+import Numeric.Natural++data Query+ = List [Query]+ | Pair ByteString Query+ | Value (Maybe ByteString)+ deriving (Eq, Show, Data, Typeable)++makePrisms ''Query++instance Monoid Query where+ mempty = List []++ mappend a b = case (a, b) of+ (List l, List r) -> List (l ++ r)+ (List l, r) -> List (r : l)+ (l, List r) -> List (l : r)+ (l, r) -> List [l, r]++instance Plated Query where+ plate = uniplate++instance ToByteString Query where+ toBS = renderQuery++instance ToText Query where+ toText = Text.decodeUtf8 . renderQuery++instance IsString Query where+ fromString = toQuery . BS.pack++keysOf :: Traversal' Query ByteString+keysOf = deep (_Pair . _1)++valuesOf :: Traversal' Query (Maybe ByteString)+valuesOf = deep _Value++pair :: ToQuery a => ByteString -> a -> Query -> Query+pair k v = mappend (Pair k (toQuery v))++(=?) :: ToQuery a => ByteString -> a -> Query+(=?) k v = Pair k (toQuery v)++renderQuery :: Query -> ByteString+renderQuery = intercalate . sort . enc Nothing+ where+ enc k (List xs) = concatMap (enc k) xs+ enc k (Pair k' x)+ | Just n <- k = enc (Just $ n <> "." <> k') x+ | otherwise = enc (Just k') x+ enc k (Value (Just v))+ | Just n <- k = [n <> vsep <> v]+ | otherwise = [v]+ enc k _+ | Just n <- k = [n]+ | otherwise = []++ intercalate [] = mempty+ intercalate [x] = x+ intercalate (x:xs) = x <> ksep <> intercalate xs++ ksep = "&"+ vsep = "="++class ToQuery a where+ toQuery :: a -> Query+ toQuery = const mempty++instance ToQuery Query where+ toQuery = id++instance (ToByteString k, ToQuery v) => ToQuery (k, v) where+ toQuery (k, v) = Pair (toBS k) (toQuery v)++instance (ToByteString k, ToByteString v) => ToQuery (k, Maybe v) where+ toQuery (k, v) = Pair (toBS k) . Value $ toBS <$> v++instance ToQuery Char where+ toQuery = toQuery . BS.singleton++instance ToQuery ByteString where+ toQuery "" = Value Nothing+ toQuery bs = Value (Just bs)++instance ToQuery Text where toQuery = toQuery . toBS+instance ToQuery Int where toQuery = toQuery . toBS+instance ToQuery Integer where toQuery = toQuery . toBS+instance ToQuery Double where toQuery = toQuery . toBS+instance ToQuery Natural where toQuery = toQuery . toBS++instance ToQuery a => ToQuery [a] where+ toQuery = List . zipWith (\n v -> Pair (toBS n) (toQuery v)) idx+ where+ idx = [1..] :: [Integer]++instance ToQuery a => ToQuery (Maybe a) where+ toQuery (Just x) = toQuery x+ toQuery Nothing = mempty++instance ToQuery Bool where+ toQuery True = toQuery ("true" :: ByteString)+ toQuery False = toQuery ("false" :: ByteString)
+ src/Network/AWS/Data/Internal/Sensitive.hs view
@@ -0,0 +1,44 @@+{-# LANGUAGE GeneralizedNewtypeDeriving #-}++-- Module : Network.AWS.Data.Internal.Sensitive+-- Copyright : (c) 2013-2014 Brendan Hay <brendan.g.hay@gmail.com>+-- 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 <brendan.g.hay@gmail.com>+-- Stability : experimental+-- Portability : non-portable (GHC extensions)++module Network.AWS.Data.Internal.Sensitive where++import Control.Lens+import Data.Monoid+import Data.String+import Network.AWS.Data.Internal.ByteString+import Network.AWS.Data.Internal.JSON+import Network.AWS.Data.Internal.Query+import Network.AWS.Data.Internal.Text+import Network.AWS.Data.Internal.XML++newtype Sensitive a = Sensitive { desensitise :: a }+ deriving+ ( Eq+ , Ord+ , IsString+ , Monoid+ , ToByteString+ , FromText+ , ToText+ , FromXML+ , ToXML+ , ToQuery+ , ToJSON+ , FromJSON+ )++instance Show (Sensitive a) where+ show = const "******"++_Sensitive :: Iso' (Sensitive a) a+_Sensitive = iso desensitise Sensitive
+ src/Network/AWS/Data/Internal/Text.hs view
@@ -0,0 +1,103 @@+{-# LANGUAGE DefaultSignatures #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE OverloadedStrings #-}++-- Module : Network.AWS.Data.Internal.Text+-- Copyright : (c) 2013-2014 Brendan Hay <brendan.g.hay@gmail.com>+-- 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 <brendan.g.hay@gmail.com>+-- Stability : experimental+-- Portability : non-portable (GHC extensions)++module Network.AWS.Data.Internal.Text+ ( FromText (..)+ , fromText+ , match+ , matchCI+ , AText.takeText++ , ToText (..)+ , showText+ ) where++import Control.Applicative+import Crypto.Hash+import Data.Attoparsec.Text (Parser)+import qualified Data.Attoparsec.Text as AText+import Data.ByteString (ByteString)+import Data.CaseInsensitive (CI)+import qualified Data.CaseInsensitive as CI+import Data.Int+import Data.Monoid+import Data.Text (Text)+import qualified Data.Text as Text+import qualified Data.Text.Encoding as Text+import qualified Data.Text.Lazy as LText+import Data.Text.Lazy.Builder (Builder)+import qualified Data.Text.Lazy.Builder as Build+import qualified Data.Text.Lazy.Builder.Int as Build+import qualified Data.Text.Lazy.Builder.RealFloat as Build+import Network.HTTP.Client+import Network.HTTP.Types+import Numeric.Natural++fromText :: FromText a => Text -> Either String a+fromText = AText.parseOnly parser++-- 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++matchCI :: Text -> a -> Parser a+matchCI x y = AText.asciiCI x <* AText.endOfInput >> return y++class FromText a where+ parser :: Parser a++instance FromText Text where parser = AText.takeText+instance FromText ByteString where parser = Text.encodeUtf8 <$> AText.takeText+instance FromText Int where parser = AText.decimal+instance FromText Integer where parser = AText.decimal+instance FromText Natural where parser = AText.decimal+instance FromText Double where parser = AText.rational++instance FromText Bool where+ parser = matchCI "false" False <|> matchCI "true" True++showText :: ToText a => a -> String+showText = Text.unpack . toText++class ToText a where+ toText :: a -> Text++instance (ToText a, ToText b) => ToText (a, b) where+ toText (a, b) = "(" <> toText a <> ", " <> toText b <> ")"++instance ToText a => ToText [a] where+ toText xs = "[" <> Text.intercalate ", " (map toText xs) <> "]"++instance ToText a => ToText (CI a) where+ toText = toText . CI.original++instance ToText (Response a) where+ toText rs = Text.pack . show $ rs { responseBody = () }++instance ToText Text where toText = id+instance ToText ByteString where toText = Text.decodeUtf8+instance ToText Int where toText = shortText . Build.decimal+instance ToText Int64 where toText = shortText . Build.decimal+instance ToText Integer where toText = shortText . Build.decimal+instance ToText Natural where toText = shortText . Build.decimal+instance ToText Double where toText = shortText . Build.realFloat+instance ToText StdMethod where toText = toText . renderStdMethod+instance ToText (Digest a) where toText = toText . digestToHexByteString++instance ToText Bool where+ toText True = "true"+ toText False = "false"++shortText :: Builder -> Text+shortText = LText.toStrict . Build.toLazyTextWith 32
+ src/Network/AWS/Data/Internal/Time.hs view
@@ -0,0 +1,171 @@+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE GADTs #-}+{-# LANGUAGE KindSignatures #-}+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE StandaloneDeriving #-}++-- Module : Network.AWS.Data.Internal.Time+-- Copyright : (c) 2013-2014 Brendan Hay <brendan.g.hay@gmail.com>+-- 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 <brendan.g.hay@gmail.com>+-- Stability : experimental+-- Portability : non-portable (GHC extensions)++module Network.AWS.Data.Internal.Time+ ( Format (..)+ , Time (..)+ , _Time++ , UTCTime+ , RFC822+ , ISO8601+ , BasicTime+ , AWSTime+ , POSIX+ ) where++import Control.Applicative+import Control.Lens+import Data.Aeson+import Data.Attoparsec.Text (Parser)+import qualified Data.Attoparsec.Text as AText+import qualified Data.ByteString.Char8 as BS+import Data.Function (on)+import Data.Tagged+import qualified Data.Text as Text+import Data.Time+import Data.Time.Clock.POSIX+import Network.AWS.Data.Internal.ByteString+import Network.AWS.Data.Internal.JSON+import Network.AWS.Data.Internal.Query+import Network.AWS.Data.Internal.Text+import Network.AWS.Data.Internal.XML+import System.Locale++data Format+ = RFC822Format+ | ISO8601Format+ | BasicFormat+ | AWSFormat+ | POSIXFormat+ deriving (Eq, Show)++data Time :: Format -> * where+ Time :: UTCTime -> Time a+ LocaleTime :: TimeLocale -> UTCTime -> Time a++deriving instance Show (Time a)+deriving instance Eq (Time a)++instance Ord (Time (a :: Format)) where+ compare = compare `on` ts+ where+ ts (Time t) = (t, defaultTimeLocale)+ ts (LocaleTime l t) = (t, l)+++-- | This is a poorly behaved isomorphism, due to the fact 'LocaleTime' only+-- exists for testing purposes, and we wish to compose using 'mapping'+-- in actual usage.+_Time :: Iso' (Time a) UTCTime+_Time = iso (\case; Time a -> a; LocaleTime _ a -> a) Time++type RFC822 = Time RFC822Format+type ISO8601 = Time ISO8601Format+type BasicTime = Time BasicFormat+type AWSTime = Time AWSFormat+type POSIX = Time POSIXFormat++class TimeFormat a where+ format :: Tagged a String++instance TimeFormat RFC822 where format = Tagged "%a, %d %b %Y %H:%M:%S GMT"+instance TimeFormat ISO8601 where format = Tagged (iso8601DateFormat (Just "%XZ"))+instance TimeFormat BasicTime where format = Tagged "%Y%m%d"+instance TimeFormat AWSTime where format = Tagged "%Y%m%dT%H%M%SZ"++instance FromText RFC822 where parser = parseFormattedTime+instance FromText ISO8601 where parser = parseFormattedTime+instance FromText BasicTime where parser = parseFormattedTime+instance FromText AWSTime where parser = parseFormattedTime++instance FromText POSIX where+ parser = Time . posixSecondsToUTCTime . realToFrac+ <$> (parser :: Parser Integer)++parseFormattedTime :: forall a. TimeFormat (Time a) => Parser (Time a)+parseFormattedTime = do+ x <- Text.unpack <$> AText.takeText+ p (parseTime defaultTimeLocale (untag f) x) x+ where+ p :: Maybe UTCTime -> String -> Parser (Time a)+ p Nothing s = fail ("Unable to parse " ++ untag f ++ " from " ++ s)+ p (Just x) _ = return (Time x)++ f :: Tagged (Time a) String+ f = format++instance ToText RFC822 where toText = Text.pack . renderFormattedTime+instance ToText ISO8601 where toText = Text.pack . renderFormattedTime+instance ToText BasicTime where toText = Text.pack . renderFormattedTime+instance ToText AWSTime where toText = Text.pack . renderFormattedTime++instance ToText POSIX where+ toText t = toText time+ where+ time :: Integer+ time = truncate . utcTimeToPOSIXSeconds $+ case t of+ Time x -> x+ LocaleTime _ x -> x++renderFormattedTime :: forall a. TimeFormat (Time a) => Time a -> String+renderFormattedTime x = formatTime l (untag f) t+ where+ (l, t) = case x of+ Time t' -> (defaultTimeLocale, t')+ LocaleTime l' t' -> (l', t')++ f :: Tagged (Time a) String+ f = format++instance FromXML RFC822 where parseXML = parseXMLText "RFC822"+instance FromXML ISO8601 where parseXML = parseXMLText "ISO8601"+instance FromXML AWSTime where parseXML = parseXMLText "AWSTime"+instance FromXML BasicTime where parseXML = parseXMLText "BasicTime"+instance FromXML POSIX where parseXML = parseXMLText "POSIX"++instance FromJSON RFC822 where parseJSON = parseJSONText "RFC822"+instance FromJSON ISO8601 where parseJSON = parseJSONText "ISO8601"+instance FromJSON AWSTime where parseJSON = parseJSONText "AWSTime"+instance FromJSON BasicTime where parseJSON = parseJSONText "BasicTime"+instance FromJSON POSIX where parseJSON = parseJSONText "POSIX"++instance ToByteString RFC822 where toBS = BS.pack . renderFormattedTime+instance ToByteString ISO8601 where toBS = BS.pack . renderFormattedTime+instance ToByteString BasicTime where toBS = BS.pack . renderFormattedTime+instance ToByteString AWSTime where toBS = BS.pack . renderFormattedTime++instance ToQuery RFC822 where toQuery = toQuery . toBS+instance ToQuery ISO8601 where toQuery = toQuery . toBS+instance ToQuery BasicTime where toQuery = toQuery . toBS+instance ToQuery AWSTime where toQuery = toQuery . toBS++instance ToXML RFC822 where toXML = toXMLText+instance ToXML ISO8601 where toXML = toXMLText+instance ToXML AWSTime where toXML = toXMLText+instance ToXML BasicTime where toXML = toXMLText+instance ToXML POSIX where toXML = toXMLText++instance ToJSON RFC822 where toJSON = toJSONText+instance ToJSON ISO8601 where toJSON = toJSONText+instance ToJSON AWSTime where toJSON = toJSONText+instance ToJSON BasicTime where toJSON = toJSONText+instance ToJSON POSIX where toJSON = toJSONText
+ src/Network/AWS/Data/Internal/URI.hs view
@@ -0,0 +1,83 @@+{-# LANGUAGE OverloadedStrings #-}++-- Module : Network.AWS.Data.Internal.URI+-- Copyright : (c) 2013-2014 Brendan Hay <brendan.g.hay@gmail.com>+-- 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 <brendan.g.hay@gmail.com>+-- Stability : experimental+-- Portability : non-portable (GHC extensions)++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.Monoid+import Network.AWS.Data.Internal.ByteString++collapseURI :: ByteString -> ByteString+collapseURI bs+ | BS.null bs = slash+ | BS.null path = slash+ | otherwise = tl (hd path)+ where+ path = BS.intercalate slash+ . reverse+ . Fold.foldl' go []+ . filter (/= mempty)+ $ BS.split sep bs++ hd x | BS.head x == sep = x+ | otherwise = sep `BS.cons` x++ tl x | BS.last x == sep = x+ | BS.last bs == sep = x `BS.snoc` sep+ | otherwise = x++ go acc c | c == dot = acc+ go acc c | c == dots = remv acc c+ go acc c = c : acc++ remv [] _ = []+ remv (x : xs) c+ | x == dot = c : xs+ | x == dots = c : x : xs+ | otherwise = xs++ dot = "."+ dots = ".."++ 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)
+ src/Network/AWS/Data/Internal/XML.hs view
@@ -0,0 +1,187 @@+{-# LANGUAGE DefaultSignatures #-}+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE ScopedTypeVariables #-}++-- Module : Network.AWS.Data.Internal.XML+-- Copyright : (c) 2013-2014 Brendan Hay <brendan.g.hay@gmail.com>+-- 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 <brendan.g.hay@gmail.com>+-- Stability : experimental+-- Portability : non-portable (GHC extensions)++module Network.AWS.Data.Internal.XML+ (+ -- * FromXML+ FromXML (..)+ , decodeXML+ , parseXMLText+ , childNodes+ , findElement+ , withContent+ , withElement+ , withNode+ , (.@)+ , (.@?)++ -- * ToXML+ , ToXML (..)+ , ToXMLRoot (..)+ , encodeXML+ , toXMLText+ , namespaced+ , element+ , nodes+ , (=@)+ , unsafeToXML+ ) where++import Control.Applicative+import Control.Monad+import Data.Default.Class+import Data.Maybe+import Data.Monoid+import Data.Text (Text)+import Network.AWS.Data.Internal.ByteString+import Network.AWS.Data.Internal.Text+import Numeric.Natural+import Text.XML++decodeXML :: LazyByteString -> Either String [Node]+decodeXML = either failure success . parseLBS def+ where+ failure = Left . show+ success = Right . elementNodes . documentRoot++encodeXML :: ToXMLRoot a => a -> LazyByteString+encodeXML x = renderLBS def d+ where+ d = Document+ { documentPrologue = p+ , documentRoot = toXMLRoot x+ , documentEpilogue = []+ }++ p = Prologue+ { prologueBefore = []+ , prologueDoctype = Nothing+ , prologueAfter = []+ }++parseXMLText :: FromText a => String -> [Node] -> Either String a+parseXMLText n = withContent n fromText+{-# INLINE parseXMLText #-}++toXMLText :: ToText a => a -> [Node]+toXMLText x = [NodeContent (toText x)]+{-# INLINE toXMLText #-}++(.@) :: FromXML a => [Node] -> Text -> Either String a+ns .@ n = findElement n ns >>= parseXML+{-# INLINE (.@) #-}++(.@?) :: FromXML a => [Node] -> Text -> Either String (Maybe a)+ns .@? n =+ case findElement n ns of+ Left _ -> Right Nothing+ Right xs -> parseXML xs+{-# INLINE (.@?) #-}++namespaced :: Text -> Text -> [Node] -> Element+namespaced g l = element (Name l (Just g) Nothing)+{-# INLINE namespaced #-}++element :: Name -> [Node] -> Element+element n = Element n mempty+{-# INLINE element #-}++nodes :: Name -> [Node] -> [Node]+nodes n ns = [NodeElement (element n ns)]+{-# INLINE nodes #-}++(=@) :: ToXML a => Name -> a -> Node+n =@ x = NodeElement (element n (toXML x))+{-# INLINE (=@) #-}++-- | /Caution:/ This is for use with types which are 'flattened' in+-- AWS service model terminology. It is applied by the generator/templating+-- in safe contexts only.+unsafeToXML :: (Show a, ToXML a) => a -> Node+unsafeToXML x =+ fromMaybe (error $ "Failed to unflatten node-list for: " ++ show x)+ (listToMaybe (toXML x))+{-# INLINE unsafeToXML #-}++withContent :: String -> (Text -> Either String a) -> [Node] -> Either String a+withContent n f = withNode n (join . fmap f . g)+ where+ g (NodeContent x)+ = Right x+ g (NodeElement e)+ = Left $ "unexpected element " ++ show (elementName e) ++ " when expecting node content: " ++ n+ g _ = Left $ "unexpected element, when expecting node content: " ++ n+{-# INLINE withContent #-}++withNode :: String -> (Node -> Either String a) -> [Node] -> Either String a+withNode n f = \case+ [x] -> f x+ [] -> Left $ "empty node list, when expecting a single node: " ++ n+ _ -> Left $ "encountered node list, when expecting a single node: " ++ n+{-# INLINE withNode #-}++withElement :: Text -> ([Node] -> Either String a) -> [Node] -> Either String a+withElement n f = join . fmap f . findElement n+{-# INLINE withElement #-}++findElement :: Text -> [Node] -> Either String [Node]+findElement n = maybe err Right . listToMaybe . mapMaybe (childNodes n)+ where+ err = Left $ "unable to find element " ++ show n+{-# INLINE findElement #-}++childNodes :: Text -> Node -> Maybe [Node]+childNodes n (NodeElement e)+ | nameLocalName (elementName e) == n = Just (elementNodes e)+childNodes _ _ = Nothing+{-# INLINE childNodes #-}++class FromXML a where+ parseXML :: [Node] -> Either String a++instance FromXML a => FromXML (Maybe a) where+ parseXML [] = pure Nothing+ parseXML ns = Just <$> parseXML ns+ {-# INLINE parseXML #-}++instance FromXML Text where parseXML = parseXMLText "Text"+instance FromXML Int where parseXML = parseXMLText "Int"+instance FromXML Integer where parseXML = parseXMLText "Integer"+instance FromXML Natural where parseXML = parseXMLText "Natural"+instance FromXML Double where parseXML = parseXMLText "Double"+instance FromXML Bool where parseXML = parseXMLText "Bool"++class ToXMLRoot a where+ toXMLRoot :: a -> Element++class ToXML a where+ toXML :: a -> [Node]++ default toXML :: ToXMLRoot a => a -> [Node]+ toXML = (:[]) . NodeElement . toXMLRoot+ {-# INLINE toXML #-}++instance ToXML a => ToXML (Maybe a) where+ toXML (Just x) = toXML x+ toXML Nothing = []+ {-# INLINE toXML #-}++instance ToXML Text where toXML = toXMLText+instance ToXML Int where toXML = toXMLText+instance ToXML Integer where toXML = toXMLText+instance ToXML Natural where toXML = toXMLText+instance ToXML Double where toXML = toXMLText+instance ToXML Bool where toXML = toXMLText
+ src/Network/AWS/EC2/Metadata.hs view
@@ -0,0 +1,328 @@+{-# LANGUAGE BangPatterns #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE OverloadedStrings #-}++-- Module : Network.AWS.EC2.Metadata+-- Copyright : (c) 2013-2014 Brendan Hay <brendan.g.hay@gmail.com>+-- 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 <brendan.g.hay@gmail.com>+-- Stability : experimental+-- Portability : non-portable (GHC extensions)++-- | Retrieve an EC2 instance's local metadata.+module Network.AWS.EC2.Metadata+ (+ -- * Requests+ -- ** Running on EC2+ isEC2++ -- ** Dynamic+ , Dynamic (..)+ , dynamic++ -- ** Metadata+ , Metadata (..)+ , Mapping (..)+ , Info (..)+ , Interface (..)+ , metadata++ -- ** User data+ , userdata+ ) where++import Control.Applicative+import Control.Exception+import Control.Monad+import Control.Monad.Except+import Data.ByteString (ByteString)+import qualified Data.ByteString.Char8 as BS+import qualified Data.ByteString.Lazy as LBS+import Data.Maybe+import Data.Monoid+import Data.Text (Text)+import qualified Data.Text as Text+import Network.AWS.Data+import Network.HTTP.Client+import Network.HTTP.Types (status404)++data Dynamic+ = FWS+ -- ^ Value showing whether the customer has enabled detailed one-minute+ -- monitoring in CloudWatch.+ --+ -- Valid values: enabled | disabled.+ | Document+ -- ^ JSON containing instance attributes, such as instance-id,+ -- private IP address, etc.+ | PKCS7+ -- ^ Used to verify the document's authenticity and content against the+ -- signature.+ | Signature++instance ToPath Dynamic where+ toPath x = case x of+ FWS -> "fws/instance-monitoring"+ Document -> "instance-identity/document"+ PKCS7 -> "instance-identity/pkcs7"+ Signature -> "instance-identity/signature"++data Metadata+ = AMIId+ -- ^ The AMI ID used to launch the instance.+ | AMILaunchIndex+ -- ^ If you started more than one instance at the same time, this value+ -- indicates the order in which the instance was launched.+ -- The value of the first instance launched is 0.+ | AMIManifestPath+ -- ^ The path to the AMI's manifest file in Amazon S3.+ -- If you used an Amazon EBS-backed AMI to launch the instance,+ -- the returned result is unknown.+ | AncestorAMIIds+ -- ^ The AMI IDs of any instances that were rebundled to create this AMI.+ -- This value will only exist if the AMI manifest file contained an+ -- ancestor-amis key.+ | BlockDevice !Mapping+ -- ^ See: 'Mapping'+ | Hostname+ -- ^ The private hostname of the instance. In cases where multiple network+ -- interfaces are present, this refers to the eth0 device+ -- (the device for which the device number is 0).+ | IAM !Info+ -- ^ See: 'Info'+ | InstanceAction+ -- ^ Notifies the instance that it should reboot in preparation for bundling.+ -- Valid values: none | shutdown | bundle-pending.+ | InstanceId+ -- ^ The ID of this instance.+ | InstanceType+ -- ^ The type of instance.+ --+ -- See: @InstanceType@+ | KernelId+ -- ^ The ID of the kernel launched with this instance, if applicable.+ | LocalHostname+ -- ^ The private DNS hostname of the instance. In cases where multiple+ -- network interfaces are present, this refers to the eth0 device+ -- (the device for which the device number is 0).+ | LocalIPV4+ -- ^ The private IP address of the instance. In cases where multiple network+ -- interfaces are present, this refers to the eth0 device+ -- (the device for which the device number is 0).+ | MAC+ -- ^ The instance's media access control (MAC) address. In cases where+ -- multiple network interfaces are present, this refers to the eth0 device+ -- (the device for which the device number is 0).+ | Network !Text !Interface+ -- ^ See: 'Interface'+ | AvailabilityZone+ -- ^ The Availability Zone in which the instance launched.+ | ProductCodes+ -- ^ Product codes associated with the instance, if any.+ | PublicHostname+ -- ^ The instance's public DNS. If the instance is in a VPC, this category+ -- is only returned if the enableDnsHostnames attribute is set to true.+ -- For more information, see Using DNS with Your VPC.+ | PublicIPV4+ -- ^ The public IP address. If an Elastic IP address is associated with the+ -- instance, the value returned is the Elastic IP address.+ | OpenSSHKey+ -- ^ Public key. Only available if supplied at instance launch time.+ | RAMDiskId+ -- ^ The ID of the RAM disk specified at launch time, if applicable.+ | ReservationId+ -- ^ ID of the reservation.+ | SecurityGroups+ -- ^ The names of the security groups applied to the instance.+ deriving (Eq, Ord, Show)++instance ToPath Metadata where+ toPath x = case x of+ AMIId -> "ami-id"+ AMILaunchIndex -> "ami-launch-index"+ AMIManifestPath -> "ami-manifest-path"+ AncestorAMIIds -> "ancestor-ami-ids"+ BlockDevice m -> "block-device-mapping/" <> toPath m+ Hostname -> "hostname"+ IAM m -> "iam/" <> toPath m+ InstanceAction -> "instance-action"+ InstanceId -> "instance-id"+ InstanceType -> "instance-type"+ KernelId -> "kernel-id"+ LocalHostname -> "local-hostname"+ LocalIPV4 -> "local-ipv4"+ MAC -> "mac"+ Network n m -> "network/interfaces/macs/" <> n <> "/" <> toPath m+ AvailabilityZone -> "placement/availability-zone"+ ProductCodes -> "product-codes"+ PublicHostname -> "public-hostname"+ PublicIPV4 -> "public-ipv4"+ OpenSSHKey -> "public-keys/0/openssh-key"+ RAMDiskId -> "ramdisk-id"+ ReservationId -> "reservation-id"+ SecurityGroups -> "security-groups"++data Mapping+ = AMI+ -- ^ The virtual device that contains the root/boot file system.+ | EBS !Int+ -- ^ The virtual devices associated with Amazon EBS volumes, if present.+ -- This value is only available in metadata if it is present at launch time.+ -- The N indicates the index of the Amazon EBS volume (such as ebs1 or ebs2).+ | Ephemeral !Int+ -- ^ The virtual devices associated with ephemeral devices, if present.+ -- The N indicates the index of the ephemeral volume.+ | Root+ -- ^ The virtual devices or partitions associated with the root devices,+ -- or partitions on the virtual device, where the root (/ or C:) file system+ -- is associated with the given instance.+ | Swap+ -- ^ The virtual devices associated with swap. Not always present.+ deriving (Eq, Ord, Show)++instance ToPath Mapping where+ toPath x = case x of+ AMI -> "ami"+ EBS n -> "ebs" <> toText n+ Ephemeral n -> "ephemeral" <> toText n+ Root -> "root"+ Swap -> "root"++data Interface+ = IDeviceNumber+ -- ^ The device number associated with that interface. Each interface must+ -- have a unique device number. The device number serves as a hint to device+ -- naming in the instance; for example, device-number is 2 for the eth2 device.+ | IIPV4Associations !Text+ -- ^ The private IPv4 addresses that are associated with each public-ip+ -- address and assigned to that interface.+ | ILocalHostname+ -- ^ The interface's local hostname.+ | ILocalIPV4s+ -- ^ The private IP addresses associated with the interface.+ | IMAC+ -- ^ The instance's MAC address.+ | IOwnerId+ -- ^ The ID of the owner of the network interface. In multiple-interface+ -- environments, an interface can be attached by a third party, such as+ -- Elastic Load Balancing. Traffic on an interface is always billed to+ -- the interface owner.+ | IPublicHostname+ -- ^ The interface's public DNS. If the instance is in a VPC, this category+ -- is only returned if the enableDnsHostnames attribute is set to true.+ -- For more information, see Using DNS with Your VPC.+ | IPublicIPV4s+ -- ^ The Elastic IP addresses associated with the interface. There may be+ -- multiple IP addresses on an instance.+ | ISecurityGroups+ -- ^ Security groups to which the network interface belongs. Returned only+ -- for instances launched into a VPC.+ | ISecurityGroupIds+ -- ^ IDs of the security groups to which the network interface belongs.+ -- Returned only for instances launched into a VPC. For more information on+ -- security groups in the EC2-VPC platform, see Security Groups for Your VPC.+ | ISubnetId+ -- ^ The ID of the subnet in which the interface resides. Returned only for+ -- instances launched into a VPC.+ | ISubnetIPV4_CIDRBlock+ -- ^ The CIDR block of the subnet in which the interface resides. Returned+ -- only for instances launched into a VPC.+ | IVPCId+ -- ^ The ID of the VPC in which the interface resides. Returned only for+ -- instances launched into a VPC.+ | IVPCIPV4_CIDRBlock+ -- ^ The CIDR block of the VPC in which the interface resides. Returned only+ -- for instances launched into a VPC.+ deriving (Eq, Ord, Show)++instance ToPath Interface where+ toPath x = case x of+ IDeviceNumber -> "device-number"+ IIPV4Associations ip -> "ipv4-associations/" <> ip+ ILocalHostname -> "local-hostname"+ ILocalIPV4s -> "local-ipv4s"+ IMAC -> "mac"+ IOwnerId -> "owner-id"+ IPublicHostname -> "public-hostname"+ IPublicIPV4s -> "public-ipv4s"+ ISecurityGroups -> "security-groups"+ ISecurityGroupIds -> "security-group-ids"+ ISubnetId -> "subnet-id"+ ISubnetIPV4_CIDRBlock -> "subnet-ipv4-cidr-block"+ IVPCId -> "vpc-id"+ IVPCIPV4_CIDRBlock -> "vpc-ipv4-cidr-block"++data Info+ = Info+ -- ^ Returns information about the last time the instance profile was updated,+ -- including the instance's LastUpdated date, InstanceProfileArn,+ -- and InstanceProfileId.+ | SecurityCredentials (Maybe Text)+ -- ^ Where role-name is the name of the IAM role associated with the instance.+ -- Returns the temporary security credentials.+ --+ -- See: 'Auth' for JSON deserialisation.+ deriving (Eq, Ord, Show)++instance ToPath Info where+ toPath x = case x of+ Info -> "info"+ SecurityCredentials r -> "security-credentials/" <> fromMaybe "" r++-- | Test whether the host is running on EC2 by requesting the instance-data.+isEC2 :: Manager -> IO Bool+isEC2 m = liftIO (req `catch` err)+ where+ req = do+ !_ <- request m "http://instance-data/latest"+ return True++ err :: IOException -> IO Bool+ err = const (return False)++dynamic :: MonadIO m+ => Manager+ -> Dynamic+ -> ExceptT HttpException m ByteString+dynamic m = get m . mappend "http://169.254.169.254/latest/dynamic/" . toPath++metadata :: MonadIO m+ => Manager+ -> Metadata+ -> ExceptT HttpException m ByteString+metadata m = get m . mappend "http://169.254.169.254/latest/meta-data/" . toPath++userdata :: MonadIO m+ => Manager+ -> ExceptT HttpException m (Maybe ByteString)+userdata m = Just+ `liftM` get m "http://169.254.169.254/latest/user-data"+ `catchError` err+ where+ err (StatusCodeException s _ _)+ | status404 == s = return Nothing+ err e = throwError e++get :: MonadIO m+ => Manager+ -> Text+ -> ExceptT HttpException m ByteString+get m url = ExceptT . liftIO $ req `catch` err+ where+ req = Right . strip <$> request m url++ strip bs+ | BS.isSuffixOf "\n" bs = BS.init bs+ | otherwise = bs++ err :: HttpException -> IO (Either HttpException a)+ err = return . Left++request :: Manager -> Text -> IO ByteString+request m url = do+ rq <- parseUrl (Text.unpack url)+ rs <- httpLbs (rq { responseTimeout = Just 2 }) m+ return . LBS.toStrict $ responseBody rs
+ src/Network/AWS/Error.hs view
@@ -0,0 +1,114 @@+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE ViewPatterns #-}++-- Module : Network.AWS.Error+-- Copyright : (c) 2013-2014 Brendan Hay <brendan.g.hay@gmail.com>+-- 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 <brendan.g.hay@gmail.com>+-- Stability : experimental+-- Portability : non-portable (GHC extensions)++module Network.AWS.Error where++import Control.Applicative+import Control.Monad+import Data.Aeson+import qualified Data.ByteString.Lazy as LBS+import Data.Text (Text)+import GHC.Generics+import Network.AWS.Data+import Network.AWS.Types+import Network.HTTP.Types++statusSuccess :: Status -> Bool+statusSuccess (statusCode -> n) = n >= 200 && n < 400++data ErrorType+ = Receiver+ | Sender+ deriving (Eq, Ord, Enum, Show, Generic)++instance FromText ErrorType where+ parser = match "Receiver" Receiver+ <|> match "Sender" Sender++instance FromXML ErrorType where+ parseXML = parseXMLText "Type"++data RESTMessage = RESTMessage+ { _msgType :: !ErrorType+ , _msgCode :: Text+ , _msgRESTMessage :: Text+ } deriving (Eq, Ord, Show, Generic)++instance FromXML RESTMessage where+ parseXML x = RESTMessage+ <$> x .@ "Type"+ <*> x .@ "Code"+ <*> x .@ "Message"++data RESTError = RESTError+ { _errError :: RESTMessage+ , _errRequestId :: Text+ } deriving (Eq, Show, Generic)++instance FromXML RESTError where+ parseXML x = RESTError+ <$> x .@ "Error"+ <*> x .@ "RequestId"++restError :: FromXML (Er a)+ => (Status -> Bool)+ -> Service a+ -> Status+ -> Maybe (LBS.ByteString -> ServiceError (Er a))+restError f Service{..} s+ | f s = Nothing+ | otherwise = Just (either failure success . (decodeXML >=> parseXML))+ 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>++data JSONError = JSONError+ { _errType :: Text+ , _errMessage :: Text+ } deriving (Eq, Show, Generic)++instance FromJSON JSONError where+ parseJSON = withObject "JSONError" $ \o ->+ JSONError+ <$> o .: "__type"+ <*> o .: "message"++jsonError :: FromJSON (Er a)+ => (Status -> Bool)+ -> Service a+ -> Status+ -> Maybe (LBS.ByteString -> ServiceError (Er a))+jsonError f Service{..} s+ | f s = Nothing+ | otherwise = Just (either failure success . eitherDecode')+ where+ success = ServiceError _svcAbbrev s+ failure = SerializerError _svcAbbrev++-- {"__type":"ResourceNotFoundException","message":"Unable to find instance with ID 1"}
+ src/Network/AWS/Pagination.hs view
@@ -0,0 +1,64 @@+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE RankNTypes #-}++-- Module : Network.AWS.Pagination+-- Copyright : (c) 2013-2014 Brendan Hay <brendan.g.hay@gmail.com>+-- 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 <brendan.g.hay@gmail.com>+-- Stability : experimental+-- Portability : non-portable (GHC extensions)++module Network.AWS.Pagination+ ( more+ , stop+ , index+ , choice+ ) where++import Control.Applicative+import Control.Lens hiding (index)+import Data.HashMap.Strict (HashMap)+import qualified Data.HashMap.Strict as Map+import Data.Text (Text)+import Network.AWS.Data (ToText(..))++-- | Generalise IsTruncated and other optional/required+-- response pagination fields.+class AWSMore a where+ more :: a -> Bool++instance AWSMore Bool where+ more = id++instance AWSMore (Maybe Bool) where+ more (Just x) = x+ more Nothing = False++instance AWSMore (Maybe Text) where+ more (Just _) = True+ more Nothing = False++instance AWSMore [a] where+ more = not . null++instance AWSMore (HashMap k v) where+ more = not . Map.null++stop :: AWSMore a => a -> Bool+stop = not . more++index :: ToText c => Getter a [b] -> Getter b c -> Getter a (Maybe Text)+index f g = f . to lastMay . to (fmap (toText . view g))++choice :: Alternative f => (a -> f b) -> (a -> f b) -> a -> f b+choice f g x = f x <|> g x++lastMay :: [a] -> Maybe a+lastMay [] = Nothing+lastMay (x:xs) = Just (go x xs)+ where+ go y [] = y+ go _ (y:ys) = go y ys
+ src/Network/AWS/Prelude.hs view
@@ -0,0 +1,104 @@+{-# LANGUAGE PatternSynonyms #-}++-- Module : Network.AWS.Prelude.Types+-- Copyright : (c) 2013-2014 Brendan Hay <brendan.g.hay@gmail.com>+-- 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 <brendan.g.hay@gmail.com>+-- Stability : experimental+-- Portability : non-portable (GHC extensions)++module Network.AWS.Prelude+ (+ -- * Re-exported+ module Export++ -- * Primitives+ , ByteString+ , CI+ , ClientRequest+ , ClientResponse+ , Exception+ , HashMap+ , HttpException+ , Natural+ , NonEmpty+ , RequestBody+ , Response+ , Text++ -- * Classes+ , AWSError (..)+ , AWSPager (..)+ , AWSRequest (..)+ , AWSService (..)+ , Generic+ , IsString (..)+ , Semigroup+ , Whole++ -- * Endpoints+ , global+ , regional+ , custom++ -- * Shared+ , Empty (..)+ , Service (..)++ -- * Errors+ , ServiceError (..)++ -- * HTTP+ , StdMethod (..)+ , Status+ ) where++import Network.AWS.Types++import Control.Exception (Exception)+import Data.ByteString (ByteString)+import Data.CaseInsensitive (CI)+import Data.HashMap.Strict (HashMap)+import Data.List.NonEmpty (NonEmpty)+import Data.Semigroup (Semigroup)+import Data.String (IsString(..))+import Data.Text (Text)+import GHC.Generics (Generic)+import Network.HTTP.Client (HttpException, RequestBody)+import Network.HTTP.Types.Method (StdMethod(..))+import Network.HTTP.Types.Status (Status)+import Numeric.Natural (Natural, Whole)++import Control.Applicative as Export+import Data.Bifunctor as Export+import Data.Coerce as Export+import Data.Default.Class as Export+import Data.Hashable as Export+import Data.Maybe as Export+import Data.Monoid as Export hiding (All, Any, Sum)+import Data.Tagged as Export+import Network.AWS.Data as Export hiding (Query)+import Network.AWS.Pagination as Export+import Network.AWS.Response as Export+import Prelude as Export hiding (head, error)++import Control.Lens as Export+ ( Lens'+ , Prism'+ , Iso'+ , (&)+ , (^.)+ , (.~)+ , (?~)+ , (%~)+ , (<>~)+ , lens+ , prism+ , iso+ , withIso+ , to+ , mapping+ )
+ src/Network/AWS/Request/Internal.hs view
@@ -0,0 +1,66 @@+{-# LANGUAGE OverloadedStrings #-}++-- Module : Network.AWS.Request.Internal+-- Copyright : (c) 2013-2014 Brendan Hay <brendan.g.hay@gmail.com>+-- 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 <brendan.g.hay@gmail.com>+-- Stability : experimental+-- Portability : non-portable (GHC extensions)++module Network.AWS.Request.Internal+ (+ -- * Requests+ defaultRequest++ -- * Lenses+ , method+ , host+ , path+ , queryString+ , requestBody+ , requestHeaders+ ) where++import Control.Lens+import Data.ByteString (ByteString)+import Data.Default.Class+import qualified Data.Text.Encoding as Text+import Network.AWS.Data+import Network.AWS.Types+import qualified Network.HTTP.Client.Internal as HTTP+import qualified Network.HTTP.Types as HTTP++defaultRequest :: (ToPath a, ToQuery a, ToHeaders a) => a -> Request a+defaultRequest x = def+ & rqPath .~ Text.encodeUtf8 (toPath x)+ & rqQuery .~ toQuery x+ & rqHeaders .~ toHeaders x+{-# INLINE defaultRequest #-}++method :: Lens' HTTP.Request HTTP.Method+method f x = f (HTTP.method x) <&> \y -> x { HTTP.method = y }+{-# INLINE method #-}++host :: Lens' HTTP.Request ByteString+host f x = f (HTTP.host x) <&> \y -> x { HTTP.host = y }+{-# INLINE host #-}++path :: Lens' HTTP.Request ByteString+path f x = f (HTTP.path x) <&> \y -> x { HTTP.path = y }+{-# INLINE path #-}++queryString :: Lens' HTTP.Request ByteString+queryString f x = f (HTTP.queryString x) <&> \y -> x { HTTP.queryString = y }+{-# INLINE queryString #-}++requestBody :: Lens' HTTP.Request HTTP.RequestBody+requestBody f x = f (HTTP.requestBody x) <&> \y -> x { HTTP.requestBody = y }+{-# INLINE requestBody #-}++requestHeaders :: Lens' HTTP.Request HTTP.RequestHeaders+requestHeaders f x =+ f (HTTP.requestHeaders x) <&> \y -> x { HTTP.requestHeaders = y }+{-# INLINE requestHeaders #-}
+ src/Network/AWS/Request/JSON.hs view
@@ -0,0 +1,46 @@+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE ScopedTypeVariables #-}++-- Module : Network.AWS.Request.JSON+-- Copyright : (c) 2013-2014 Brendan Hay <brendan.g.hay@gmail.com>+-- 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 <brendan.g.hay@gmail.com>+-- Stability : experimental+-- Portability : non-portable (GHC extensions)++module Network.AWS.Request.JSON+ ( post+ ) where++import Control.Applicative+import Control.Lens hiding (Action)+import Data.Aeson+import Data.Monoid+import Network.AWS.Data+import Network.AWS.Request.Internal+import Network.AWS.Types+import Network.HTTP.Types.Header+import Network.HTTP.Types.Method++post :: forall a. (AWSService (Sv a), ToQuery a, ToPath a, ToHeaders a, ToJSON a)+ => Action+ -> a+ -> Request a+post a x = defaultRequest x+ & rqMethod .~ POST+ & rqHeaders <>~ hs+ & rqBody .~ toBody (toJSON x)+ where+ hs = toHeader hAMZTarget target+ ++ toHeader hContentType content++ target = (\p -> p <> "." <> toBS a) <$> _svcTargetPrefix svc+ content = ("application/x-amz-json-" <>) <$> _svcJSONVersion svc++ svc :: Service (Sv a)+ svc = service+{-# INLINE post #-}
+ src/Network/AWS/Request/Query.hs view
@@ -0,0 +1,38 @@+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE ScopedTypeVariables #-}++-- Module : Network.AWS.Request.Query+-- Copyright : (c) 2013-2014 Brendan Hay <brendan.g.hay@gmail.com>+-- 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 <brendan.g.hay@gmail.com>+-- Stability : experimental+-- Portability : non-portable (GHC extensions)++module Network.AWS.Request.Query+ ( post+ ) where++import Control.Lens hiding (Action)+import Data.Monoid+import Network.AWS.Data+import Network.AWS.Request.Internal+import Network.AWS.Types+import Network.HTTP.Types.Method++post :: forall a. (AWSService (Sv a), ToQuery a, ToPath a, ToHeaders a)+ => Action+ -> a+ -> Request a+post a x = defaultRequest x & rqMethod .~ POST & rqQuery <>~ qry+ where+ qry = pair "Version" (_svcVersion svc)+ . pair "Action" (toBS a)+ $ mempty++ svc :: Service (Sv a)+ svc = service+{-# INLINE post #-}
+ src/Network/AWS/Request/RestJSON.hs view
@@ -0,0 +1,58 @@+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE ScopedTypeVariables #-}++-- Module : Network.AWS.Request.RestJSON+-- Copyright : (c) 2013-2014 Brendan Hay <brendan.g.hay@gmail.com>+-- 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 <brendan.g.hay@gmail.com>+-- Stability : experimental+-- Portability : non-portable (GHC extensions)++module Network.AWS.Request.RestJSON+ ( get+ , delete+ , post+ , put+ ) where++import Control.Applicative+import Control.Lens hiding (Action)+import Data.Aeson+import Data.Monoid+import Network.AWS.Data+import Network.AWS.Request.Internal+import Network.AWS.Types+import Network.HTTP.Types.Header+import Network.HTTP.Types.Method++get :: (ToPath a, ToQuery a, ToHeaders a) => a -> Request a+get = defaultRequest+{-# INLINE get #-}++delete :: (ToPath a, ToQuery a, ToHeaders a) => a -> Request a+delete x = get x & rqMethod .~ DELETE+{-# INLINE delete #-}++post :: (AWSService (Sv a), ToQuery a, ToPath a, ToHeaders a, ToJSON a)+ => a+ -> Request a+post x = put x & rqMethod .~ POST+{-# INLINE post #-}++put :: forall a. (AWSService (Sv a), ToQuery a, ToPath a, ToHeaders a, ToJSON a)+ => a+ -> Request a+put x = get x+ & rqMethod .~ PUT+ & rqHeaders <>~ toHeader hContentType content+ & rqBody .~ toBody (toJSON x)+ where+ content = ("application/x-amz-json-" <>) <$> _svcJSONVersion svc++ svc :: Service (Sv a)+ svc = service+{-# INLINE put #-}
+ src/Network/AWS/Request/RestXML.hs view
@@ -0,0 +1,52 @@+-- Module : Network.AWS.Request.RestXML+-- Copyright : (c) 2013-2014 Brendan Hay <brendan.g.hay@gmail.com>+-- 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 <brendan.g.hay@gmail.com>+-- Stability : experimental+-- Portability : non-portable (GHC extensions)++module Network.AWS.Request.RestXML+ ( get+ , head+ , delete+ , post+ , put+ , stream+ ) where++import Control.Lens+import Network.AWS.Data+import Network.AWS.Request.Internal+import Network.AWS.Types+import Network.HTTP.Types.Method+import Prelude hiding (head)++get :: (ToPath a, ToQuery a, ToHeaders a) => a -> Request a+get = defaultRequest+{-# INLINE get #-}++delete :: (ToPath a, ToQuery a, ToHeaders a) => a -> Request a+delete x = get x & rqMethod .~ DELETE+{-# INLINE delete #-}++head :: (ToPath a, ToQuery a, ToHeaders a) => a -> Request a+head x = get x & rqMethod .~ HEAD+{-# INLINE head #-}++post :: (ToPath a, ToQuery a, ToHeaders a, ToXMLRoot a) => a -> Request a+post x = put x & rqMethod .~ POST+{-# INLINE post #-}++put :: (ToPath a, ToQuery a, ToHeaders a, ToXMLRoot a) => a -> Request a+put x = get x & rqMethod .~ PUT & rqBody .~ toBody (encodeXML x)+{-# INLINE put #-}++stream :: (ToPath a, ToQuery a, ToHeaders a, ToBody a)+ => StdMethod+ -> a+ -> Request a+stream m x = get x & rqMethod .~ m & rqBody .~ toBody x+{-# INLINE stream #-}
+ src/Network/AWS/Response.hs view
@@ -0,0 +1,133 @@+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeFamilies #-}++-- Module : Network.AWS.Response+-- Copyright : (c) 2013-2014 Brendan Hay <brendan.g.hay@gmail.com>+-- 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 <brendan.g.hay@gmail.com>+-- Stability : experimental+-- Portability : non-portable (GHC extensions)++module Network.AWS.Response+ (+ -- * Responses+ nullResponse+ , headerResponse+ , xmlResponse+ , xmlHeaderResponse+ , jsonResponse+ , jsonHeaderResponse+ , bodyResponse+ ) where++import Control.Applicative+import Control.Monad+import Control.Monad.Trans.Resource+import Data.Aeson+import Data.Bifunctor+import qualified Data.ByteString.Lazy as LBS+import Data.Conduit+import qualified Data.Conduit.Binary as Conduit+import Network.AWS.Data (LazyByteString, FromXML(..), decodeXML)+import Network.AWS.Types+import Network.HTTP.Client hiding (Response)+import Network.HTTP.Types+import Text.XML (Node)++nullResponse :: (MonadResource m, AWSService (Sv a))+ => Rs a+ -> a+ -> Either HttpException ClientResponse+ -> m (Response a)+nullResponse rs = receive $ \_ _ bdy ->+ liftResourceT (bdy $$+- return (Right rs))+{-# INLINE nullResponse #-}++headerResponse :: (MonadResource m, AWSService (Sv a))+ => (ResponseHeaders -> Either String (Rs a))+ -> a+ -> Either HttpException ClientResponse+ -> m (Response a)+headerResponse f = deserialise (const (Right ())) (const . f)+{-# INLINE headerResponse #-}++xmlResponse :: (MonadResource m, AWSService (Sv a), FromXML (Rs a))+ => a+ -> Either HttpException ClientResponse+ -> m (Response a)+xmlResponse = deserialise (decodeXML >=> parseXML) (const Right)+{-# INLINE xmlResponse #-}++xmlHeaderResponse :: (MonadResource m, AWSService (Sv a))+ => (ResponseHeaders -> [Node] -> Either String (Rs a))+ -> a+ -> Either HttpException ClientResponse+ -> m (Response a)+xmlHeaderResponse = deserialise decodeXML+{-# INLINE xmlHeaderResponse #-}++jsonResponse :: (MonadResource m, AWSService (Sv a), FromJSON (Rs a))+ => a+ -> Either HttpException ClientResponse+ -> m (Response a)+jsonResponse = deserialise eitherDecode' (const Right)+{-# INLINE jsonResponse #-}++jsonHeaderResponse :: (MonadResource m, AWSService (Sv a))+ => (ResponseHeaders -> Object -> Either String (Rs a))+ -> a+ -> Either HttpException ClientResponse+ -> m (Response a)+jsonHeaderResponse = deserialise eitherDecode'+{-# INLINE jsonHeaderResponse #-}++bodyResponse :: (MonadResource m, AWSService (Sv a))+ => (ResponseHeaders -> ResponseBody -> Either String (Rs a))+ -> a+ -> Either HttpException ClientResponse+ -> m (Response a)+bodyResponse f = receive $ \a hs bdy ->+ return (SerializerError a `first` f hs bdy)+{-# INLINE bodyResponse #-}++deserialise :: (AWSService (Sv a), MonadResource m)+ => (LazyByteString -> Either String b)+ -> (ResponseHeaders -> b -> Either String (Rs a))+ -> a+ -> Either HttpException ClientResponse+ -> m (Response a)+deserialise g f = receive $ \a hs bdy -> do+ lbs <- sinkLbs bdy+ return $! case g lbs of+ Left e -> Left (SerializerError a e)+ Right o ->+ case f hs o of+ Left e -> Left (SerializerError a e)+ Right x -> Right x++receive :: forall m a. (MonadResource m, AWSService (Sv a))+ => (Abbrev -> ResponseHeaders -> ResponseBody -> m (Response a))+ -> a+ -> Either HttpException ClientResponse+ -> m (Response a)+receive f = const (either (return . Left . HttpError) success)+ where+ success rs =+ maybe (f (_svcAbbrev svc) hs bdy)+ (\g -> Left . g <$> sinkLbs bdy)+ (handle svc s)+ where+ svc = service :: Service (Sv a)++ s = responseStatus rs+ bdy = responseBody rs+ hs = responseHeaders rs++sinkLbs :: MonadResource m => ResponseBody -> m LBS.ByteString+sinkLbs bdy = liftResourceT (bdy $$+- Conduit.sinkLbs)+{-# INLINE sinkLbs #-}
+ src/Network/AWS/Signing/Internal.hs view
@@ -0,0 +1,49 @@+{-# LANGUAGE ConstraintKinds #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TypeFamilies #-}++-- Module : Network.AWS.Signing.Internal+-- Copyright : (c) 2013-2014 Brendan Hay <brendan.g.hay@gmail.com>+-- 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 <brendan.g.hay@gmail.com>+-- Stability : experimental+-- Portability : non-portable (GHC extensions)++module Network.AWS.Signing.Internal where++import Control.Monad.IO.Class+import qualified Crypto.Hash.SHA256 as SHA256+import qualified Crypto.MAC.HMAC as HMAC+import Data.ByteString (ByteString)+import Data.Time+import Network.AWS.Types+import System.Locale++sign :: (MonadIO m, AWSRequest a, AWSSigner (Sg (Sv a)))+ => Auth -- ^ AWS authentication credentials.+ -> Region -- ^ AWS Region.+ -> Request a -- ^ Request to sign.+ -> UTCTime -- ^ Signing time.+ -> m (Signed a (Sg (Sv a)))+sign a r rq t = withAuth a $ \e -> return $+ signed e r rq defaultTimeLocale t++presign :: (MonadIO m, AWSRequest a, AWSPresigner (Sg (Sv a)))+ => Auth -- ^ AWS authentication credentials.+ -> Region -- ^ AWS Region.+ -> Request a -- ^ Request to presign.+ -> UTCTime -- ^ Signing time.+ -> Int -- ^ Expiry time in seconds.+ -> m (Signed a (Sg (Sv a)))+presign a r rq t x = withAuth a $ \e -> return $+ presigned e r rq defaultTimeLocale t x++hmacSHA256 :: ByteString -> ByteString -> ByteString+hmacSHA256 = HMAC.hmac SHA256.hash 64++serviceOf :: AWSService (Sv a) => Request a -> Service (Sv a)+serviceOf = const service
+ src/Network/AWS/Signing/V2.hs view
@@ -0,0 +1,98 @@+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE TupleSections #-}+{-# LANGUAGE TypeFamilies #-}++-- Module : Network.AWS.Signing.V2+-- Copyright : (c) 2013-2014 Brendan Hay <brendan.g.hay@gmail.com>+-- 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 <brendan.g.hay@gmail.com>+-- Stability : experimental+-- Portability : non-portable (GHC extensions)++module Network.AWS.Signing.V2+ (+ -- * Types+ V2+ , Meta (..)++ -- * Re-exports+ , module Network.AWS.Signing.Internal+ ) where++import Control.Applicative+import Control.Lens+import Data.ByteString (ByteString)+import qualified Data.ByteString.Base64 as Base64+import qualified Data.ByteString.Char8 as BS+import Data.Monoid+import Data.Time+import Network.AWS.Data+import Network.AWS.Request.Internal+import Network.AWS.Signing.Internal+import Network.AWS.Types+import Network.HTTP.Types hiding (toQuery)++data V2++data instance Meta V2 = Meta+ { _mSignature :: ByteString+ , _mTime :: UTCTime+ }++instance Show (Meta V2) where+ show Meta{..} = BS.unpack $ BS.unlines+ [ "Version 2 Metadata:"+ , "_mSignature " <> _mSignature+ , "_mTime " <> toBS _mTime+ ]++instance AWSSigner V2 where+ signed AuthEnv{..} r x@Request{..} l t = Signed meta rq+ where+ meta = Meta+ { _mSignature = signature+ , _mTime = t+ }++ rq = clientRequest+ & method .~ meth+ & host .~ host'+ & path .~ _rqPath+ & queryString .~ toBS authorised+ & requestHeaders .~ headers+ & requestBody .~ _bdyBody _rqBody++ meth = toBS _rqMethod+ host' = toBS (endpoint svc r)++ authorised = pair "Signature" (urlEncode True signature) query++ signature = Base64.encode+ . hmacSHA256 (toBS _authSecret)+ $ BS.intercalate "\n"+ [ meth+ , host'+ , _rqPath+ , toBS query+ ]++ query =+ pair "Version" (_svcVersion svc)+ . pair "SignatureVersion" ("2" :: ByteString)+ . pair "SignatureMethod" ("HmacSHA256" :: ByteString)+ . pair "Timestamp" time+ . pair "AWSAccessKeyId" (toBS _authAccess)+ $ _rqQuery <> maybe mempty toQuery token++ token = ("SecurityToken" :: ByteString,) . toBS <$> _authToken++ headers = hdr hDate time _rqHeaders++ time = toBS (LocaleTime l t :: ISO8601)++ svc = serviceOf x
+ src/Network/AWS/Signing/V3.hs view
@@ -0,0 +1,88 @@+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE TupleSections #-}+{-# LANGUAGE TypeFamilies #-}++-- Module : Network.AWS.Signing.V3+-- Copyright : (c) 2013-2014 Brendan Hay <brendan.g.hay@gmail.com>+-- 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 <brendan.g.hay@gmail.com>+-- Stability : experimental+-- Portability : non-portable (GHC extensions)++module Network.AWS.Signing.V3+ (+ -- * Types+ V3+ , Meta (..)++ -- * Re-exports+ , module Network.AWS.Signing.Internal+ ) where++import Control.Applicative+import Control.Lens+import Data.ByteString (ByteString)+import qualified Data.ByteString.Base64 as Base64+import qualified Data.ByteString.Char8 as BS+import Data.List (sortBy)+import Data.Maybe+import Data.Monoid+import Data.Ord+import Data.Time+import Network.AWS.Data+import Network.AWS.Request.Internal+import Network.AWS.Signing.Internal+import Network.AWS.Types+import Network.HTTP.Types.Header++data V3++data instance Meta V3 = Meta+ { _mSignature :: ByteString+ , _mTime :: UTCTime+ }++instance Show (Meta V3) where+ show Meta{..} = BS.unpack $ BS.unlines+ [ "Version 3 Metadata:"+ , "_mSignature " <> _mSignature+ , "_mTime " <> toBS _mTime+ ]++instance AWSSigner V3 where+ signed AuthEnv{..} r x@Request{..} l t = Signed meta rq+ where+ meta = Meta+ { _mSignature = signature+ , _mTime = t+ }++ rq = clientRequest+ & method .~ toBS _rqMethod+ & host .~ host'+ & path .~ _rqPath+ & queryString .~ toBS _rqQuery+ & requestHeaders .~ headers+ & requestBody .~ _bdyBody _rqBody++ host' = toBS (endpoint (serviceOf x) r)++ headers = sortBy (comparing fst)+ . hdr hAMZAuth authorisation+ . hdr hHost host'+ . hdr hDate (toBS (LocaleTime l t :: RFC822))+ $ _rqHeaders+ ++ maybeToList ((hAMZToken,) . toBS <$> _authToken)++ authorisation = "AWS3-HTTPS AWSAccessKeyId="+ <> toBS _authAccess+ <> ", Algorithm=HmacSHA256, Signature="+ <> signature++ signature = Base64.encode+ $ hmacSHA256 (toBS _authSecret) (toBS (LocaleTime l t :: AWSTime))
+ src/Network/AWS/Signing/V4.hs view
@@ -0,0 +1,205 @@+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE TupleSections #-}+{-# LANGUAGE TypeFamilies #-}++-- Module : Network.AWS.Signing.V4+-- Copyright : (c) 2013-2014 Brendan Hay <brendan.g.hay@gmail.com>+-- 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 <brendan.g.hay@gmail.com>+-- Stability : experimental+-- Portability : non-portable (GHC extensions)++module Network.AWS.Signing.V4+ (+ -- * Types+ V4+ , Meta (..)+ , authorisation++ -- * Re-exports+ , module Network.AWS.Signing.Internal+ ) where++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+import qualified Data.ByteString.Char8 as BS+import qualified Data.CaseInsensitive as CI+import qualified Data.Foldable as Fold+import Data.Function+import Data.List (groupBy, intersperse, sortBy, sort)+import Data.Maybe+import Data.Monoid+import Data.Ord+import Data.Time+import Network.AWS.Data+import Network.AWS.Request.Internal+import Network.AWS.Signing.Internal+import Network.AWS.Types+import Network.HTTP.Types.Header+import System.Locale++data V4++data instance Meta V4 = Meta+ { _mAlgorithm :: ByteString+ , _mScope :: ByteString+ , _mSigned :: ByteString+ , _mCReq :: ByteString+ , _mSTS :: ByteString+ , _mSignature :: ByteString+ , _mTime :: UTCTime+ }++instance Show (Meta V4) where+ show Meta{..} = BS.unpack $ BS.unlines+ [ "Version 4 Metadata:"+ , "_mAlgorithm " <> _mAlgorithm+ , "_mScope " <> _mScope+ , "_mSigned " <> _mSigned+ , "_mCReq " <> _mCReq+ , "_mSTS " <> _mSTS+ , "_mSignature " <> _mSignature+ , "_mTime " <> toBS _mTime+ ]++instance AWSPresigner V4 where+ presigned a r rq l t x = out+ & sgRequest . queryString <>~ auth (out ^. sgMeta)+ where+ out = finalise Nothing qry service a r rq l t++ qry cs sh =+ 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-SignedHeaders" sh+ . pair "X-AMZ-Security-Token" (toBS <$> _authToken a)++ auth = mappend "&X-AMZ-Signature=" . _mSignature++instance AWSSigner V4 where+ signed a r rq l t = out+ & sgRequest+ %~ requestHeaders+ %~ hdr hAuthorization (authorisation $ out ^. sgMeta)+ where+ out = finalise (Just "AWS4") (\_ _ -> id) service a r inp l t++ inp = rq & rqHeaders %~ hdrs (maybeToList tok)++ tok = (hAMZToken,) . toBS <$> _authToken a++authorisation :: Meta V4 -> ByteString+authorisation Meta{..} = BS.concat+ [ _mAlgorithm+ , " Credential="+ , _mScope+ , ", SignedHeaders="+ , _mSigned+ , ", Signature="+ , _mSignature+ ]++algorithm :: ByteString+algorithm = "AWS4-HMAC-SHA256"++finalise :: Maybe ByteString+ -> (ByteString -> ByteString -> Query -> Query)+ -> Service (Sv a)+ -> AuthEnv+ -> Region+ -> Request a+ -> TimeLocale+ -> UTCTime+ -> Signed a V4+finalise p qry s@Service{..} AuthEnv{..} r Request{..} l t = Signed meta rq+ where+ meta = Meta+ { _mAlgorithm = algorithm+ , _mCReq = canonicalRequest+ , _mScope = toBS _authAccess <> "/" <> credentialScope+ , _mSigned = signedHeaders+ , _mSTS = stringToSign+ , _mSignature = signature+ , _mTime = t+ }++ rq = clientRequest+ & method .~ meth+ & host .~ host'+ & path .~ _rqPath+ & queryString .~ toBS query+ & requestHeaders .~ headers+ & requestBody .~ _bdyBody _rqBody++ meth = toBS _rqMethod+ host' = toBS (endpoint s r)+ query = qry credentialScope signedHeaders _rqQuery++ canonicalQuery = toBS $ query+ & valuesOf %~ Just . maybe "" (encodeURI True)+ & keysOf %~ encodeURI False++ headers = sortBy (comparing fst)+ . hdr hHost host'+ . hdr hDate (toBS (LocaleTime l t :: RFC822))+ $ _rqHeaders++ joinedHeaders = map f $ groupBy ((==) `on` fst) headers+ where+ f [] = ("", "")+ f (h:hs) = (fst h, g $ h : hs)++ g = BS.intercalate "," . sort . map snd++ signedHeaders = mconcat+ . intersperse ";"+ $ map (CI.foldedCase . fst) joinedHeaders++ canonicalHeaders = Fold.foldMap f joinedHeaders+ where+ f (k, v) = CI.foldedCase k+ <> ":"+ <> stripBS v+ <> "\n"++ canonicalRequest = mconcat $ intersperse "\n"+ [ meth+ , collapseURI (encodeURI False _rqPath)+ , canonicalQuery+ , canonicalHeaders+ , signedHeaders+ , digestToHexByteString (_bdyHash _rqBody)+ ]++ scope =+ [ toBS (LocaleTime l t :: BasicTime)+ , toBS r+ , toBS _svcPrefix+ , "aws4_request"+ ]++ credentialScope = BS.intercalate "/" scope++ signingKey = Fold.foldl1 hmacSHA256 $+ maybe (toBS _authSecret) (<> toBS _authSecret) p : scope++ stringToSign = BS.intercalate "\n"+ [ algorithm+ , toBS (LocaleTime l t :: AWSTime)+ , credentialScope+ , Base16.encode (SHA256.hash canonicalRequest)+ ]++ signature = Base16.encode (hmacSHA256 signingKey stringToSign)
+ src/Network/AWS/Types.hs view
@@ -0,0 +1,465 @@+{-# LANGUAGE DefaultSignatures #-}+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE GADTs #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE StandaloneDeriving #-}+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE TupleSections #-}+{-# LANGUAGE TypeFamilies #-}++-- Module : Network.AWS.Types+-- Copyright : (c) 2013-2014 Brendan Hay <brendan.g.hay@gmail.com>+-- 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 <brendan.g.hay@gmail.com>+-- Stability : experimental+-- Portability : non-portable (GHC extensions)++module Network.AWS.Types+ (+ -- * Authentication+ -- ** Credentials+ AccessKey (..)+ , SecretKey (..)+ , SecurityToken (..)+ -- ** Environment+ , AuthEnv (..)+ , Auth (..)+ , withAuth++ -- * Logger+ , Logger (..)+ , debug++ -- * Services+ , Abbrev+ , AWSService (..)+ , Service (..)++ -- * Endpoints+ , Endpoint (..)+ , Host (..)+ , endpoint+ , global+ , regional+ , custom++ -- * Errors+ , ServiceError (..)+ , _HttpError+ , _SerializerError+ , _ServiceError+ , _Errors++ , AWSError+ , awsError++ -- * Signing+ , AWSSigner (..)+ , AWSPresigner (..)+ , Signed (..)+ , Meta+ , sgMeta+ , sgRequest++ -- * Requests+ , AWSRequest (..)+ , AWSPager (..)+ , Request (..)+ , rqMethod+ , rqHeaders+ , rqPath+ , rqQuery+ , rqBody++ -- * Responses+ , Response+ , Empty (..)++ -- * Regions+ , Region (..)+ , Zone (..)+ , zRegion+ , zSuffix++ -- * Shared+ , Action (..)++ -- * Convenience+ , ClientRequest+ , ClientResponse+ , ResponseBody+ , clientRequest+ ) where++import Control.Applicative+import Control.Concurrent (ThreadId)+import Control.Exception (Exception)+import Control.Lens hiding (Action)+import Control.Monad.IO.Class+import Control.Monad.Trans.Resource+import Data.Aeson hiding (Error)+import qualified Data.Attoparsec.Text as AText+import Data.ByteString (ByteString)+import Data.Char+import Data.Conduit+import Data.Default.Class+import Data.IORef+import Data.Monoid+import Data.String+import Data.Text (Text)+import qualified Data.Text as Text+import qualified Data.Text.Encoding as Text+import Data.Time+import Data.Typeable+import GHC.Generics+import Network.AWS.Data hiding ((.:), (.:?))+import qualified Network.HTTP.Client as Client+import Network.HTTP.Client hiding (Request, Response)+import Network.HTTP.Types.Header+import Network.HTTP.Types.Method+import Network.HTTP.Types.Status (Status)+import System.Locale++-- | Abbreviated service name.+type Abbrev = Text++-- | An error type representing the subset of errors that can be directly+-- attributed to this library.+data ServiceError a+ = HttpError HttpException+ | SerializerError Abbrev String+ | ServiceError Abbrev Status a+ | Errors [ServiceError a]+ deriving (Show, Typeable)++instance (Show a, Typeable a) => Exception (ServiceError a)++instance Monoid (ServiceError a) where+ mempty = Errors []+ mappend a b = Errors (f a <> f b)+ where+ f (Errors xs) = xs+ f x = [x]++class AWSError a where+ awsError :: a -> ServiceError String++instance Show a => AWSError (ServiceError a) where+ awsError = \case+ HttpError e -> HttpError e+ SerializerError a e -> SerializerError a e+ ServiceError a s x -> ServiceError a s (show x)+ Errors xs -> Errors (map awsError xs)++-- | The properties (such as endpoint) for a service, as well as it's+-- associated signing algorithm and error types.+class (AWSSigner (Sg a), Show (Er a)) => AWSService a where+ -- | Signing algorithm supported by the service.+ type Sg a :: *++ -- | The general service error.+ type Er a :: *++ service :: Service a+ handle :: Service a+ -> Status+ -> Maybe (LazyByteString -> ServiceError (Er a))++-- | An alias for the common response 'Either' containing a service error in the+-- 'Left' case, or the expected response in the 'Right'.+type Response a = Either (ServiceError (Er (Sv a))) (Rs a)++-- | Specify how a request can be de/serialised.+class (AWSService (Sv a), AWSSigner (Sg (Sv a))) => AWSRequest a where+ -- | The service definition for a request.+ type Sv a :: *++ -- | The successful, expected response associated with a request.+ type Rs a :: *++ request :: a -> Request a+ response :: MonadResource m+ => a+ -> Either HttpException ClientResponse+ -> m (Response a)++-- | Specify how an 'AWSRequest' and it's associated 'Rs' response can generate+-- a subsequent request, if available.+class AWSRequest a => AWSPager a where+ page :: a -> Rs a -> Maybe a++-- | Signing metadata data specific to a signing algorithm.+--+-- /Note:/ this is used for test and debug purposes, or is otherwise ignored.+data family Meta v :: *++-- | A signed 'ClientRequest' and associated metadata specific to the signing+-- algorithm that was used.+data Signed a v where+ Signed :: Show (Meta v)+ => { _sgMeta :: Meta v+ , _sgRequest :: ClientRequest+ }+ -> Signed a v++sgMeta :: Lens' (Signed a v) (Meta v)+sgMeta f (Signed m rq) = f m <&> \y -> Signed y rq++sgRequest :: Lens' (Signed a v) ClientRequest+sgRequest f (Signed m rq) = f rq <&> \y -> Signed m y++instance ToText (Signed a v) where+ toText (Signed m rq) = Text.unlines+ [ Text.pack (show m)+ , "HTTP Request:"+ , Text.pack (show rq)+ ]++class AWSSigner v where+ signed :: (AWSService (Sv a), v ~ Sg (Sv a))+ => AuthEnv+ -> Region+ -> Request a+ -> TimeLocale+ -> UTCTime+ -> Signed a v++class AWSPresigner v where+ presigned :: (AWSService (Sv a), v ~ Sg (Sv a))+ => AuthEnv+ -> Region+ -> Request a+ -> TimeLocale+ -> UTCTime+ -> Int+ -> Signed a v++-- | Access key credential.+newtype AccessKey = AccessKey ByteString+ deriving (Eq, Show, IsString)++instance ToByteString AccessKey where+ toBS (AccessKey k) = k++instance ToText AccessKey where+ toText = Text.decodeUtf8 . toBS++-- | Secret key credential.+newtype SecretKey = SecretKey ByteString+ deriving (Eq, Show, IsString)++instance ToByteString SecretKey where+ toBS (SecretKey k) = k++instance ToText SecretKey where+ toText = Text.decodeUtf8 . toBS++-- | A security token used by STS to temporarily authorise access to an AWS resource.+newtype SecurityToken = SecurityToken ByteString+ deriving (Eq, Show, IsString)++instance ToByteString SecurityToken where+ toBS (SecurityToken t) = t++-- | The authorisation environment.+data AuthEnv = AuthEnv+ { _authAccess :: !AccessKey+ , _authSecret :: !SecretKey+ , _authToken :: Maybe SecurityToken+ , _authExpiry :: Maybe UTCTime+ }++instance FromJSON AuthEnv where+ parseJSON = withObject "AuthEnv" $ \o -> AuthEnv+ <$> f AccessKey (o .: "AccessKeyId")+ <*> f SecretKey (o .: "SecretAccessKey")+ <*> fmap (f SecurityToken) (o .:? "Token")+ <*> o .:? "Expiration"+ where+ f g = fmap (g . Text.encodeUtf8)++-- | An authorisation environment containing AWS credentials and potentially+-- a reference which can be refreshed out-of-band as they expire.+data Auth+ = Ref ThreadId (IORef AuthEnv)+ | Auth AuthEnv++withAuth :: MonadIO m => Auth -> (AuthEnv -> m a) -> m a+withAuth (Auth e) f = f e+withAuth (Ref _ r) f = liftIO (readIORef r) >>= f++-- | The log level and associated logger function.+data Logger+ = None+ | Debug (Text -> IO ())++-- | Log a message using the debug logger, or if none is specified noop.+debug :: MonadIO m => Logger -> Text -> m ()+debug None = const (return ())+debug (Debug f) = liftIO . f++newtype Host = Host ByteString+ deriving (Eq, Show)++instance ToByteString Host where+ toBS (Host h) = h++-- | The scope for a service's endpoint.+data Endpoint+ = Global+ | Regional+ | Custom ByteString++instance IsString Endpoint where+ fromString = Custom . fromString++-- | Determine the full host address for a 'Service within the given 'Region'.+endpoint :: Service a -> Region -> Host+endpoint Service{..} reg =+ let suf = ".amazonaws.com"+ in Host $ case _svcEndpoint of+ Global -> _svcPrefix <> suf+ Regional -> _svcPrefix <> "." <> toBS reg <> suf+ Custom x -> x++global, regional :: Endpoint+global = Global+regional = Regional++custom :: ByteString -> Endpoint+custom = Custom++-- | Attributes specific to an AWS service.+data Service a = Service+ { _svcAbbrev :: !Text+ , _svcEndpoint :: !Endpoint+ , _svcPrefix :: ByteString+ , _svcVersion :: ByteString+ , _svcTargetPrefix :: Maybe ByteString+ , _svcJSONVersion :: Maybe ByteString+ }++-- | An unsigned request.+data Request a = Request+ { _rqMethod :: !StdMethod+ , _rqPath :: ByteString+ , _rqQuery :: Query+ , _rqHeaders :: [Header]+ , _rqBody :: RqBody+ }++instance Default (Request a) where+ def = Request GET "/" mempty mempty ""++instance ToText (Request a) where+ toText Request{..} = Text.unlines+ [ "Request:"+ , "_rqMethod = " <> toText _rqMethod+ , "_rqPath = " <> toText _rqPath+ , "_rqQuery = " <> toText _rqQuery+ , "_rqHeaders = " <> toText _rqHeaders+ , "_rqBody = " <> toText _rqBody+ ]++-- | The sum of available AWS regions.+data Region+ = Ireland -- ^ Europe / eu-west-1+ | Tokyo -- ^ Asia Pacific / ap-northeast-1+ | Singapore -- ^ Asia Pacific / ap-southeast-1+ | Sydney -- ^ Asia Pacific / ap-southeast-2+ | Beijing -- ^ China / cn-north-1+ | NorthVirginia -- ^ US / us-east-1+ | NorthCalifornia -- ^ US / us-west-1+ | Oregon -- ^ US / us-west-2+ | GovCloud -- ^ AWS GovCloud / us-gov-west-1+ | GovCloudFIPS -- ^ AWS GovCloud (FIPS 140-2) S3 Only / fips-us-gov-west-1+ | SaoPaulo -- ^ South America / sa-east-1+ deriving (Eq, Ord, Read, Show, Generic)++instance Default Region where+ def = NorthVirginia++instance FromText Region where+ parser = match "eu-west-1" Ireland+ <|> match "ap-northeast-1" Tokyo+ <|> match "ap-southeast-1" Singapore+ <|> match "ap-southeast-2" Sydney+ <|> match "cn-north-1" Beijing+ <|> match "us-east-1" NorthVirginia+ <|> match "us-west-2" NorthCalifornia+ <|> match "us-west-1" Oregon+ <|> match "us-gov-west-1" GovCloud+ <|> match "fips-us-gov-west-1" GovCloudFIPS+ <|> match "sa-east-1" SaoPaulo++instance ToText Region where+ toText r = case r of+ Ireland -> "eu-west-1"+ Tokyo -> "ap-northeast-1"+ Singapore -> "ap-southeast-1"+ Sydney -> "ap-southeast-2"+ Beijing -> "cn-north-1"+ NorthVirginia -> "us-east-1"+ NorthCalifornia -> "us-west-1"+ Oregon -> "us-west-2"+ GovCloud -> "us-gov-west-1"+ GovCloudFIPS -> "fips-us-gov-west-1"+ SaoPaulo -> "sa-east-1"++instance ToByteString Region++instance FromXML Region where parseXML = parseXMLText "Region"+instance ToXML Region where toXML = toXMLText++-- | An availability zone.+data Zone = Zone+ { _zRegion :: !Region+ , _zSuffix :: !Char+ } deriving (Eq, Ord, Read, Show)++instance FromText Zone where+ parser = Zone <$> parser <*> AText.satisfy isAlpha <* AText.endOfInput++instance ToText Zone where+ toText Zone{..} = toText _zRegion `Text.snoc` _zSuffix++-- | A service's query action.+newtype Action = Action Text+ deriving (Eq, Ord, Show, IsString, ToText, ToByteString)++data Empty = Empty+ deriving (Eq, Show)++instance ToJSON Empty where+ toJSON = const Null++-- | A convenience alias to avoid type ambiguity.+type ClientRequest = Client.Request++-- | A convenience alias encapsulating the common 'Response'.+type ClientResponse = Client.Response ResponseBody++-- | A convenience alias encapsulating the common 'Response' body.+type ResponseBody = ResumableSource (ResourceT IO) ByteString++-- | Construct a 'ClientRequest' using common parameters such as TLS and prevent+-- throwing errors when receiving erroneous status codes in respones.+clientRequest :: ClientRequest+clientRequest = def+ { Client.secure = True+ , Client.port = 443+ , Client.checkStatus = \_ _ _ -> Nothing+ }++makePrisms ''ServiceError+makeLenses ''Request+makeLenses ''Zone