Showing preview only (575K chars total). Download the full file or copy to clipboard to get everything.
Repository: aristidb/aws
Branch: master
Commit: ab4035840545
Files: 123
Total size: 540.2 KB
Directory structure:
gitextract_7y2rbhgn/
├── .ghci
├── .gitignore
├── .travis.yml
├── Aws/
│ ├── Aws.hs
│ ├── Core.hs
│ ├── DynamoDb/
│ │ ├── Commands/
│ │ │ ├── BatchGetItem.hs
│ │ │ ├── BatchWriteItem.hs
│ │ │ ├── DeleteItem.hs
│ │ │ ├── GetItem.hs
│ │ │ ├── PutItem.hs
│ │ │ ├── Query.hs
│ │ │ ├── Scan.hs
│ │ │ ├── Table.hs
│ │ │ └── UpdateItem.hs
│ │ ├── Commands.hs
│ │ └── Core.hs
│ ├── DynamoDb.hs
│ ├── Ec2/
│ │ └── InstanceMetadata.hs
│ ├── Iam/
│ │ ├── Commands/
│ │ │ ├── AddUserToGroup.hs
│ │ │ ├── CreateAccessKey.hs
│ │ │ ├── CreateGroup.hs
│ │ │ ├── CreateUser.hs
│ │ │ ├── DeleteAccessKey.hs
│ │ │ ├── DeleteGroup.hs
│ │ │ ├── DeleteGroupPolicy.hs
│ │ │ ├── DeleteUser.hs
│ │ │ ├── DeleteUserPolicy.hs
│ │ │ ├── GetGroup.hs
│ │ │ ├── GetGroupPolicy.hs
│ │ │ ├── GetUser.hs
│ │ │ ├── GetUserPolicy.hs
│ │ │ ├── ListAccessKeys.hs
│ │ │ ├── ListGroupPolicies.hs
│ │ │ ├── ListGroups.hs
│ │ │ ├── ListMfaDevices.hs
│ │ │ ├── ListUserPolicies.hs
│ │ │ ├── ListUsers.hs
│ │ │ ├── PutGroupPolicy.hs
│ │ │ ├── PutUserPolicy.hs
│ │ │ ├── RemoveUserFromGroup.hs
│ │ │ ├── UpdateAccessKey.hs
│ │ │ ├── UpdateGroup.hs
│ │ │ └── UpdateUser.hs
│ │ ├── Commands.hs
│ │ ├── Core.hs
│ │ └── Internal.hs
│ ├── Iam.hs
│ ├── Network.hs
│ ├── S3/
│ │ ├── Commands/
│ │ │ ├── CopyObject.hs
│ │ │ ├── DeleteBucket.hs
│ │ │ ├── DeleteObject.hs
│ │ │ ├── DeleteObjectVersion.hs
│ │ │ ├── DeleteObjects.hs
│ │ │ ├── GetBucket.hs
│ │ │ ├── GetBucketLocation.hs
│ │ │ ├── GetBucketObjectVersions.hs
│ │ │ ├── GetBucketVersioning.hs
│ │ │ ├── GetObject.hs
│ │ │ ├── GetService.hs
│ │ │ ├── HeadObject.hs
│ │ │ ├── Multipart.hs
│ │ │ ├── PutBucket.hs
│ │ │ ├── PutBucketVersioning.hs
│ │ │ ├── PutObject.hs
│ │ │ └── RestoreObject.hs
│ │ ├── Commands.hs
│ │ └── Core.hs
│ ├── S3.hs
│ ├── Ses/
│ │ ├── Commands/
│ │ │ ├── DeleteIdentity.hs
│ │ │ ├── GetIdentityDkimAttributes.hs
│ │ │ ├── GetIdentityNotificationAttributes.hs
│ │ │ ├── GetIdentityVerificationAttributes.hs
│ │ │ ├── ListIdentities.hs
│ │ │ ├── SendRawEmail.hs
│ │ │ ├── SetIdentityDkimEnabled.hs
│ │ │ ├── SetIdentityFeedbackForwardingEnabled.hs
│ │ │ ├── SetIdentityNotificationTopic.hs
│ │ │ ├── VerifyDomainDkim.hs
│ │ │ ├── VerifyDomainIdentity.hs
│ │ │ └── VerifyEmailIdentity.hs
│ │ ├── Commands.hs
│ │ └── Core.hs
│ ├── Ses.hs
│ ├── SimpleDb/
│ │ ├── Commands/
│ │ │ ├── Attributes.hs
│ │ │ ├── Domain.hs
│ │ │ └── Select.hs
│ │ ├── Commands.hs
│ │ └── Core.hs
│ ├── SimpleDb.hs
│ ├── Sqs/
│ │ ├── Commands/
│ │ │ ├── Message.hs
│ │ │ ├── Permission.hs
│ │ │ ├── Queue.hs
│ │ │ └── QueueAttributes.hs
│ │ ├── Commands.hs
│ │ └── Core.hs
│ └── Sqs.hs
├── Aws.hs
├── CHANGELOG.md
├── Examples/
│ ├── DynamoDb.hs
│ ├── GetObject.hs
│ ├── GetObjectGoogle.hs
│ ├── GetObjectV4.hs
│ ├── MultipartTransfer.hs
│ ├── MultipartUpload.hs
│ ├── NukeBucket.hs
│ ├── PutBucketNearLine.hs
│ ├── PutObjectIA.hs
│ ├── SimpleDb.hs
│ └── Sqs.hs
├── LICENSE
├── README.md
├── Setup.hs
├── VERSIONING
├── aws.cabal
├── default.nix
├── ghci.hs
├── shell.nix
├── stack.yaml
└── tests/
├── DynamoDb/
│ ├── Main.hs
│ └── Utils.hs
├── S3/
│ └── Main.hs
├── Sqs/
│ └── Main.hs
└── Utils.hs
================================================
FILE CONTENTS
================================================
================================================
FILE: .ghci
================================================
:set -XRecordWildCards
:set -XTypeFamilies
:set -XMultiParamTypeClasses
:set -XFlexibleContexts
:set -XFlexibleInstances
:set -XFunctionalDependencies
:set -XDataKinds
:set -XKindSignatures
:set -XDeriveFunctor
:set -XDeriveDataTypeable
:set -XOverloadedStrings
:set -XTupleSections
:set -XScopedTypeVariables
:set -XRank2Types
================================================
FILE: .gitignore
================================================
*~
dist/*
*.swp
/.cabal-sandbox
/cabal.sandbox.config
cloud-remote.pdf
/.stack-work/
================================================
FILE: .travis.yml
================================================
sudo: false
addons:
apt:
sources:
- hvr-ghc
packages:
- libgmp-dev
- ghc-8.0.1
- cabal-install-1.24
install:
- export PATH=/opt/cabal/1.24/bin:/opt/ghc/8.0.1/bin:$PATH
- travis_retry cabal update
- cabal install --only-dependencies -fexamples --enable-tests
script:
- cabal configure -fexamples --enable-tests && cabal build
================================================
FILE: Aws/Aws.hs
================================================
{-# LANGUAGE CPP #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE BangPatterns #-}
module Aws.Aws
( -- * Logging
LogLevel(..)
, Logger
, defaultLog
-- * Configuration
, Configuration(..)
, baseConfiguration
, dbgConfiguration
-- * Transaction runners
-- ** Safe runners
, aws
, awsRef
, pureAws
, memoryAws
, simpleAws
-- ** Unsafe runners
, unsafeAws
, unsafeAwsRef
-- ** URI runners
, awsUri
-- * Iterated runners
--, awsIteratedAll
, awsIteratedSource
, awsIteratedSource'
, awsIteratedList
, awsIteratedList'
)
where
import Aws.Core
import Control.Applicative
import Control.Monad
import qualified Control.Monad.Catch as E
import Control.Monad.IO.Class
import Control.Monad.Trans
import Control.Monad.Trans.Resource
import qualified Data.ByteString as B
import qualified Data.ByteString.Lazy as L
import qualified Data.CaseInsensitive as CI
import qualified Data.Conduit as C
import qualified Data.Conduit.List as CL
import Data.IORef
import Data.Monoid
import qualified Data.Text as T
import qualified Data.Text.Encoding as T
import qualified Data.Text.IO as T
import qualified Network.HTTP.Conduit as HTTP
import qualified Network.HTTP.Client.TLS as HTTP
import System.IO (stderr)
import Prelude
-- | The severity of a log message, in rising order.
data LogLevel
= Debug
| Info
| Warning
| Error
deriving (Show, Eq, Ord)
-- | The interface for any logging function. Takes log level and a log message, and can perform an arbitrary
-- IO action.
type Logger = LogLevel -> T.Text -> IO ()
-- | The default logger @defaultLog minLevel@, which prints log messages above level @minLevel@ to @stderr@.
defaultLog :: LogLevel -> Logger
defaultLog minLevel lev t | lev >= minLevel = T.hPutStrLn stderr $ T.concat [T.pack $ show lev, ": ", t]
| otherwise = return ()
-- | The configuration for an AWS request. You can use multiple configurations in parallel, even over the same HTTP
-- connection manager.
data Configuration
= Configuration {
-- | Whether to restrict the signature validity with a plain timestamp, or with explicit expiration
-- (absolute or relative).
timeInfo :: TimeInfo
-- | AWS access credentials.
, credentials :: Credentials
-- | The error / message logger.
, logger :: Logger
, proxy :: Maybe HTTP.Proxy
}
-- | The default configuration, with credentials loaded from environment variable or configuration file
-- (see 'loadCredentialsDefault').
baseConfiguration :: MonadIO io => io Configuration
baseConfiguration = liftIO $ do
cr <- loadCredentialsDefault
case cr of
Nothing -> E.throwM $ NoCredentialsException "could not locate aws credentials"
Just cr' -> return Configuration {
timeInfo = Timestamp
, credentials = cr'
, logger = defaultLog Warning
, proxy = Nothing
}
-- | Debug configuration, which logs much more verbosely.
dbgConfiguration :: MonadIO io => io Configuration
dbgConfiguration = do
c <- baseConfiguration
return c { logger = defaultLog Debug }
-- | Run an AWS transaction, with HTTP manager and metadata wrapped in a 'Response'.
--
-- All errors are caught and wrapped in the 'Response' value.
--
-- Metadata is logged at level 'Info'.
--
-- Usage (with existing 'HTTP.Manager'):
-- @
-- resp <- aws cfg serviceCfg manager request
-- @
aws :: (Transaction r a)
=> Configuration
-> ServiceConfiguration r NormalQuery
-> HTTP.Manager
-> r
-> ResourceT IO (Response (ResponseMetadata a) a)
aws = unsafeAws
-- | Run an AWS transaction, with HTTP manager and metadata returned in an 'IORef'.
--
-- Errors are not caught, and need to be handled with exception handlers.
--
-- Metadata is not logged.
--
-- Usage (with existing 'HTTP.Manager'):
-- @
-- ref <- newIORef mempty;
-- resp <- awsRef cfg serviceCfg manager request
-- @
-- Unfortunately, the ";" above seems necessary, as haddock does not want to split lines for me.
awsRef :: (Transaction r a)
=> Configuration
-> ServiceConfiguration r NormalQuery
-> HTTP.Manager
-> IORef (ResponseMetadata a)
-> r
-> ResourceT IO a
awsRef = unsafeAwsRef
-- | Run an AWS transaction, with HTTP manager and without metadata.
--
-- Metadata is logged at level 'Info'.
--
-- Usage (with existing 'HTTP.Manager'):
-- @
-- resp <- aws cfg serviceCfg manager request
-- @
pureAws :: (Transaction r a)
=> Configuration
-> ServiceConfiguration r NormalQuery
-> HTTP.Manager
-> r
-> ResourceT IO a
pureAws cfg scfg mgr req = readResponseIO =<< aws cfg scfg mgr req
-- | Run an AWS transaction, with HTTP manager and without metadata.
--
-- Metadata is logged at level 'Info'.
--
-- Usage (with existing 'HTTP.Manager'):
-- @
-- resp <- aws cfg serviceCfg manager request
-- @
memoryAws :: (Transaction r a, AsMemoryResponse a, MonadIO io)
=> Configuration
-> ServiceConfiguration r NormalQuery
-> HTTP.Manager
-> r
-> io (MemoryResponse a)
memoryAws cfg scfg mgr req = liftIO $ runResourceT $ loadToMemory =<< readResponseIO =<< aws cfg scfg mgr req
-- | Run an AWS transaction, /without/ HTTP manager and without metadata.
--
-- Metadata is logged at level 'Info'.
--
-- Note that this is potentially less efficient than using 'aws', because HTTP connections cannot be re-used.
--
-- Usage:
-- @
-- resp <- simpleAws cfg serviceCfg request
-- @
simpleAws :: (Transaction r a, AsMemoryResponse a, MonadIO io)
=> Configuration
-> ServiceConfiguration r NormalQuery
-> r
-> io (MemoryResponse a)
simpleAws cfg scfg request = liftIO $ runResourceT $ do
manager <- liftIO HTTP.getGlobalManager
loadToMemory =<< readResponseIO =<< aws cfg scfg manager request
-- | Run an AWS transaction, without enforcing that response and request type form a valid transaction pair.
--
-- This is especially useful for debugging and development, you should not have to use it in production.
--
-- All errors are caught and wrapped in the 'Response' value.
--
-- Metadata is wrapped in the Response, and also logged at level 'Info'.
unsafeAws
:: (ResponseConsumer r a,
Loggable (ResponseMetadata a),
SignQuery r) =>
Configuration -> ServiceConfiguration r NormalQuery -> HTTP.Manager -> r -> ResourceT IO (Response (ResponseMetadata a) a)
unsafeAws cfg scfg manager request = do
metadataRef <- liftIO $ newIORef mempty
let catchAll :: ResourceT IO a -> ResourceT IO (Either E.SomeException a)
catchAll = E.handle (return . Left) . fmap Right
resp <- catchAll $
unsafeAwsRef cfg scfg manager metadataRef request
metadata <- liftIO $ readIORef metadataRef
liftIO $ logger cfg Info $ "Response metadata: " `mappend` toLogText metadata
return $ Response metadata resp
-- | Run an AWS transaction, without enforcing that response and request type form a valid transaction pair.
--
-- This is especially useful for debugging and development, you should not have to use it in production.
--
-- Errors are not caught, and need to be handled with exception handlers.
--
-- Metadata is put in the 'IORef', but not logged.
unsafeAwsRef
:: (ResponseConsumer r a,
SignQuery r) =>
Configuration -> ServiceConfiguration r NormalQuery -> HTTP.Manager -> IORef (ResponseMetadata a) -> r -> ResourceT IO a
unsafeAwsRef cfg info manager metadataRef request = do
sd <- liftIO $ signatureData <$> timeInfo <*> credentials $ cfg
let !q = {-# SCC "unsafeAwsRef:signQuery" #-} signQuery request info sd
let logDebug = liftIO . logger cfg Debug . T.pack
logDebug $ "String to sign: " ++ show (sqStringToSign q)
!httpRequest <- {-# SCC "unsafeAwsRef:httpRequest" #-} liftIO $ do
req <- queryToHttpRequest q
return $ req { HTTP.proxy = proxy cfg }
logDebug $ "Host: " ++ show (HTTP.host httpRequest)
logDebug $ "Path: " ++ show (HTTP.path httpRequest)
logDebug $ "Query string: " ++ show (HTTP.queryString httpRequest)
logDebug $ "Header: " ++ show (HTTP.requestHeaders httpRequest)
case HTTP.requestBody httpRequest of
HTTP.RequestBodyLBS lbs -> logDebug $ "Body: " ++ show (L.take 1000 lbs)
HTTP.RequestBodyBS bs -> logDebug $ "Body: " ++ show (B.take 1000 bs)
_ -> return ()
hresp <- {-# SCC "unsafeAwsRef:http" #-} HTTP.http httpRequest manager
logDebug $ "Response status: " ++ show (HTTP.responseStatus hresp)
forM_ (HTTP.responseHeaders hresp) $ \(hname,hvalue) -> liftIO $
logger cfg Debug $ T.decodeUtf8 $ "Response header '" `mappend` CI.original hname `mappend` "': '" `mappend` hvalue `mappend` "'"
{-# SCC "unsafeAwsRef:responseConsumer" #-} responseConsumer httpRequest request metadataRef hresp
-- | Run a URI-only AWS transaction. Returns a URI that can be sent anywhere. Does not work with all requests.
--
-- Usage:
-- @
-- uri <- awsUri cfg request
-- @
awsUri :: (SignQuery request, MonadIO io)
=> Configuration -> ServiceConfiguration request UriOnlyQuery -> request -> io B.ByteString
awsUri cfg info request = liftIO $ do
let ti = timeInfo cfg
cr = credentials cfg
sd <- signatureData ti cr
let q = signQuery request info sd
logger cfg Debug $ T.pack $ "String to sign: " ++ show (sqStringToSign q)
return $ queryToUri q
{-
-- | Run an iterated AWS transaction. May make multiple HTTP requests.
awsIteratedAll :: (IteratedTransaction r a)
=> Configuration
-> ServiceConfiguration r NormalQuery
-> HTTP.Manager
-> r
-> ResourceT IO (Response [ResponseMetadata a] a)
awsIteratedAll cfg scfg manager req_ = go req_ Nothing
where go request prevResp = do Response meta respAttempt <- aws cfg scfg manager request
case maybeCombineIteratedResponse prevResp <$> respAttempt of
f@(Failure _) -> return (Response [meta] f)
s@(Success resp) ->
case nextIteratedRequest request resp of
Nothing ->
return (Response [meta] s)
Just nextRequest ->
mapMetadata (meta:) `liftM` go nextRequest (Just resp)
-}
awsIteratedSource
:: (IteratedTransaction r a)
=> Configuration
-> ServiceConfiguration r NormalQuery
-> HTTP.Manager
-> r
-> forall i. C.ConduitT i (Response (ResponseMetadata a) a) (ResourceT IO) ()
awsIteratedSource cfg scfg manager req_ = awsIteratedSource' run req_
where
run r = do
res <- aws cfg scfg manager r
a <- readResponseIO res
return (a, res)
awsIteratedList
:: (IteratedTransaction r a, ListResponse a i)
=> Configuration
-> ServiceConfiguration r NormalQuery
-> HTTP.Manager
-> r
-> forall j. C.ConduitT j i (ResourceT IO) ()
awsIteratedList cfg scfg manager req = awsIteratedList' run req
where
run r = readResponseIO =<< aws cfg scfg manager r
-------------------------------------------------------------------------------
-- | A more flexible version of 'awsIteratedSource' that uses a
-- user-supplied run function. Useful for embedding AWS functionality
-- within application specific monadic contexts.
awsIteratedSource'
:: (Monad m, IteratedTransaction r a)
=> (r -> m (a, b))
-- ^ A runner function for executing transactions.
-> r
-- ^ An initial request
-> forall i. C.ConduitT i b m ()
awsIteratedSource' run r0 = go r0
where
go q = do
(a, b) <- lift $ run q
C.yield b
case nextIteratedRequest q a of
Nothing -> return ()
Just q' -> go q'
-------------------------------------------------------------------------------
-- | A more flexible version of 'awsIteratedList' that uses a
-- user-supplied run function. Useful for embedding AWS functionality
-- within application specific monadic contexts.
awsIteratedList'
:: (Monad m, IteratedTransaction r b, ListResponse b c)
=> (r -> m b)
-- ^ A runner function for executing transactions.
-> r
-- ^ An initial request
-> forall i. C.ConduitT i c m ()
awsIteratedList' run r0 =
awsIteratedSource' run' r0 `C.fuse`
CL.concatMap listResponse
where
dupl a = (a,a)
run' r = dupl `liftM` run r
================================================
FILE: Aws/Core.hs
================================================
{-# LANGUAGE CPP #-}
module Aws.Core
( -- * Logging
Loggable(..)
-- * Response
-- ** Metadata in responses
, Response(..)
, readResponse
, readResponseIO
, tellMetadata
, tellMetadataRef
, mapMetadata
-- ** Response data consumers
, HTTPResponseConsumer
, ResponseConsumer(..)
-- ** Memory response
, AsMemoryResponse(..)
-- ** List response
, ListResponse(..)
-- ** Exception types
, XmlException(..)
, HeaderException(..)
, FormException(..)
, NoCredentialsException(..)
, throwStatusCodeException
-- ** Response deconstruction helpers
, readHex2
-- *** XML
, elContent
, elCont
, force
, forceM
, textReadBool
, textReadInt
, readInt
, xmlCursorConsumer
-- * Query
, SignedQuery(..)
, NormalQuery
, UriOnlyQuery
, queryToHttpRequest
, queryToUri
-- ** Expiration
, TimeInfo(..)
, AbsoluteTimeInfo(..)
, fromAbsoluteTimeInfo
, makeAbsoluteTimeInfo
-- ** Signature
, SignatureData(..)
, signatureData
, SignQuery(..)
, AuthorizationHash(..)
, amzHash
, signature
, credentialV4
, authorizationV4
, authorizationV4'
, signatureV4
-- ** Query construction helpers
, queryList
, awsBool
, awsTrue
, awsFalse
, fmtTime
, fmtRfc822Time
, rfc822Time
, fmtAmzTime
, fmtTimeEpochSeconds
, parseHttpDate
, httpDate1
, textHttpDate
, iso8601UtcDate
-- * Transactions
, Transaction
, IteratedTransaction(..)
-- * Credentials
, Credentials(..)
, makeCredentials
, credentialsDefaultFile
, credentialsDefaultKey
, loadCredentialsFromFile
, loadCredentialsFromEnv
, loadCredentialsFromInstanceMetadata
, loadCredentialsFromEnvOrFile
, loadCredentialsFromEnvOrFileOrInstanceMetadata
, loadCredentialsDefault
, anonymousCredentials
-- * Service configuration
, DefaultServiceConfiguration(..)
-- * HTTP types
, Protocol(..)
, defaultPort
, Method(..)
, httpMethod
)
where
import Aws.Ec2.InstanceMetadata
import Aws.Network
import qualified Blaze.ByteString.Builder as Blaze
import Control.Applicative
import Control.Arrow
import qualified Control.Exception as E
import Control.Monad
import Control.Monad.IO.Class
import Control.Monad.Trans.Resource (ResourceT, MonadThrow (throwM))
import qualified Crypto.Hash as CH
import qualified Crypto.MAC.HMAC as CMH
import qualified Data.Aeson as A
import qualified Data.ByteArray as ByteArray
import Data.ByteString (ByteString)
import qualified Data.ByteString as B
import qualified Data.ByteString.Base16 as Base16
import qualified Data.ByteString.Base64 as Base64
import Data.ByteString.Char8 ({- IsString -})
import qualified Data.ByteString.Lazy as L
import qualified Data.ByteString.UTF8 as BU
import Data.Char
import Data.Conduit ((.|))
import qualified Data.Conduit as C
#if MIN_VERSION_http_conduit(2,2,0)
import qualified Data.Conduit.Binary as CB
#endif
import qualified Data.Conduit.List as CL
import Data.Kind
import Data.IORef
import Data.List
import qualified Data.Map as M
import Data.Maybe
import Data.Monoid
import qualified Data.Text as T
import qualified Data.Text.Encoding as T
import qualified Data.Text.IO as T
import Data.Time
import qualified Data.Traversable as Traversable
import Data.Typeable
import Data.Word
import qualified Network.HTTP.Conduit as HTTP
import qualified Network.HTTP.Client.TLS as HTTP
import qualified Network.HTTP.Types as HTTP
import System.Directory
import System.Environment
import System.FilePath ((</>))
#if !MIN_VERSION_time(1,5,0)
import System.Locale
#endif
import qualified Text.XML as XML
import qualified Text.XML.Cursor as Cu
import Text.XML.Cursor hiding (force, forceM)
import Prelude
-------------------------------------------------------------------------------
-- | Types that can be logged (textually).
class Loggable a where
toLogText :: a -> T.Text
-- | A response with metadata. Can also contain an error response, or
-- an internal error, via 'Attempt'.
--
-- Response forms a Writer-like monad.
data Response m a = Response { responseMetadata :: m
, responseResult :: Either E.SomeException a }
deriving (Show, Functor)
-- | Read a response result (if it's a success response, fail otherwise).
readResponse :: MonadThrow n => Response m a -> n a
readResponse = either throwM return . responseResult
-- | Read a response result (if it's a success response, fail otherwise). In MonadIO.
readResponseIO :: MonadIO io => Response m a -> io a
readResponseIO = liftIO . readResponse
-- | An empty response with some metadata.
tellMetadata :: m -> Response m ()
tellMetadata m = Response m (return ())
-- | Apply a function to the metadata.
mapMetadata :: (m -> n) -> Response m a -> Response n a
mapMetadata f (Response m a) = Response (f m) a
--multiResponse :: Monoid m => Response m a -> Response [m] a ->
instance Monoid m => Applicative (Response m) where
pure x = Response mempty (Right x)
(<*>) = ap
instance Monoid m => Monad (Response m) where
return = pure
Response m1 (Left e) >>= _ = Response m1 (Left e)
Response m1 (Right x) >>= f = let Response m2 y = f x
in Response (m1 `mappend` m2) y -- currently using First-semantics, Last SHOULD work too
instance Monoid m => MonadThrow (Response m) where
throwM e = Response mempty (throwM e)
-- | Add metadata to an 'IORef' (using 'mappend').
tellMetadataRef :: Monoid m => IORef m -> m -> IO ()
tellMetadataRef r m = modifyIORef r (`mappend` m)
-- | A full HTTP response parser. Takes HTTP status, response headers, and response body.
type HTTPResponseConsumer a = HTTP.Response (C.ConduitM () ByteString (ResourceT IO) ())
-> ResourceT IO a
-- | Class for types that AWS HTTP responses can be parsed into.
--
-- The request is also passed for possibly required additional metadata.
--
-- Note that for debugging, there is an instance for 'L.ByteString'.
class Monoid (ResponseMetadata resp) => ResponseConsumer req resp where
-- | Metadata associated with a response. Typically there is one
-- metadata type for each AWS service.
type ResponseMetadata resp
-- | Response parser. Takes the corresponding AWS request, the derived
-- @http-client@ request (for error reporting), an 'IORef' for metadata, and
-- HTTP response data.
responseConsumer :: HTTP.Request -> req -> IORef (ResponseMetadata resp) -> HTTPResponseConsumer resp
-- | Does not parse response. For debugging.
instance ResponseConsumer r (HTTP.Response L.ByteString) where
type ResponseMetadata (HTTP.Response L.ByteString) = ()
responseConsumer _ _ _ resp = do
bss <- C.runConduit $ HTTP.responseBody resp .| CL.consume
return resp
{ HTTP.responseBody = L.fromChunks bss
}
-- | Class for responses that are fully loaded into memory
class AsMemoryResponse resp where
type MemoryResponse resp :: Type
loadToMemory :: resp -> ResourceT IO (MemoryResponse resp)
-- | Responses that have one main list in them, and perhaps some decoration.
class ListResponse resp item | resp -> item where
listResponse :: resp -> [item]
-- | Associates a request type and a response type in a bi-directional way.
--
-- This allows the type-checker to infer the response type when given
-- the request type and vice versa.
--
-- Note that the actual request generation and response parsing
-- resides in 'SignQuery' and 'ResponseConsumer' respectively.
class (SignQuery r, ResponseConsumer r a, Loggable (ResponseMetadata a))
=> Transaction r a
| r -> a
-- | A transaction that may need to be split over multiple requests, for example because of upstream response size limits.
class Transaction r a => IteratedTransaction r a | r -> a where
nextIteratedRequest :: r -> a -> Maybe r
-- | Signature version 4: ((region, service),(date,key))
type V4Key = ((B.ByteString,B.ByteString),(B.ByteString,B.ByteString))
-- | AWS access credentials.
data Credentials
= Credentials {
-- | AWS Access Key ID.
accessKeyID :: B.ByteString
-- | AWS Secret Access Key.
, secretAccessKey :: B.ByteString
-- | Signing keys for signature version 4
, v4SigningKeys :: IORef [V4Key]
-- | Signed IAM token
, iamToken :: Maybe B.ByteString
-- | Set when the credentials are intended for anonymous access.
, isAnonymousCredentials :: Bool
}
instance Show Credentials where
show c@(Credentials {}) = "Credentials{accessKeyID=" ++ show (accessKeyID c) ++ ",secretAccessKey=" ++ show (secretAccessKey c) ++ ",iamToken=" ++ show (iamToken c) ++ "}"
makeCredentials :: MonadIO io
=> B.ByteString -- ^ AWS Access Key ID
-> B.ByteString -- ^ AWS Secret Access Key
-> io Credentials
makeCredentials accessKeyID secretAccessKey = liftIO $ do
v4SigningKeys <- newIORef []
let iamToken = Nothing
let isAnonymousCredentials = False
return Credentials { .. }
-- | The file where access credentials are loaded, when using 'loadCredentialsDefault'.
-- May return 'Nothing' if @HOME@ is unset.
--
-- Value: /<user directory>/@/.aws-keys@
credentialsDefaultFile :: MonadIO io => io (Maybe FilePath)
credentialsDefaultFile = liftIO $ tryMaybe ((</> ".aws-keys") <$> getHomeDirectory)
tryMaybe :: IO a -> IO (Maybe a)
tryMaybe action = E.catch (Just <$> action) f
where
f :: E.SomeException -> IO (Maybe a)
f _ = return Nothing
-- | The key to be used in the access credential file that is loaded, when using 'loadCredentialsDefault'.
--
-- Value: @default@
credentialsDefaultKey :: T.Text
credentialsDefaultKey = "default"
-- | Load credentials from a (text) file given a key name.
--
-- The file consists of a sequence of lines, each in the following format:
--
-- @keyName awsKeyID awsKeySecret@
loadCredentialsFromFile :: MonadIO io => FilePath -> T.Text -> io (Maybe Credentials)
loadCredentialsFromFile file key = liftIO $ do
exists <- doesFileExist file
if exists
then do
contents <- map T.words . T.lines <$> T.readFile file
Traversable.sequence $ do
[_key, keyID, secret] <- find (hasKey key) contents
return (makeCredentials (T.encodeUtf8 keyID) (T.encodeUtf8 secret))
else return Nothing
where
hasKey _ [] = False
hasKey k (k2 : _) = k == k2
-- | Load credentials from the environment variables @AWS_ACCESS_KEY_ID@ and @AWS_ACCESS_KEY_SECRET@
-- (or @AWS_SECRET_ACCESS_KEY@), if possible.
loadCredentialsFromEnv :: MonadIO io => io (Maybe Credentials)
loadCredentialsFromEnv = liftIO $ do
env <- getEnvironment
let lk = fmap (T.encodeUtf8 . T.pack) . flip lookup env
keyID = lk "AWS_ACCESS_KEY_ID"
secret = lk "AWS_ACCESS_KEY_SECRET" `mplus` lk "AWS_SECRET_ACCESS_KEY"
setSession creds = creds { iamToken = lk "AWS_SESSION_TOKEN" }
makeCredentials' k s = setSession <$> makeCredentials k s
Traversable.sequence $ makeCredentials' <$> keyID <*> secret
loadCredentialsFromInstanceMetadata :: MonadIO io => io (Maybe Credentials)
loadCredentialsFromInstanceMetadata = do
mgr <- liftIO HTTP.getGlobalManager
-- check if the path is routable
avail <- liftIO $ hostAvailable "169.254.169.254"
if not avail
then return Nothing
else do
info <- liftIO $ E.catch (getInstanceMetadata mgr "latest/meta-data/iam" "info" >>= return . Just) (\(_ :: HTTP.HttpException) -> return Nothing)
let infodict = info >>= A.decode :: Maybe (M.Map String String)
info' = infodict >>= M.lookup "InstanceProfileArn"
case info' of
Just name ->
do
let name' = drop 1 $ dropWhile (/= '/') $ name
creds <- liftIO $ E.catch (getInstanceMetadata mgr "latest/meta-data/iam/security-credentials" name' >>= return . Just) (\(_ :: HTTP.HttpException) -> return Nothing)
-- this token lasts ~6 hours
let dict = creds >>= A.decode :: Maybe (M.Map String String)
keyID = dict >>= M.lookup "AccessKeyId"
secret = dict >>= M.lookup "SecretAccessKey"
token = dict >>= M.lookup "Token"
ref <- liftIO $ newIORef []
return (Credentials <$> (T.encodeUtf8 . T.pack <$> keyID)
<*> (T.encodeUtf8 . T.pack <$> secret)
<*> return ref
<*> (Just . T.encodeUtf8 . T.pack <$> token)
<*> return False)
Nothing -> return Nothing
-- | Load credentials from environment variables if possible, or alternatively from a file with a given key name.
--
-- See 'loadCredentialsFromEnv' and 'loadCredentialsFromFile' for details.
loadCredentialsFromEnvOrFile :: MonadIO io => FilePath -> T.Text -> io (Maybe Credentials)
loadCredentialsFromEnvOrFile file key =
do
envcr <- loadCredentialsFromEnv
case envcr of
Just cr -> return (Just cr)
Nothing -> loadCredentialsFromFile file key
-- | Load credentials from environment variables if possible, or alternatively from the instance metadata store, or alternatively from a file with a given key name.
--
-- See 'loadCredentialsFromEnv', 'loadCredentialsFromFile' and 'loadCredentialsFromInstanceMetadata' for details.
loadCredentialsFromEnvOrFileOrInstanceMetadata :: MonadIO io => FilePath -> T.Text -> io (Maybe Credentials)
loadCredentialsFromEnvOrFileOrInstanceMetadata file key =
do
envcr <- loadCredentialsFromEnv
case envcr of
Just cr -> return (Just cr)
Nothing ->
do
filecr <- loadCredentialsFromFile file key
case filecr of
Just cr -> return (Just cr)
Nothing -> loadCredentialsFromInstanceMetadata
-- | Load credentials from environment variables if possible, or alternative from the default file with the default
-- key name.
--
-- Default file: /<user directory>/@/.aws-keys@
-- Default key name: @default@
--
-- See 'loadCredentialsFromEnv' and 'loadCredentialsFromFile' for details.
loadCredentialsDefault :: MonadIO io => io (Maybe Credentials)
loadCredentialsDefault = do
mfile <- credentialsDefaultFile
case mfile of
Just file -> loadCredentialsFromEnvOrFileOrInstanceMetadata file credentialsDefaultKey
Nothing -> loadCredentialsFromEnv
-- | Make a dummy Credentials that can be used to access some AWS services
-- anonymously.
anonymousCredentials :: MonadIO io => io Credentials
anonymousCredentials = do
cr <- makeCredentials mempty mempty
return (cr { isAnonymousCredentials = True })
-- | Protocols supported by AWS. Currently, all AWS services use the HTTP or HTTPS protocols.
data Protocol
= HTTP
| HTTPS
deriving (Eq,Read,Show,Ord,Typeable)
-- | The default port to be used for a protocol if no specific port is specified.
defaultPort :: Protocol -> Int
defaultPort HTTP = 80
defaultPort HTTPS = 443
-- | Request method. Not all request methods are supported by all services.
data Method
= Head -- ^ HEAD method. Put all request parameters in a query string and HTTP headers.
| Get -- ^ GET method. Put all request parameters in a query string and HTTP headers.
| PostQuery -- ^ POST method. Put all request parameters in a query string and HTTP headers, but send the query string
-- as a POST payload
| Post -- ^ POST method. Sends a service- and request-specific request body.
| Put -- ^ PUT method.
| Delete -- ^ DELETE method.
deriving (Show, Eq, Ord)
-- | HTTP method associated with a request method.
httpMethod :: Method -> HTTP.Method
httpMethod Head = "HEAD"
httpMethod Get = "GET"
httpMethod PostQuery = "POST"
httpMethod Post = "POST"
httpMethod Put = "PUT"
httpMethod Delete = "DELETE"
-- | A pre-signed medium-level request object.
data SignedQuery
= SignedQuery {
-- | Request method.
sqMethod :: !Method
-- | Protocol to be used.
, sqProtocol :: !Protocol
-- | HTTP host.
, sqHost :: !B.ByteString
-- | IP port.
, sqPort :: !Int
-- | HTTP path.
, sqPath :: !B.ByteString
-- | Query string list (used with 'Get' and 'PostQuery').
, sqQuery :: !HTTP.Query
-- | Request date/time.
, sqDate :: !(Maybe UTCTime)
-- | Authorization string (if applicable), for @Authorization@ header. See 'authorizationV4'
, sqAuthorization :: !(Maybe (IO B.ByteString))
-- | Request body content type.
, sqContentType :: !(Maybe B.ByteString)
-- | Request body content MD5.
, sqContentMd5 :: !(Maybe (CH.Digest CH.MD5))
-- | Additional Amazon "amz" headers.
, sqAmzHeaders :: !HTTP.RequestHeaders
-- | Additional non-"amz" headers.
, sqOtherHeaders :: !HTTP.RequestHeaders
-- | Request body (used with 'Post' and 'Put').
, sqBody :: !(Maybe HTTP.RequestBody)
-- | String to sign. Note that the string is already signed, this is passed mostly for debugging purposes.
, sqStringToSign :: !B.ByteString
}
--deriving (Show)
-- | Create a HTTP request from a 'SignedQuery' object.
queryToHttpRequest :: SignedQuery -> IO HTTP.Request
queryToHttpRequest SignedQuery{..} = do
mauth <- maybe (return Nothing) (Just<$>) sqAuthorization
return $ HTTP.defaultRequest {
HTTP.method = httpMethod sqMethod
, HTTP.secure = case sqProtocol of
HTTP -> False
HTTPS -> True
, HTTP.host = sqHost
, HTTP.port = sqPort
, HTTP.path = sqPath
, HTTP.queryString =
if sqMethod == PostQuery
then ""
else HTTP.renderQuery False sqQuery
, HTTP.requestHeaders = catMaybes [ checkDate (\d -> ("Date", fmtRfc822Time d)) sqDate
, fmap (\c -> ("Content-Type", c)) contentType
, fmap (\md5 -> ("Content-MD5", Base64.encode $ ByteArray.convert md5)) sqContentMd5
, fmap (\auth -> ("Authorization", auth)) mauth]
++ sqAmzHeaders
++ sqOtherHeaders
, HTTP.requestBody =
-- An explicitly defined body parameter should overwrite everything else.
case sqBody of
Just x -> x
Nothing ->
-- a POST query should convert its query string into the body
case sqMethod of
PostQuery -> HTTP.RequestBodyLBS . Blaze.toLazyByteString $
HTTP.renderQueryBuilder False sqQuery
_ -> HTTP.RequestBodyBuilder 0 mempty
, HTTP.decompress = HTTP.alwaysDecompress
#if MIN_VERSION_http_conduit(2,2,0)
, HTTP.checkResponse = \_ _ -> return ()
#else
, HTTP.checkStatus = \_ _ _-> Nothing
#endif
, HTTP.redirectCount = 10
}
where
checkDate f mb = maybe (f <$> mb) (const Nothing) $ lookup "date" sqOtherHeaders
-- An explicitly defined content-type should override everything else.
contentType = sqContentType `mplus` defContentType
defContentType = case sqMethod of
PostQuery -> Just "application/x-www-form-urlencoded; charset=utf-8"
_ -> Nothing
-- | Create a URI from a 'SignedQuery' object.
--
-- Unused / incompatible fields will be silently ignored.
queryToUri :: SignedQuery -> B.ByteString
queryToUri SignedQuery{..}
= B.concat [
case sqProtocol of
HTTP -> "http://"
HTTPS -> "https://"
, sqHost
, if sqPort == defaultPort sqProtocol then "" else T.encodeUtf8 . T.pack $ ':' : show sqPort
, sqPath
, HTTP.renderQuery True sqQuery
]
-- | Whether to restrict the signature validity with a plain timestamp, or with explicit expiration
-- (absolute or relative).
data TimeInfo
= Timestamp -- ^ Use a simple timestamp to let AWS check the request validity.
| ExpiresAt { fromExpiresAt :: UTCTime } -- ^ Let requests expire at a specific fixed time.
| ExpiresIn { fromExpiresIn :: NominalDiffTime } -- ^ Let requests expire a specific number of seconds after they
-- were generated.
deriving (Show)
-- | Like 'TimeInfo', but with all relative times replaced by absolute UTC.
data AbsoluteTimeInfo
= AbsoluteTimestamp { fromAbsoluteTimestamp :: UTCTime }
| AbsoluteExpires { fromAbsoluteExpires :: UTCTime }
deriving (Show)
-- | Just the UTC time value.
fromAbsoluteTimeInfo :: AbsoluteTimeInfo -> UTCTime
fromAbsoluteTimeInfo (AbsoluteTimestamp time) = time
fromAbsoluteTimeInfo (AbsoluteExpires time) = time
-- | Convert 'TimeInfo' to 'AbsoluteTimeInfo' given the current UTC time.
makeAbsoluteTimeInfo :: TimeInfo -> UTCTime -> AbsoluteTimeInfo
makeAbsoluteTimeInfo Timestamp now = AbsoluteTimestamp now
makeAbsoluteTimeInfo (ExpiresAt t) _ = AbsoluteExpires t
makeAbsoluteTimeInfo (ExpiresIn s) now = AbsoluteExpires $ addUTCTime s now
-- | Data that is always required for signing requests.
data SignatureData
= SignatureData {
-- | Expiration or timestamp.
signatureTimeInfo :: AbsoluteTimeInfo
-- | Current time.
, signatureTime :: UTCTime
-- | Access credentials.
, signatureCredentials :: Credentials
}
-- | Create signature data using the current system time.
signatureData :: TimeInfo -> Credentials -> IO SignatureData
signatureData rti cr = do
now <- getCurrentTime
let ti = makeAbsoluteTimeInfo rti now
return SignatureData { signatureTimeInfo = ti, signatureTime = now, signatureCredentials = cr }
-- | Tag type for normal queries.
data NormalQuery
-- | Tag type for URI-only queries.
data UriOnlyQuery
-- | A "signable" request object. Assembles together the Query, and signs it in one go.
class SignQuery request where
-- | Additional information, like API endpoints and service-specific preferences.
type ServiceConfiguration request :: Type {- Query Type -} -> Type
-- | Create a 'SignedQuery' from a request, additional 'Info', and 'SignatureData'.
signQuery :: request -> ServiceConfiguration request queryType -> SignatureData -> SignedQuery
-- | Supported crypto hashes for the signature.
data AuthorizationHash
= HmacSHA1
| HmacSHA256
deriving (Show)
-- | Authorization hash identifier as expected by Amazon.
amzHash :: AuthorizationHash -> B.ByteString
amzHash HmacSHA1 = "HmacSHA1"
amzHash HmacSHA256 = "HmacSHA256"
-- | Create a signature. Usually, AWS wants a specifically constructed string to be signed.
--
-- The signature is a HMAC-based hash of the string and the secret access key.
signature :: Credentials -> AuthorizationHash -> B.ByteString -> B.ByteString
signature cr ah input = Base64.encode sig
where
sig = case ah of
HmacSHA1 -> ByteArray.convert (CMH.hmac (secretAccessKey cr) input :: CMH.HMAC CH.SHA1)
HmacSHA256 -> ByteArray.convert (CMH.hmac (secretAccessKey cr) input :: CMH.HMAC CH.SHA256)
-- | Generates the Credential string, required for V4 signatures.
credentialV4
:: SignatureData
-> B.ByteString -- ^ region, e.g. us-east-1
-> B.ByteString -- ^ service, e.g. dynamodb
-> B.ByteString
credentialV4 sd region service = B.concat
[ accessKeyID (signatureCredentials sd)
, "/"
, date
, "/"
, region
, "/"
, service
, "/aws4_request"
]
where
date = fmtTime "%Y%m%d" $ signatureTime sd
-- | Use this to create the Authorization header to set into 'sqAuthorization'.
-- See <http://docs.aws.amazon.com/general/latest/gr/signature-version-4.html>: you must create the
-- canonical request as explained by Step 1 and this function takes care of Steps 2 and 3.
authorizationV4 :: SignatureData
-> AuthorizationHash
-> B.ByteString -- ^ region, e.g. us-east-1
-> B.ByteString -- ^ service, e.g. dynamodb
-> B.ByteString -- ^ SignedHeaders, e.g. content-type;host;x-amz-date;x-amz-target
-> B.ByteString -- ^ canonicalRequest (before hashing)
-> IO B.ByteString
authorizationV4 sd ah region service headers canonicalRequest = do
let ref = v4SigningKeys $ signatureCredentials sd
date = fmtTime "%Y%m%d" $ signatureTime sd
-- Lookup existing signing key
allkeys <- readIORef ref
let mkey = case lookup (region,service) allkeys of
Just (d,k) | d /= date -> Nothing
| otherwise -> Just k
Nothing -> Nothing
-- possibly create a new signing key
let createNewKey = atomicModifyIORef ref $ \keylist ->
let kSigning = signingKeyV4 sd ah region service
lstK = (region,service)
keylist' = (lstK,(date,kSigning)) : filter ((lstK/=).fst) keylist
in (keylist', kSigning)
-- finally, return the header
constructAuthorizationV4Header sd ah region service headers
. signatureV4WithKey sd ah region service canonicalRequest
<$> maybe createNewKey return mkey
-- | IO free version of @authorizationV4@, use this if you need
-- to compute the signature outside of IO.
authorizationV4'
:: SignatureData
-> AuthorizationHash
-> B.ByteString -- ^ region, e.g. us-east-1
-> B.ByteString -- ^ service, e.g. dynamodb
-> B.ByteString -- ^ SignedHeaders, e.g. content-type;host;x-amz-date;x-amz-target
-> B.ByteString -- ^ canonicalRequest (before hashing)
-> B.ByteString
authorizationV4' sd ah region service headers canonicalRequest
= constructAuthorizationV4Header sd ah region service headers
$ signatureV4 sd ah region service canonicalRequest
constructAuthorizationV4Header
:: SignatureData
-> AuthorizationHash
-> B.ByteString -- ^ region, e.g. us-east-1
-> B.ByteString -- ^ service, e.g. dynamodb
-> B.ByteString -- ^ SignedHeaders, e.g. content-type;host;x-amz-date;x-amz-target
-> B.ByteString -- ^ signature
-> B.ByteString
constructAuthorizationV4Header sd ah region service headers sig = B.concat
[ alg
, " Credential="
, credentialV4 sd region service
, ",SignedHeaders="
, headers
, ",Signature="
, sig
]
where
alg = case ah of
HmacSHA1 -> "AWS4-HMAC-SHA1"
HmacSHA256 -> "AWS4-HMAC-SHA256"
-- | Compute the signature for V4
signatureV4WithKey
:: SignatureData
-> AuthorizationHash
-> B.ByteString -- ^ region, e.g. us-east-1
-> B.ByteString -- ^ service, e.g. dynamodb
-> B.ByteString -- ^ canonicalRequest (before hashing)
-> B.ByteString -- ^ signing key
-> B.ByteString
signatureV4WithKey sd ah region service canonicalRequest key = Base16.encode $ mkHmac key stringToSign
where
date = fmtTime "%Y%m%d" $ signatureTime sd
mkHmac k i = case ah of
HmacSHA1 -> ByteArray.convert (CMH.hmac k i :: CMH.HMAC CH.SHA1)
HmacSHA256 -> ByteArray.convert (CMH.hmac k i :: CMH.HMAC CH.SHA256)
mkHash i = case ah of
HmacSHA1 -> ByteArray.convert (CH.hash i :: CH.Digest CH.SHA1)
HmacSHA256 -> ByteArray.convert (CH.hash i :: CH.Digest CH.SHA256)
alg = case ah of
HmacSHA1 -> "AWS4-HMAC-SHA1"
HmacSHA256 -> "AWS4-HMAC-SHA256"
-- now do the signature
canonicalRequestHash = Base16.encode $ mkHash canonicalRequest
stringToSign = B.concat
[ alg
, "\n"
, fmtTime "%Y%m%dT%H%M%SZ" $ signatureTime sd
, "\n"
, date
, "/"
, region
, "/"
, service
, "/aws4_request\n"
, canonicalRequestHash
]
signingKeyV4
:: SignatureData
-> AuthorizationHash
-> B.ByteString -- ^ region, e.g. us-east-1
-> B.ByteString -- ^ service, e.g. dynamodb
-> B.ByteString
signingKeyV4 sd ah region service = kSigning
where
mkHmac k i = case ah of
HmacSHA1 -> ByteArray.convert (CMH.hmac k i :: CMH.HMAC CH.SHA1)
HmacSHA256 -> ByteArray.convert (CMH.hmac k i :: CMH.HMAC CH.SHA256)
date = fmtTime "%Y%m%d" $ signatureTime sd
secretKey = secretAccessKey $ signatureCredentials sd
kDate = mkHmac ("AWS4" <> secretKey) date
kRegion = mkHmac kDate region
kService = mkHmac kRegion service
kSigning = mkHmac kService "aws4_request"
signatureV4
:: SignatureData
-> AuthorizationHash
-> B.ByteString -- ^ region, e.g. us-east-1
-> B.ByteString -- ^ service, e.g. dynamodb
-> B.ByteString -- ^ canonicalRequest (before hashing)
-> B.ByteString
signatureV4 sd ah region service canonicalRequest
= signatureV4WithKey sd ah region service canonicalRequest
$ signingKeyV4 sd ah region service
-- | Default configuration for a specific service.
class DefaultServiceConfiguration config where
-- | Default service configuration.
defServiceConfig :: config
-- | Default debugging-only configuration. (Normally using HTTP instead of HTTPS for easier debugging.)
debugServiceConfig :: config
debugServiceConfig = defServiceConfig
-- | @queryList f prefix xs@ constructs a query list from a list of
-- elements @xs@, using a common prefix @prefix@, and a transformer
-- function @f@.
--
-- A dot (@.@) is interspersed between prefix and generated key.
--
-- Example:
--
-- @queryList swap \"pfx\" [(\"a\", \"b\"), (\"c\", \"d\")]@ evaluates to @[(\"pfx.b\", \"a\"), (\"pfx.d\", \"c\")]@
-- (except with ByteString instead of String, of course).
queryList :: (a -> [(B.ByteString, B.ByteString)]) -> B.ByteString -> [a] -> [(B.ByteString, B.ByteString)]
queryList f prefix xs = concat $ zipWith combine prefixList (map f xs)
where prefixList = map (dot prefix . BU.fromString . show) [(1 :: Int) ..]
combine pf = map $ first (pf `dot`)
dot x y = B.concat [x, BU.fromString ".", y]
-- | A \"true\"/\"false\" boolean as requested by some services.
awsBool :: Bool -> B.ByteString
awsBool True = "true"
awsBool False = "false"
-- | \"true\"
awsTrue :: B.ByteString
awsTrue = awsBool True
-- | \"false\"
awsFalse :: B.ByteString
awsFalse = awsBool False
-- | Format time according to a format string, as a ByteString.
fmtTime :: String -> UTCTime -> B.ByteString
fmtTime s t = BU.fromString $ formatTime defaultTimeLocale s t
rfc822Time :: String
rfc822Time = "%a, %0d %b %Y %H:%M:%S GMT"
-- | Format time in RFC 822 format.
fmtRfc822Time :: UTCTime -> B.ByteString
fmtRfc822Time = fmtTime rfc822Time
-- | Format time in yyyy-mm-ddThh-mm-ss format.
fmtAmzTime :: UTCTime -> B.ByteString
fmtAmzTime = fmtTime "%Y-%m-%dT%H:%M:%S"
-- | Format time as seconds since the Unix epoch.
fmtTimeEpochSeconds :: UTCTime -> B.ByteString
fmtTimeEpochSeconds = fmtTime "%s"
-- | Parse HTTP-date (section 3.3.1 of RFC 2616)
parseHttpDate :: String -> Maybe UTCTime
parseHttpDate s = p "%a, %d %b %Y %H:%M:%S GMT" s -- rfc1123-date
<|> p "%A, %d-%b-%y %H:%M:%S GMT" s -- rfc850-date
<|> p "%a %b %_d %H:%M:%S %Y" s -- asctime-date
<|> p "%Y-%m-%dT%H:%M:%S%QZ" s -- iso 8601
<|> p "%Y-%m-%dT%H:%M:%S%Q%Z" s -- iso 8601
where p = parseTimeM True defaultTimeLocale
-- | HTTP-date (section 3.3.1 of RFC 2616, first type - RFC1123-style)
httpDate1 :: String
httpDate1 = "%a, %d %b %Y %H:%M:%S GMT" -- rfc1123-date
-- | Format (as Text) HTTP-date (section 3.3.1 of RFC 2616, first type - RFC1123-style)
textHttpDate :: UTCTime -> T.Text
textHttpDate = T.pack . formatTime defaultTimeLocale httpDate1
iso8601UtcDate :: String
iso8601UtcDate = "%Y-%m-%dT%H:%M:%S%QZ"
-- | Parse a two-digit hex number.
readHex2 :: [Char] -> Maybe Word8
readHex2 [c1,c2] = do n1 <- readHex1 c1
n2 <- readHex1 c2
return . fromIntegral $ n1 * 16 + n2
where
readHex1 c | c >= '0' && c <= '9' = Just $ ord c - ord '0'
| c >= 'A' && c <= 'F' = Just $ ord c - ord 'A' + 10
| c >= 'a' && c <= 'f' = Just $ ord c - ord 'a' + 10
readHex1 _ = Nothing
readHex2 _ = Nothing
-- XML
-- | An error that occurred during XML parsing / validation.
newtype XmlException = XmlException { xmlErrorMessage :: String }
deriving (Show, Typeable)
instance E.Exception XmlException
-- | An error that occurred during header parsing / validation.
newtype HeaderException = HeaderException { headerErrorMessage :: String }
deriving (Show, Typeable)
instance E.Exception HeaderException
-- | An error that occurred during form parsing / validation.
newtype FormException = FormException { formErrorMesage :: String }
deriving (Show, Typeable)
instance E.Exception FormException
-- | No credentials were found and an invariant was violated.
newtype NoCredentialsException = NoCredentialsException { noCredentialsErrorMessage :: String }
deriving (Show, Typeable)
instance E.Exception NoCredentialsException
-- | A helper to throw an 'HTTP.StatusCodeException'.
throwStatusCodeException :: MonadThrow m => HTTP.Request -> HTTP.Response (C.ConduitM () ByteString m ()) -> m a
throwStatusCodeException req resp = do
let resp' = fmap (const ()) resp
-- only take first 10kB of error response
body <- C.runConduit $ HTTP.responseBody resp .| CB.take (10*1024)
let sce = HTTP.StatusCodeException resp' (L.toStrict body)
throwM $ HTTP.HttpExceptionRequest req sce
-- | A specific element (case-insensitive, ignoring namespace - sadly necessary), extracting only the textual contents.
elContent :: T.Text -> Cursor -> [T.Text]
elContent name = laxElement name &/ content
-- | Like 'elContent', but extracts 'String's instead of 'T.Text'.
elCont :: T.Text -> Cursor -> [String]
elCont name = laxElement name &/ content &| T.unpack
-- | Extract the first element from a parser result list, and throw an 'XmlException' if the list is empty.
force :: MonadThrow m => String -> [a] -> m a
force = Cu.force . XmlException
-- | Extract the first element from a monadic parser result list, and throw an 'XmlException' if the list is empty.
forceM :: MonadThrow m => String -> [m a] -> m a
forceM = Cu.forceM . XmlException
-- | Read a boolean from a 'T.Text', throwing an 'XmlException' on failure.
textReadBool :: MonadThrow m => T.Text -> m Bool
textReadBool s = case T.unpack s of
"true" -> return True
"false" -> return False
_ -> throwM $ XmlException "Invalid Bool"
-- | Read an integer from a 'T.Text', throwing an 'XmlException' on failure.
textReadInt :: (MonadThrow m, Num a) => T.Text -> m a
textReadInt s = case reads $ T.unpack s of
[(n,"")] -> return $ fromInteger n
_ -> throwM $ XmlException "Invalid Integer"
-- | Read an integer from a 'String', throwing an 'XmlException' on failure.
readInt :: (MonadThrow m, Num a) => String -> m a
readInt s = case reads s of
[(n,"")] -> return $ fromInteger n
_ -> throwM $ XmlException "Invalid Integer"
-- | Create a complete 'HTTPResponseConsumer' from a simple function that takes a 'Cu.Cursor' to XML in the response
-- body.
--
-- This function is highly recommended for any services that parse relatively short XML responses. (If status and response
-- headers are required, simply take them as function parameters, and pass them through to this function.)
xmlCursorConsumer ::
(Monoid m)
=> (Cu.Cursor -> Response m a)
-> IORef m
-> HTTPResponseConsumer a
xmlCursorConsumer parse metadataRef res
= do doc <- C.runConduit $ HTTP.responseBody res .| XML.sinkDoc XML.def
let cursor = Cu.fromDocument doc
let Response metadata x = parse cursor
liftIO $ tellMetadataRef metadataRef metadata
case x of
Left err -> liftIO $ throwM err
Right v -> return v
================================================
FILE: Aws/DynamoDb/Commands/BatchGetItem.hs
================================================
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE NoMonomorphismRestriction #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeFamilies #-}
-----------------------------------------------------------------------------
-- |
-- Module : Aws.DynamoDb.Commands.BatchGetItem
-- Copyright : Soostone Inc
-- License : BSD3
--
-- Maintainer : Justin Dawson <jtdawso@gmail.com>
-- Stability : experimental
--
-- @http:\/\/docs.aws.amazon.com\/amazondynamodb\/latest\/APIReference\/API_BatchGetItem.html@
----------------------------------------------------------------------------
module Aws.DynamoDb.Commands.BatchGetItem where
-------------------------------------------------------------------------------
import Control.Applicative
import Data.Aeson
import Data.Default
import qualified Data.HashMap.Strict as HM
import qualified Data.Text as T
import Prelude
-------------------------------------------------------------------------------
import Aws.Core
import Aws.DynamoDb.Core
import Aws.DynamoDb.Commands.GetItem
-------------------------------------------------------------------------------
data GetRequestItem = GetRequestItem{
griProjExpr :: Maybe T.Text
, griConsistent ::Bool
, griKeys :: [PrimaryKey]
} deriving (Eq,Show,Read,Ord)
data BatchGetItem = BatchGetItem {
bgRequests :: [(T.Text,GetRequestItem)]
-- ^ Get Requests for a specified table
, bgRetCons :: ReturnConsumption
} deriving (Eq,Show,Read,Ord)
-------------------------------------------------------------------------------
-- | Construct a RequestItem .
batchGetRequestItem :: Maybe T.Text
-- ^ Projection Expression
-> Bool
-- ^ Consistent Read
-> [PrimaryKey]
-- ^ Items to be deleted
-> GetRequestItem
batchGetRequestItem expr consistent keys = GetRequestItem expr consistent keys
toBatchGet :: [GetItem] -> BatchGetItem
toBatchGet gs = BatchGetItem (convert gs) def
where
groupItems :: [GetItem]-> HM.HashMap T.Text [GetItem] -> HM.HashMap T.Text [GetItem]
groupItems [] hm = hm
groupItems (x:xs) hm = let key = giTableName x
in groupItems xs (HM.insert key (x : (HM.lookupDefault [] key hm)) hm)
convert :: [GetItem] -> [(T.Text,GetRequestItem)]
convert gs' = let l = HM.toList $ groupItems gs' HM.empty
-- Uses one GetItem to specify ProjectionExpression
-- and ConsistentRead for the entire batch
in map (\(table,items@(i:_)) ->(table,GetRequestItem
(T.intercalate "," <$> giAttrs i)
(giConsistent i)
(map giKey items)) ) l
-- | Construct a BatchGetItem
batchGetItem :: [(T.Text, GetRequestItem)]
-> BatchGetItem
batchGetItem reqs = BatchGetItem reqs def
instance ToJSON GetRequestItem where
toJSON GetRequestItem{..} =
(object $ maybe [] (return . ("ProjectionExpression" .=)) griProjExpr ++
["ConsistentRead" .= griConsistent
, "Keys" .= griKeys])
instance ToJSON BatchGetItem where
toJSON BatchGetItem{..} =
object $
[ "RequestItems" .= HM.fromList bgRequests
, "ReturnConsumedCapacity" .= bgRetCons
]
instance FromJSON GetRequestItem where
parseJSON (Object p) = do
GetRequestItem <$> p .:? "ProjectionExpression"
<*> p .: "ConsistentRead"
<*> p .: "Keys"
parseJSON _ = fail "unable to parse GetRequestItem"
data BatchGetItemResponse = BatchGetItemResponse {
bgResponses :: [(T.Text, [Item])]
, bgUnprocessed :: Maybe [(T.Text,GetRequestItem)]
-- ^ Unprocessed Requests on failure
, bgConsumed :: Maybe ConsumedCapacity
-- ^ Amount of capacity consumed
} deriving (Eq,Show,Read,Ord)
instance Transaction BatchGetItem BatchGetItemResponse
instance SignQuery BatchGetItem where
type ServiceConfiguration BatchGetItem = DdbConfiguration
signQuery gi = ddbSignQuery "BatchGetItem" gi
instance FromJSON BatchGetItemResponse where
parseJSON (Object v) = BatchGetItemResponse
<$> (HM.toList <$> (v .: "Responses"))
<*> v .:? "UnprocessedItems"
<*> v .:? "ConsumedCapacity"
parseJSON _ = fail "BatchGetItemResponse must be an object."
instance ResponseConsumer r BatchGetItemResponse where
type ResponseMetadata BatchGetItemResponse = DdbResponse
responseConsumer _ _ ref resp = ddbResponseConsumer ref resp
instance AsMemoryResponse BatchGetItemResponse where
type MemoryResponse BatchGetItemResponse = BatchGetItemResponse
loadToMemory = return
================================================
FILE: Aws/DynamoDb/Commands/BatchWriteItem.hs
================================================
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE NoMonomorphismRestriction #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeFamilies #-}
-----------------------------------------------------------------------------
-- |
-- Module : Aws.DynamoDb.Commands.BatchWriteItem
-- Copyright : Soostone Inc
-- License : BSD3
--
-- Maintainer : Justin Dawson <jtdawso@gmail.com>
-- Stability : experimental
--
-- @http:\/\/docs.aws.amazon.com\/amazondynamodb\/latest\/APIReference\/API_BatchWriteItem.html@
----------------------------------------------------------------------------
module Aws.DynamoDb.Commands.BatchWriteItem where
-------------------------------------------------------------------------------
import Control.Applicative
import Data.Aeson
import Data.Default
import qualified Data.Foldable as F (asum)
import qualified Data.HashMap.Strict as HM
import qualified Data.Text as T
import Prelude
-------------------------------------------------------------------------------
import Aws.Core
import Aws.DynamoDb.Core
import Aws.DynamoDb.Commands.PutItem
import Aws.DynamoDb.Commands.DeleteItem
-------------------------------------------------------------------------------
data Request = PutRequest { prItem :: Item }
| DeleteRequest {drKey :: PrimaryKey}
deriving (Eq,Show,Read,Ord)
data BatchWriteItem = BatchWriteItem {
bwRequests :: [(T.Text,[Request])]
-- ^ Put or Delete Requests for a specified table
, bwRetCons :: ReturnConsumption
, bwRetMet :: ReturnItemCollectionMetrics
} deriving (Eq,Show,Read,Ord)
-------------------------------------------------------------------------------
toBatchWrite :: [PutItem]
-> [DeleteItem]
-> BatchWriteItem
toBatchWrite ps ds =BatchWriteItem maps def def
where
maps :: [(T.Text,[Request])]
maps = let pMap = foldl (\acc p -> let key = piTable p
in HM.insert key (PutRequest (piItem p) : (HM.lookupDefault [] key acc)) acc) HM.empty ps
totalMap = foldl (\acc d -> let key = diTable d
in HM.insert key (DeleteRequest (diKey d) : (HM.lookupDefault [] key acc)) acc) pMap ds
in HM.toList totalMap
-- | Construct a BatchWriteItem
batchWriteItem :: [(T.Text,[Request])]
-> BatchWriteItem
batchWriteItem reqs = BatchWriteItem reqs def def
instance ToJSON Request where
toJSON PutRequest{..} =
object $
[ "PutRequest" .= (object $ ["Item" .= prItem])
]
toJSON DeleteRequest{..} =
object $
[ "DeleteRequest" .= (object $ ["Key" .= drKey])
]
instance ToJSON BatchWriteItem where
toJSON BatchWriteItem{..} =
object $
[ "RequestItems" .= HM.fromList bwRequests
, "ReturnConsumedCapacity" .= bwRetCons
, "ReturnItemCollectionMetrics" .= bwRetMet
]
instance FromJSON Request where
parseJSON = withObject "PutRequest or DeleteRequest" $ \o ->
F.asum [
do
pr <- o .: "PutRequest"
i <- pr .: "Item"
return $ PutRequest i ,
do
dr <- o .: "DeleteRequest"
pk <- dr .: "Key"
return $ DeleteRequest pk
]
data BatchWriteItemResponse = BatchWriteItemResponse {
bwUnprocessed :: [(T.Text,[Request])]
-- ^ Unprocessed Requests on failure
, bwConsumed :: Maybe ConsumedCapacity
-- ^ Amount of capacity consumed
, bwColMet :: Maybe ItemCollectionMetrics
-- ^ Collection metrics for tables affected by BatchWriteItem.
} deriving (Eq,Show,Read,Ord)
instance Transaction BatchWriteItem BatchWriteItemResponse
instance SignQuery BatchWriteItem where
type ServiceConfiguration BatchWriteItem = DdbConfiguration
signQuery gi = ddbSignQuery "BatchWriteItem" gi
instance FromJSON BatchWriteItemResponse where
parseJSON (Object v) = BatchWriteItemResponse
<$> HM.toList <$> (v .: "UnprocessedItems")
<*> v .:? "ConsumedCapacity"
<*> v .:? "ItemCollectionMetrics"
parseJSON _ = fail "BatchWriteItemResponse must be an object."
instance ResponseConsumer r BatchWriteItemResponse where
type ResponseMetadata BatchWriteItemResponse = DdbResponse
responseConsumer _ _ ref resp = ddbResponseConsumer ref resp
instance AsMemoryResponse BatchWriteItemResponse where
type MemoryResponse BatchWriteItemResponse = BatchWriteItemResponse
loadToMemory = return
================================================
FILE: Aws/DynamoDb/Commands/DeleteItem.hs
================================================
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE NoMonomorphismRestriction #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeFamilies #-}
-----------------------------------------------------------------------------
-- |
-- Module : Aws.DynamoDb.Commands.DeleteItem
-- Copyright : Soostone Inc
-- License : BSD3
--
-- Maintainer : Ozgun Ataman <ozgun.ataman@soostone.com>
-- Stability : experimental
--
-- @http:\/\/docs.aws.amazon.com\/amazondynamodb\/latest\/APIReference\/API_DeleteItem.html@
----------------------------------------------------------------------------
module Aws.DynamoDb.Commands.DeleteItem where
-------------------------------------------------------------------------------
import Control.Applicative
import Data.Aeson
import Data.Default
import qualified Data.Text as T
import Prelude
-------------------------------------------------------------------------------
import Aws.Core
import Aws.DynamoDb.Core
-------------------------------------------------------------------------------
data DeleteItem = DeleteItem {
diTable :: T.Text
-- ^ Target table
, diKey :: PrimaryKey
-- ^ The item to delete.
, diExpect :: Conditions
-- ^ (Possible) set of exceptions for a conditional Put
, diReturn :: UpdateReturn
-- ^ What to return from this query.
, diRetCons :: ReturnConsumption
, diRetMet :: ReturnItemCollectionMetrics
} deriving (Eq,Show,Read,Ord)
-------------------------------------------------------------------------------
-- | Construct a minimal 'DeleteItem' request.
deleteItem :: T.Text
-- ^ A Dynamo table name
-> PrimaryKey
-- ^ Item to be saved
-> DeleteItem
deleteItem tn key = DeleteItem tn key def def def def
instance ToJSON DeleteItem where
toJSON DeleteItem{..} =
object $ expectsJson diExpect ++
[ "TableName" .= diTable
, "Key" .= diKey
, "ReturnValues" .= diReturn
, "ReturnConsumedCapacity" .= diRetCons
, "ReturnItemCollectionMetrics" .= diRetMet
]
data DeleteItemResponse = DeleteItemResponse {
dirAttrs :: Maybe Item
-- ^ Old attributes, if requested
, dirConsumed :: Maybe ConsumedCapacity
-- ^ Amount of capacity consumed
, dirColMet :: Maybe ItemCollectionMetrics
-- ^ Collection metrics if they have been requested.
} deriving (Eq,Show,Read,Ord)
instance Transaction DeleteItem DeleteItemResponse
instance SignQuery DeleteItem where
type ServiceConfiguration DeleteItem = DdbConfiguration
signQuery gi = ddbSignQuery "DeleteItem" gi
instance FromJSON DeleteItemResponse where
parseJSON (Object v) = DeleteItemResponse
<$> v .:? "Attributes"
<*> v .:? "ConsumedCapacity"
<*> v .:? "ItemCollectionMetrics"
parseJSON _ = fail "DeleteItemResponse must be an object."
instance ResponseConsumer r DeleteItemResponse where
type ResponseMetadata DeleteItemResponse = DdbResponse
responseConsumer _ _ ref resp = ddbResponseConsumer ref resp
instance AsMemoryResponse DeleteItemResponse where
type MemoryResponse DeleteItemResponse = DeleteItemResponse
loadToMemory = return
================================================
FILE: Aws/DynamoDb/Commands/GetItem.hs
================================================
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE TypeFamilies #-}
-----------------------------------------------------------------------------
-- |
-- Module : Aws.DynamoDb.Commands.GetItem
-- Copyright : Soostone Inc
-- License : BSD3
--
-- Maintainer : Ozgun Ataman <ozgun.ataman@soostone.com>
-- Stability : experimental
--
--
----------------------------------------------------------------------------
module Aws.DynamoDb.Commands.GetItem where
-------------------------------------------------------------------------------
import Control.Applicative
import Data.Aeson
import Data.Default
import qualified Data.Text as T
import Prelude
-------------------------------------------------------------------------------
import Aws.Core
import Aws.DynamoDb.Core
-------------------------------------------------------------------------------
-- | A GetItem query that fetches a specific object from DDB.
--
-- See: @http://docs.aws.amazon.com/amazondynamodb/latest/developerguide/API_GetItem.html@
data GetItem = GetItem {
giTableName :: T.Text
, giKey :: PrimaryKey
, giAttrs :: Maybe [T.Text]
-- ^ Attributes to get. 'Nothing' grabs everything.
, giConsistent :: Bool
-- ^ Whether to issue a consistent read.
, giRetCons :: ReturnConsumption
-- ^ Whether to return consumption stats.
} deriving (Eq,Show,Read,Ord)
-------------------------------------------------------------------------------
-- | Construct a minimal 'GetItem' request.
getItem
:: T.Text -- ^ Table name
-> PrimaryKey -- ^ Primary key
-> GetItem
getItem tn k = GetItem tn k Nothing False def
-- | Response to a 'GetItem' query.
data GetItemResponse = GetItemResponse {
girItem :: Maybe Item
, girConsumed :: Maybe ConsumedCapacity
} deriving (Eq,Show,Read,Ord)
instance Transaction GetItem GetItemResponse
instance ToJSON GetItem where
toJSON GetItem{..} = object $
maybe [] (return . ("AttributesToGet" .=)) giAttrs ++
[ "TableName" .= giTableName
, "Key" .= giKey
, "ConsistentRead" .= giConsistent
, "ReturnConsumedCapacity" .= giRetCons
]
instance SignQuery GetItem where
type ServiceConfiguration GetItem = DdbConfiguration
signQuery gi = ddbSignQuery "GetItem" gi
instance FromJSON GetItemResponse where
parseJSON (Object v) = GetItemResponse
<$> v .:? "Item"
<*> v .:? "ConsumedCapacity"
parseJSON _ = fail "GetItemResponse must be an object."
instance ResponseConsumer r GetItemResponse where
type ResponseMetadata GetItemResponse = DdbResponse
responseConsumer _ _ ref resp = ddbResponseConsumer ref resp
instance AsMemoryResponse GetItemResponse where
type MemoryResponse GetItemResponse = GetItemResponse
loadToMemory = return
================================================
FILE: Aws/DynamoDb/Commands/PutItem.hs
================================================
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE NoMonomorphismRestriction #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeFamilies #-}
-----------------------------------------------------------------------------
-- |
-- Module : Aws.DynamoDb.Commands.GetItem
-- Copyright : Soostone Inc
-- License : BSD3
--
-- Maintainer : Ozgun Ataman <ozgun.ataman@soostone.com>
-- Stability : experimental
--
-- @http:\/\/docs.aws.amazon.com\/amazondynamodb\/latest\/APIReference\/API_PutItem.html@
----------------------------------------------------------------------------
module Aws.DynamoDb.Commands.PutItem where
-------------------------------------------------------------------------------
import Control.Applicative
import Data.Aeson
import Data.Default
import qualified Data.Text as T
import Prelude
-------------------------------------------------------------------------------
import Aws.Core
import Aws.DynamoDb.Core
-------------------------------------------------------------------------------
data PutItem = PutItem {
piTable :: T.Text
-- ^ Target table
, piItem :: Item
-- ^ An item to Put. Attributes here will replace what maybe under
-- the key on DDB.
, piExpect :: Conditions
-- ^ (Possible) set of exceptions for a conditional Put
, piReturn :: UpdateReturn
-- ^ What to return from this query.
, piRetCons :: ReturnConsumption
, piRetMet :: ReturnItemCollectionMetrics
} deriving (Eq,Show,Read,Ord)
-------------------------------------------------------------------------------
-- | Construct a minimal 'PutItem' request.
putItem :: T.Text
-- ^ A Dynamo table name
-> Item
-- ^ Item to be saved
-> PutItem
putItem tn it = PutItem tn it def def def def
instance ToJSON PutItem where
toJSON PutItem{..} =
object $ expectsJson piExpect ++
[ "TableName" .= piTable
, "Item" .= piItem
, "ReturnValues" .= piReturn
, "ReturnConsumedCapacity" .= piRetCons
, "ReturnItemCollectionMetrics" .= piRetMet
]
data PutItemResponse = PutItemResponse {
pirAttrs :: Maybe Item
-- ^ Old attributes, if requested
, pirConsumed :: Maybe ConsumedCapacity
-- ^ Amount of capacity consumed
, pirColMet :: Maybe ItemCollectionMetrics
-- ^ Collection metrics if they have been requested.
} deriving (Eq,Show,Read,Ord)
instance Transaction PutItem PutItemResponse
instance SignQuery PutItem where
type ServiceConfiguration PutItem = DdbConfiguration
signQuery gi = ddbSignQuery "PutItem" gi
instance FromJSON PutItemResponse where
parseJSON (Object v) = PutItemResponse
<$> v .:? "Attributes"
<*> v .:? "ConsumedCapacity"
<*> v .:? "ItemCollectionMetrics"
parseJSON _ = fail "PutItemResponse must be an object."
instance ResponseConsumer r PutItemResponse where
type ResponseMetadata PutItemResponse = DdbResponse
responseConsumer _ _ ref resp = ddbResponseConsumer ref resp
instance AsMemoryResponse PutItemResponse where
type MemoryResponse PutItemResponse = PutItemResponse
loadToMemory = return
================================================
FILE: Aws/DynamoDb/Commands/Query.hs
================================================
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE TypeFamilies #-}
-----------------------------------------------------------------------------
-- |
-- Module : Aws.DynamoDb.Commands.Query
-- Copyright : Soostone Inc
-- License : BSD3
--
-- Maintainer : Ozgun Ataman <ozgun.ataman@soostone.com>
-- Stability : experimental
--
-- Implementation of Amazon DynamoDb Query command.
--
-- See: @http:\/\/docs.aws.amazon.com\/amazondynamodb\/latest\/APIReference\/API_Query.html@
----------------------------------------------------------------------------
module Aws.DynamoDb.Commands.Query
( Query (..)
, Slice (..)
, query
, QueryResponse (..)
) where
-------------------------------------------------------------------------------
import Control.Applicative
import Data.Aeson
import Data.Default
import Data.Maybe
import qualified Data.Text as T
import Data.Typeable
import qualified Data.Vector as V
-------------------------------------------------------------------------------
import Aws.Core
import Aws.DynamoDb.Core
-------------------------------------------------------------------------------
-------------------------------------------------------------------------------
-- | 'Slice' is the primary constraint in a 'Query' command, per AWS
-- requirements.
--
-- All 'Query' commands must specify a hash attribute via 'DEq' and
-- optionally provide a secondary range attribute.
data Slice = Slice {
sliceHash :: Attribute
-- ^ Hash value of the primary key or index being used
, sliceCond :: Maybe Condition
-- ^ An optional condition specified on the range component, if
-- present, of the primary key or index being used.
} deriving (Eq,Show,Read,Ord,Typeable)
-- | A Query command that uses primary keys for an expedient scan.
data Query = Query {
qTableName :: T.Text
-- ^ Required.
, qKeyConditions :: Slice
-- ^ Required. Hash or hash-range main condition.
, qFilter :: Conditions
-- ^ Whether to filter results before returning to client
, qStartKey :: Maybe [Attribute]
-- ^ Exclusive start key to resume a previous query.
, qLimit :: Maybe Int
-- ^ Whether to limit result set size
, qForwardScan :: Bool
-- ^ Set to False for descending results
, qSelect :: QuerySelect
-- ^ What to return from 'Query'
, qRetCons :: ReturnConsumption
, qIndex :: Maybe T.Text
-- ^ Whether to use a secondary/global index
, qConsistent :: Bool
} deriving (Eq,Show,Read,Ord,Typeable)
-------------------------------------------------------------------------------
instance ToJSON Query where
toJSON Query{..} = object $
catMaybes
[ (("ExclusiveStartKey" .= ) . attributesJson) <$> qStartKey
, ("Limit" .= ) <$> qLimit
, ("IndexName" .= ) <$> qIndex
] ++
conditionsJson "QueryFilter" qFilter ++
querySelectJson qSelect ++
[ "ScanIndexForward" .= qForwardScan
, "TableName".= qTableName
, "KeyConditions" .= sliceJson qKeyConditions
, "ReturnConsumedCapacity" .= qRetCons
, "ConsistentRead" .= qConsistent
]
-------------------------------------------------------------------------------
-- | Construct a minimal 'Query' request.
query
:: T.Text
-- ^ Table name
-> Slice
-- ^ Primary key slice for query
-> Query
query tn sl = Query tn sl def Nothing Nothing True def def Nothing False
-- | Response to a 'Query' query.
data QueryResponse = QueryResponse {
qrItems :: V.Vector Item
, qrLastKey :: Maybe [Attribute]
, qrCount :: Int
, qrScanned :: Int
, qrConsumed :: Maybe ConsumedCapacity
} deriving (Eq,Show,Read,Ord)
instance FromJSON QueryResponse where
parseJSON (Object v) = QueryResponse
<$> v .:? "Items" .!= V.empty
<*> ((do o <- v .: "LastEvaluatedKey"
Just <$> parseAttributeJson o)
<|> pure Nothing)
<*> v .: "Count"
<*> v .: "ScannedCount"
<*> v .:? "ConsumedCapacity"
parseJSON _ = fail "QueryResponse must be an object."
instance Transaction Query QueryResponse
instance SignQuery Query where
type ServiceConfiguration Query = DdbConfiguration
signQuery gi = ddbSignQuery "Query" gi
instance ResponseConsumer r QueryResponse where
type ResponseMetadata QueryResponse = DdbResponse
responseConsumer _ _ ref resp
= ddbResponseConsumer ref resp
instance AsMemoryResponse QueryResponse where
type MemoryResponse QueryResponse = QueryResponse
loadToMemory = return
instance ListResponse QueryResponse Item where
listResponse = V.toList . qrItems
instance IteratedTransaction Query QueryResponse where
nextIteratedRequest request response = case qrLastKey response of
Nothing -> Nothing
key -> Just request { qStartKey = key }
sliceJson :: Slice -> Value
sliceJson Slice{..} = object (map conditionJson cs)
where
cs = maybe [] return sliceCond ++ [hashCond]
hashCond = Condition (attrName sliceHash) (DEq (attrVal sliceHash))
================================================
FILE: Aws/DynamoDb/Commands/Scan.hs
================================================
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE TypeFamilies #-}
-----------------------------------------------------------------------------
-- |
-- Module : Aws.DynamoDb.Commands.Scan
-- Copyright : Soostone Inc
-- License : BSD3
--
-- Maintainer : Ozgun Ataman <ozgun.ataman@soostone.com>
-- Stability : experimental
--
-- Implementation of Amazon DynamoDb Scan command.
--
-- See: @http:\/\/docs.aws.amazon.com\/amazondynamodb\/latest\/APIReference\/API_Scan.html@
----------------------------------------------------------------------------
module Aws.DynamoDb.Commands.Scan
( Scan (..)
, scan
, ScanResponse (..)
) where
-------------------------------------------------------------------------------
import Control.Applicative
import Data.Aeson
import Data.Default
import Data.Maybe
import qualified Data.Text as T
import Data.Typeable
import qualified Data.Vector as V
-------------------------------------------------------------------------------
import Aws.Core
import Aws.DynamoDb.Core
-------------------------------------------------------------------------------
-- | A Scan command that uses primary keys for an expedient scan.
data Scan = Scan {
sTableName :: T.Text
-- ^ Required.
, sConsistentRead :: Bool
-- ^ Whether to require a consistent read
, sFilter :: Conditions
-- ^ Whether to filter results before returning to client
, sStartKey :: Maybe [Attribute]
-- ^ Exclusive start key to resume a previous query.
, sLimit :: Maybe Int
-- ^ Whether to limit result set size
, sIndex :: Maybe T.Text
-- ^ Optional. Index to 'Scan'
, sSelect :: QuerySelect
-- ^ What to return from 'Scan'
, sRetCons :: ReturnConsumption
, sSegment :: Int
-- ^ Segment number, starting at 0, for parallel queries.
, sTotalSegments :: Int
-- ^ Total number of parallel segments. 1 means sequential scan.
} deriving (Eq,Show,Read,Ord,Typeable)
-- | Construct a minimal 'Scan' request.
scan :: T.Text -- ^ Table name
-> Scan
scan tn = Scan tn False def Nothing Nothing Nothing def def 0 1
-- | Response to a 'Scan' query.
data ScanResponse = ScanResponse {
srItems :: V.Vector Item
, srLastKey :: Maybe [Attribute]
, srCount :: Int
, srScanned :: Int
, srConsumed :: Maybe ConsumedCapacity
} deriving (Eq,Show,Read,Ord)
-------------------------------------------------------------------------------
instance ToJSON Scan where
toJSON Scan{..} = object $
catMaybes
[ (("ExclusiveStartKey" .= ) . attributesJson) <$> sStartKey
, ("Limit" .= ) <$> sLimit
, ("IndexName" .= ) <$> sIndex
] ++
conditionsJson "ScanFilter" sFilter ++
querySelectJson sSelect ++
[ "TableName".= sTableName
, "ReturnConsumedCapacity" .= sRetCons
, "Segment" .= sSegment
, "TotalSegments" .= sTotalSegments
, "ConsistentRead" .= sConsistentRead
]
instance FromJSON ScanResponse where
parseJSON (Object v) = ScanResponse
<$> v .:? "Items" .!= V.empty
<*> ((do o <- v .: "LastEvaluatedKey"
Just <$> parseAttributeJson o)
<|> pure Nothing)
<*> v .: "Count"
<*> v .: "ScannedCount"
<*> v .:? "ConsumedCapacity"
parseJSON _ = fail "ScanResponse must be an object."
instance Transaction Scan ScanResponse
instance SignQuery Scan where
type ServiceConfiguration Scan = DdbConfiguration
signQuery gi = ddbSignQuery "Scan" gi
instance ResponseConsumer r ScanResponse where
type ResponseMetadata ScanResponse = DdbResponse
responseConsumer _ _ ref resp = ddbResponseConsumer ref resp
instance AsMemoryResponse ScanResponse where
type MemoryResponse ScanResponse = ScanResponse
loadToMemory = return
instance ListResponse ScanResponse Item where
listResponse = V.toList . srItems
instance IteratedTransaction Scan ScanResponse where
nextIteratedRequest request response =
case srLastKey response of
Nothing -> Nothing
key -> Just request { sStartKey = key }
================================================
FILE: Aws/DynamoDb/Commands/Table.hs
================================================
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE TypeFamilies #-}
module Aws.DynamoDb.Commands.Table
( -- * Commands
CreateTable(..)
, createTable
, CreateTableResult(..)
, DescribeTable(..)
, DescribeTableResult(..)
, UpdateTable(..)
, UpdateTableResult(..)
, DeleteTable(..)
, DeleteTableResult(..)
, ListTables(..)
, ListTablesResult(..)
-- * Data passed in the commands
, AttributeType(..)
, AttributeDefinition(..)
, KeySchema(..)
, Projection(..)
, LocalSecondaryIndex(..)
, LocalSecondaryIndexStatus(..)
, ProvisionedThroughput(..)
, ProvisionedThroughputStatus(..)
, GlobalSecondaryIndex(..)
, GlobalSecondaryIndexStatus(..)
, GlobalSecondaryIndexUpdate(..)
, TableDescription(..)
) where
-------------------------------------------------------------------------------
import Control.Applicative
import Data.Aeson ((.!=), (.:), (.:?), (.=))
import qualified Data.Aeson as A
import qualified Data.Aeson.KeyMap as KM
import qualified Data.Aeson.Types as A
import Data.Char (toUpper)
import Data.Scientific (Scientific)
import qualified Data.Text as T
import Data.Time
import Data.Time.Clock.POSIX
import Data.Typeable
import qualified Data.Vector as V
import GHC.Generics (Generic)
import Prelude
-------------------------------------------------------------------------------
import Aws.Core
import Aws.DynamoDb.Core
-------------------------------------------------------------------------------
capitalizeOpt :: A.Options
capitalizeOpt = A.defaultOptions
{ A.fieldLabelModifier = \x -> case x of
(c:cs) -> toUpper c : cs
[] -> []
}
dropOpt :: Int -> A.Options
dropOpt d = A.defaultOptions { A.fieldLabelModifier = drop d }
convertToUTCTime :: Scientific -> UTCTime
convertToUTCTime = posixSecondsToUTCTime . fromInteger . round
-- | The type of a key attribute that appears in the table key or as a
-- key in one of the indices.
data AttributeType = AttrString | AttrNumber | AttrBinary
deriving (Show, Read, Ord, Typeable, Eq, Enum, Bounded, Generic)
instance A.ToJSON AttributeType where
toJSON AttrString = A.String "S"
toJSON AttrNumber = A.String "N"
toJSON AttrBinary = A.String "B"
instance A.FromJSON AttributeType where
parseJSON (A.String str) =
case str of
"S" -> return AttrString
"N" -> return AttrNumber
"B" -> return AttrBinary
_ -> fail $ "Invalid attribute type " ++ T.unpack str
parseJSON _ = fail "Attribute type must be a string"
-- | A key attribute that appears in the table key or as a key in one of the indices.
data AttributeDefinition = AttributeDefinition {
attributeName :: T.Text
, attributeType :: AttributeType
} deriving (Eq,Read,Ord,Show,Typeable,Generic)
instance A.ToJSON AttributeDefinition where
toJSON = A.genericToJSON capitalizeOpt
instance A.FromJSON AttributeDefinition where
parseJSON = A.genericParseJSON capitalizeOpt
-- | The key schema can either be a hash of a single attribute name or a hash attribute name
-- and a range attribute name.
data KeySchema = HashOnly T.Text
| HashAndRange T.Text T.Text
deriving (Eq,Read,Show,Ord,Typeable,Generic)
instance A.ToJSON KeySchema where
toJSON (HashOnly a)
= A.Array $ V.fromList [ A.object [ "AttributeName" .= a
, "KeyType" .= (A.String "HASH")
]
]
toJSON (HashAndRange hash range)
= A.Array $ V.fromList [ A.object [ "AttributeName" .= hash
, "KeyType" .= (A.String "HASH")
]
, A.object [ "AttributeName" .= range
, "KeyType" .= (A.String "RANGE")
]
]
instance A.FromJSON KeySchema where
parseJSON (A.Array v) =
case V.length v of
1 -> do obj <- A.parseJSON (v V.! 0)
kt <- obj .: "KeyType"
if kt /= ("HASH" :: T.Text)
then fail "With only one key, the type must be HASH"
else HashOnly <$> obj .: "AttributeName"
2 -> do hash <- A.parseJSON (v V.! 0)
range <- A.parseJSON (v V.! 1)
hkt <- hash .: "KeyType"
rkt <- range .: "KeyType"
if hkt /= ("HASH" :: T.Text) || rkt /= ("RANGE" :: T.Text)
then fail "With two keys, one must be HASH and the other RANGE"
else HashAndRange <$> hash .: "AttributeName"
<*> range .: "AttributeName"
_ -> fail "Key schema must have one or two entries"
parseJSON _ = fail "Key schema must be an array"
-- | This determines which attributes are projected into a secondary index.
data Projection = ProjectKeysOnly
| ProjectAll
| ProjectInclude [T.Text]
deriving Show
instance A.ToJSON Projection where
toJSON ProjectKeysOnly = A.object [ "ProjectionType" .= ("KEYS_ONLY" :: T.Text) ]
toJSON ProjectAll = A.object [ "ProjectionType" .= ("ALL" :: T.Text) ]
toJSON (ProjectInclude a) = A.object [ "ProjectionType" .= ("INCLUDE" :: T.Text)
, "NonKeyAttributes" .= a
]
instance A.FromJSON Projection where
parseJSON (A.Object o) = do
ty <- (o .: "ProjectionType") :: A.Parser T.Text
case ty of
"KEYS_ONLY" -> return ProjectKeysOnly
"ALL" -> return ProjectAll
"INCLUDE" -> ProjectInclude <$> o .: "NonKeyAttributes"
_ -> fail "Invalid projection type"
parseJSON _ = fail "Projection must be an object"
-- | Describes a single local secondary index. The KeySchema MUST
-- share the same hash key attribute as the parent table, only the
-- range key can differ.
data LocalSecondaryIndex
= LocalSecondaryIndex {
localIndexName :: T.Text
, localKeySchema :: KeySchema
, localProjection :: Projection
}
deriving (Show, Generic)
instance A.ToJSON LocalSecondaryIndex where
toJSON = A.genericToJSON $ dropOpt 5
instance A.FromJSON LocalSecondaryIndex where
parseJSON = A.genericParseJSON $ dropOpt 5
-- | This is returned by AWS to describe the local secondary index.
data LocalSecondaryIndexStatus
= LocalSecondaryIndexStatus {
locStatusIndexName :: T.Text
, locStatusIndexSizeBytes :: Integer
, locStatusItemCount :: Integer
, locStatusKeySchema :: KeySchema
, locStatusProjection :: Projection
}
deriving (Show, Generic)
instance A.FromJSON LocalSecondaryIndexStatus where
parseJSON = A.genericParseJSON $ dropOpt 9
-- | The target provisioned throughput you are requesting for the table or global secondary index.
data ProvisionedThroughput
= ProvisionedThroughput {
readCapacityUnits :: Int
, writeCapacityUnits :: Int
}
deriving (Show, Generic)
instance A.ToJSON ProvisionedThroughput where
toJSON = A.genericToJSON capitalizeOpt
instance A.FromJSON ProvisionedThroughput where
parseJSON = A.genericParseJSON capitalizeOpt
-- | This is returned by AWS as the status of the throughput for a table or global secondary index.
data ProvisionedThroughputStatus
= ProvisionedThroughputStatus {
statusLastDecreaseDateTime :: UTCTime
, statusLastIncreaseDateTime :: UTCTime
, statusNumberOfDecreasesToday :: Int
, statusReadCapacityUnits :: Int
, statusWriteCapacityUnits :: Int
}
deriving (Show, Generic)
instance A.FromJSON ProvisionedThroughputStatus where
parseJSON = A.withObject "Throughput status must be an object" $ \o ->
ProvisionedThroughputStatus
<$> (convertToUTCTime <$> o .:? "LastDecreaseDateTime" .!= 0)
<*> (convertToUTCTime <$> o .:? "LastIncreaseDateTime" .!= 0)
<*> o .:? "NumberOfDecreasesToday" .!= 0
<*> o .: "ReadCapacityUnits"
<*> o .: "WriteCapacityUnits"
-- | Describes a global secondary index.
data GlobalSecondaryIndex
= GlobalSecondaryIndex {
globalIndexName :: T.Text
, globalKeySchema :: KeySchema
, globalProjection :: Projection
, globalProvisionedThroughput :: ProvisionedThroughput
}
deriving (Show, Generic)
instance A.ToJSON GlobalSecondaryIndex where
toJSON = A.genericToJSON $ dropOpt 6
instance A.FromJSON GlobalSecondaryIndex where
parseJSON = A.genericParseJSON $ dropOpt 6
-- | This is returned by AWS to describe the status of a global secondary index.
data GlobalSecondaryIndexStatus
= GlobalSecondaryIndexStatus {
gStatusIndexName :: T.Text
, gStatusIndexSizeBytes :: Integer
, gStatusIndexStatus :: T.Text
, gStatusItemCount :: Integer
, gStatusKeySchema :: KeySchema
, gStatusProjection :: Projection
, gStatusProvisionedThroughput :: ProvisionedThroughputStatus
}
deriving (Show, Generic)
instance A.FromJSON GlobalSecondaryIndexStatus where
parseJSON = A.genericParseJSON $ dropOpt 7
-- | This is used to request a change in the provisioned throughput of
-- a global secondary index as part of an 'UpdateTable' operation.
data GlobalSecondaryIndexUpdate
= GlobalSecondaryIndexUpdate {
gUpdateIndexName :: T.Text
, gUpdateProvisionedThroughput :: ProvisionedThroughput
}
deriving (Show, Generic)
instance A.ToJSON GlobalSecondaryIndexUpdate where
toJSON gi = A.object ["Update" .= A.genericToJSON (dropOpt 7) gi]
-- | This describes the table and is the return value from AWS for all
-- the table-related commands.
data TableDescription
= TableDescription {
rTableName :: T.Text
, rTableSizeBytes :: Integer
, rTableStatus :: T.Text -- ^ one of CREATING, UPDATING, DELETING, ACTIVE
, rCreationDateTime :: Maybe UTCTime
, rItemCount :: Integer
, rAttributeDefinitions :: [AttributeDefinition]
, rKeySchema :: Maybe KeySchema
, rProvisionedThroughput :: ProvisionedThroughputStatus
, rLocalSecondaryIndexes :: [LocalSecondaryIndexStatus]
, rGlobalSecondaryIndexes :: [GlobalSecondaryIndexStatus]
}
deriving (Show, Generic)
instance A.FromJSON TableDescription where
parseJSON = A.withObject "Table must be an object" $ \o -> do
t <- case (KM.lookup "Table" o, KM.lookup "TableDescription" o) of
(Just (A.Object t), _) -> return t
(_, Just (A.Object t)) -> return t
_ -> fail "Table description must have key 'Table' or 'TableDescription'"
TableDescription <$> t .: "TableName"
<*> t .: "TableSizeBytes"
<*> t .: "TableStatus"
<*> (fmap convertToUTCTime <$> t .:? "CreationDateTime")
<*> t .: "ItemCount"
<*> t .:? "AttributeDefinitions" .!= []
<*> t .:? "KeySchema"
<*> t .: "ProvisionedThroughput"
<*> t .:? "LocalSecondaryIndexes" .!= []
<*> t .:? "GlobalSecondaryIndexes" .!= []
{- Can't derive these instances onto the return values
instance ResponseConsumer r TableDescription where
type ResponseMetadata TableDescription = DyMetadata
responseConsumer _ _ _ = ddbResponseConsumer
instance AsMemoryResponse TableDescription where
type MemoryResponse TableDescription = TableDescription
loadToMemory = return
-}
-------------------------------------------------------------------------------
--- Commands
-------------------------------------------------------------------------------
data CreateTable = CreateTable {
createTableName :: T.Text
, createAttributeDefinitions :: [AttributeDefinition]
-- ^ only attributes appearing in a key must be listed here
, createKeySchema :: KeySchema
, createProvisionedThroughput :: ProvisionedThroughput
, createLocalSecondaryIndexes :: [LocalSecondaryIndex]
-- ^ at most 5 local secondary indices are allowed
, createGlobalSecondaryIndexes :: [GlobalSecondaryIndex]
} deriving (Show, Generic)
createTable :: T.Text -- ^ Table name
-> [AttributeDefinition]
-> KeySchema
-> ProvisionedThroughput
-> CreateTable
createTable tn ad ks p = CreateTable tn ad ks p [] []
instance A.ToJSON CreateTable where
toJSON ct = A.object $ m ++ lindex ++ gindex
where
m = [ "TableName" .= createTableName ct
, "AttributeDefinitions" .= createAttributeDefinitions ct
, "KeySchema" .= createKeySchema ct
, "ProvisionedThroughput" .= createProvisionedThroughput ct
]
-- AWS will error with 500 if (LocalSecondaryIndexes : []) is present in the JSON
lindex = if null (createLocalSecondaryIndexes ct)
then []
else [ "LocalSecondaryIndexes" .= createLocalSecondaryIndexes ct ]
gindex = if null (createGlobalSecondaryIndexes ct)
then []
else [ "GlobalSecondaryIndexes" .= createGlobalSecondaryIndexes ct ]
--instance A.ToJSON CreateTable where
-- toJSON = A.genericToJSON $ dropOpt 6
-- | ServiceConfiguration: 'DdbConfiguration'
instance SignQuery CreateTable where
type ServiceConfiguration CreateTable = DdbConfiguration
signQuery = ddbSignQuery "CreateTable"
newtype CreateTableResult = CreateTableResult { ctStatus :: TableDescription }
deriving (Show, A.FromJSON)
-- ResponseConsumer and AsMemoryResponse can't be derived
instance ResponseConsumer r CreateTableResult where
type ResponseMetadata CreateTableResult = DdbResponse
responseConsumer _ _ = ddbResponseConsumer
instance AsMemoryResponse CreateTableResult where
type MemoryResponse CreateTableResult = TableDescription
loadToMemory = return . ctStatus
instance Transaction CreateTable CreateTableResult
data DescribeTable
= DescribeTable {
dTableName :: T.Text
}
deriving (Show, Generic)
instance A.ToJSON DescribeTable where
toJSON = A.genericToJSON $ dropOpt 1
-- | ServiceConfiguration: 'DdbConfiguration'
instance SignQuery DescribeTable where
type ServiceConfiguration DescribeTable = DdbConfiguration
signQuery = ddbSignQuery "DescribeTable"
newtype DescribeTableResult = DescribeTableResult { dtStatus :: TableDescription }
deriving (Show, A.FromJSON)
-- ResponseConsumer can't be derived
instance ResponseConsumer r DescribeTableResult where
type ResponseMetadata DescribeTableResult = DdbResponse
responseConsumer _ _ = ddbResponseConsumer
instance AsMemoryResponse DescribeTableResult where
type MemoryResponse DescribeTableResult = TableDescription
loadToMemory = return . dtStatus
instance Transaction DescribeTable DescribeTableResult
data UpdateTable
= UpdateTable {
updateTableName :: T.Text
, updateProvisionedThroughput :: ProvisionedThroughput
, updateGlobalSecondaryIndexUpdates :: [GlobalSecondaryIndexUpdate]
}
deriving (Show, Generic)
instance A.ToJSON UpdateTable where
toJSON a = A.object
$ "TableName" .= updateTableName a
: "ProvisionedThroughput" .= updateProvisionedThroughput a
: case updateGlobalSecondaryIndexUpdates a of
[] -> []
l -> [ "GlobalSecondaryIndexUpdates" .= l ]
-- | ServiceConfiguration: 'DdbConfiguration'
instance SignQuery UpdateTable where
type ServiceConfiguration UpdateTable = DdbConfiguration
signQuery = ddbSignQuery "UpdateTable"
newtype UpdateTableResult = UpdateTableResult { uStatus :: TableDescription }
deriving (Show, A.FromJSON)
-- ResponseConsumer can't be derived
instance ResponseConsumer r UpdateTableResult where
type ResponseMetadata UpdateTableResult = DdbResponse
responseConsumer _ _ = ddbResponseConsumer
instance AsMemoryResponse UpdateTableResult where
type MemoryResponse UpdateTableResult = TableDescription
loadToMemory = return . uStatus
instance Transaction UpdateTable UpdateTableResult
data DeleteTable
= DeleteTable {
deleteTableName :: T.Text
}
deriving (Show, Generic)
instance A.ToJSON DeleteTable where
toJSON = A.genericToJSON $ dropOpt 6
-- | ServiceConfiguration: 'DdbConfiguration'
instance SignQuery DeleteTable where
type ServiceConfiguration DeleteTable = DdbConfiguration
signQuery = ddbSignQuery "DeleteTable"
newtype DeleteTableResult = DeleteTableResult { dStatus :: TableDescription }
deriving (Show, A.FromJSON)
-- ResponseConsumer can't be derived
instance ResponseConsumer r DeleteTableResult where
type ResponseMetadata DeleteTableResult = DdbResponse
responseConsumer _ _ = ddbResponseConsumer
instance AsMemoryResponse DeleteTableResult where
type MemoryResponse DeleteTableResult = TableDescription
loadToMemory = return . dStatus
instance Transaction DeleteTable DeleteTableResult
-- | TODO: currently this does not support restarting a cutoff query because of size.
data ListTables = ListTables
deriving (Show)
instance A.ToJSON ListTables where
toJSON _ = A.object []
-- | ServiceConfiguration: 'DdbConfiguration'
instance SignQuery ListTables where
type ServiceConfiguration ListTables = DdbConfiguration
signQuery = ddbSignQuery "ListTables"
newtype ListTablesResult
= ListTablesResult {
tableNames :: [T.Text]
}
deriving (Show, Generic)
instance A.FromJSON ListTablesResult where
parseJSON = A.genericParseJSON capitalizeOpt
instance ResponseConsumer r ListTablesResult where
type ResponseMetadata ListTablesResult = DdbResponse
responseConsumer _ _ = ddbResponseConsumer
instance AsMemoryResponse ListTablesResult where
type MemoryResponse ListTablesResult = [T.Text]
loadToMemory = return . tableNames
instance Transaction ListTables ListTablesResult
================================================
FILE: Aws/DynamoDb/Commands/UpdateItem.hs
================================================
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE NoMonomorphismRestriction #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeFamilies #-}
-----------------------------------------------------------------------------
-- |
-- Module : Aws.DynamoDb.Commands.UpdateItem
-- Copyright : Soostone Inc
-- License : BSD3
--
-- Maintainer : Ozgun Ataman <ozgun.ataman@soostone.com>
-- Stability : experimental
--
--
----------------------------------------------------------------------------
module Aws.DynamoDb.Commands.UpdateItem
( UpdateItem(..)
, updateItem
, AttributeUpdate(..)
, au
, UpdateAction(..)
, UpdateItemResponse(..)
) where
-------------------------------------------------------------------------------
import Control.Applicative
import Data.Aeson
import qualified Data.Aeson.Key as AK
import Data.Default
import qualified Data.Text as T
import Prelude
-------------------------------------------------------------------------------
import Aws.Core
import Aws.DynamoDb.Core
-------------------------------------------------------------------------------
-- | An @UpdateItem@ request.
data UpdateItem = UpdateItem {
uiTable :: T.Text
, uiKey :: PrimaryKey
, uiUpdates :: [AttributeUpdate]
, uiExpect :: Conditions
-- ^ Conditional update - see DynamoDb documentation
, uiReturn :: UpdateReturn
, uiRetCons :: ReturnConsumption
, uiRetMet :: ReturnItemCollectionMetrics
} deriving (Eq,Show,Read,Ord)
-------------------------------------------------------------------------------
-- | Construct a minimal 'UpdateItem' request.
updateItem
:: T.Text -- ^ Table name
-> PrimaryKey -- ^ Primary key for item
-> [AttributeUpdate] -- ^ Updates for this item
-> UpdateItem
updateItem tn key ups = UpdateItem tn key ups def def def def
-- | A helper to avoid overlapping instances for 'ToJSON'.
newtype AttributeUpdates = AttributeUpdates {
getAttributeUpdates :: [AttributeUpdate]
}
data AttributeUpdate = AttributeUpdate {
auAttr :: Attribute
-- ^ Attribute key-value
, auAction :: UpdateAction
-- ^ Type of update operation.
} deriving (Eq,Show,Read,Ord)
instance DynSize AttributeUpdate where
dynSize (AttributeUpdate a _) = dynSize a
-------------------------------------------------------------------------------
-- | Shorthand for the 'AttributeUpdate' constructor. Defaults to PUT
-- for the update action.
au :: Attribute -> AttributeUpdate
au a = AttributeUpdate a def
instance ToJSON AttributeUpdates where
toJSON = object . map mk . getAttributeUpdates
where
mk AttributeUpdate { auAction = UDelete, auAttr = auAttr } =
(AK.fromText (attrName auAttr)) .= object
["Action" .= UDelete]
mk AttributeUpdate { .. } = AK.fromText (attrName auAttr) .= object
["Value" .= (attrVal auAttr), "Action" .= auAction]
-------------------------------------------------------------------------------
-- | Type of attribute update to perform.
--
-- See AWS docs at:
--
-- @http:\/\/docs.aws.amazon.com\/amazondynamodb\/latest\/APIReference\/API_UpdateItem.html@
data UpdateAction
= UPut -- ^ Simply write, overwriting any previous value
| UAdd -- ^ Numerical add or add to set.
| UDelete -- ^ Empty value: remove; Set value: Subtract from set.
deriving (Eq,Show,Read,Ord)
instance ToJSON UpdateAction where
toJSON UPut = String "PUT"
toJSON UAdd = String "ADD"
toJSON UDelete = String "DELETE"
instance Default UpdateAction where
def = UPut
instance ToJSON UpdateItem where
toJSON UpdateItem{..} =
object $ expectsJson uiExpect ++
[ "TableName" .= uiTable
, "Key" .= uiKey
, "AttributeUpdates" .= AttributeUpdates uiUpdates
, "ReturnValues" .= uiReturn
, "ReturnConsumedCapacity" .= uiRetCons
, "ReturnItemCollectionMetrics" .= uiRetMet
]
data UpdateItemResponse = UpdateItemResponse {
uirAttrs :: Maybe Item
-- ^ Old attributes, if requested
, uirConsumed :: Maybe ConsumedCapacity
-- ^ Amount of capacity consumed
} deriving (Eq,Show,Read,Ord)
instance Transaction UpdateItem UpdateItemResponse
instance SignQuery UpdateItem where
type ServiceConfiguration UpdateItem = DdbConfiguration
signQuery gi = ddbSignQuery "UpdateItem" gi
instance FromJSON UpdateItemResponse where
parseJSON (Object v) = UpdateItemResponse
<$> v .:? "Attributes"
<*> v .:? "ConsumedCapacity"
parseJSON _ = fail "UpdateItemResponse expected a JSON object"
instance ResponseConsumer r UpdateItemResponse where
type ResponseMetadata UpdateItemResponse = DdbResponse
responseConsumer _ _ ref resp = ddbResponseConsumer ref resp
instance AsMemoryResponse UpdateItemResponse where
type MemoryResponse UpdateItemResponse = UpdateItemResponse
loadToMemory = return
================================================
FILE: Aws/DynamoDb/Commands.hs
================================================
module Aws.DynamoDb.Commands
( module Aws.DynamoDb.Commands.BatchGetItem
, module Aws.DynamoDb.Commands.BatchWriteItem
, module Aws.DynamoDb.Commands.DeleteItem
, module Aws.DynamoDb.Commands.GetItem
, module Aws.DynamoDb.Commands.PutItem
, module Aws.DynamoDb.Commands.Query
, module Aws.DynamoDb.Commands.Scan
, module Aws.DynamoDb.Commands.Table
, module Aws.DynamoDb.Commands.UpdateItem
) where
-------------------------------------------------------------------------------
import Aws.DynamoDb.Commands.BatchGetItem
import Aws.DynamoDb.Commands.BatchWriteItem
import Aws.DynamoDb.Commands.DeleteItem
import Aws.DynamoDb.Commands.GetItem
import Aws.DynamoDb.Commands.PutItem
import Aws.DynamoDb.Commands.Query
import Aws.DynamoDb.Commands.Scan
import Aws.DynamoDb.Commands.Table
import Aws.DynamoDb.Commands.UpdateItem
-------------------------------------------------------------------------------
================================================
FILE: Aws/DynamoDb/Core.hs
================================================
{-# LANGUAGE CPP #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE NoMonomorphismRestriction #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UndecidableInstances #-}
-----------------------------------------------------------------------------
-- |
-- Module : Aws.DynamoDb.Core
-- Copyright : Soostone Inc, Chris Allen
-- License : BSD3
--
-- Maintainer : Ozgun Ataman <ozgun.ataman@soostone.com>
-- Stability : experimental
--
-- Shared types and utilities for DyanmoDb functionality.
----------------------------------------------------------------------------
module Aws.DynamoDb.Core
(
-- * Configuration and Regions
Region (..)
, ddbLocal
, ddbUsEast1
, ddbUsWest1
, ddbUsWest2
, ddbEuWest1
, ddbEuWest2
, ddbEuCentral1
, ddbApNe1
, ddbApSe1
, ddbApSe2
, ddbSaEast1
, DdbConfiguration (..)
-- * DynamoDB values
, DValue (..)
-- * Converting to/from 'DValue'
, DynVal(..)
, toValue, fromValue
, Bin (..)
, OldBool(..)
-- * Defining new 'DynVal' instances
, DynData(..)
, DynBinary(..), DynNumber(..), DynString(..), DynBool(..)
-- * Working with key/value pairs
, Attribute (..)
, parseAttributeJson
, attributeJson
, attributesJson
, attrTuple
, attr
, attrAs
, text, int, double
, PrimaryKey (..)
, hk
, hrk
-- * Working with objects (attribute collections)
, Item
, item
, attributes
, ToDynItem (..)
, FromDynItem (..)
, fromItem
, Parser (..)
, getAttr
, getAttr'
, parseAttr
-- * Common types used by operations
, Conditions (..)
, conditionsJson
, expectsJson
, Condition (..)
, conditionJson
, CondOp (..)
, CondMerge (..)
, ConsumedCapacity (..)
, ReturnConsumption (..)
, ItemCollectionMetrics (..)
, ReturnItemCollectionMetrics (..)
, UpdateReturn (..)
, QuerySelect (..)
, querySelectJson
-- * Size estimation
, DynSize (..)
, nullAttr
-- * Responses & Errors
, DdbResponse (..)
, DdbErrCode (..)
, shouldRetry
, DdbError (..)
-- * Internal Helpers
, ddbSignQuery
, AmazonError (..)
, ddbResponseConsumer
, ddbHttp
, ddbHttps
) where
-------------------------------------------------------------------------------
import Control.Applicative
import qualified Control.Exception as C
import Control.Monad
#if MIN_VERSION_base(4,9,0)
import qualified Control.Monad.Fail as Fail
#endif
import Control.Monad.Trans
import Control.Monad.Trans.Resource (throwM)
import qualified Crypto.Hash as CH
import Data.Aeson
import qualified Data.Aeson as A
import qualified Data.Aeson.Key as AK
import qualified Data.Aeson.KeyMap as KM
import Data.Aeson.Parser as A (json')
import Data.Aeson.Types (Pair, parseEither)
import qualified Data.Aeson.Types as A
import qualified Data.Attoparsec.ByteString as AttoB (endOfInput)
import qualified Data.Attoparsec.Text as Atto
import qualified Data.ByteArray as ByteArray
import qualified Data.ByteString.Base16 as Base16
import qualified Data.ByteString.Base64 as Base64
import qualified Data.ByteString.Char8 as B
import qualified Data.CaseInsensitive as CI
import Data.Conduit
import Data.Conduit.Attoparsec (sinkParser)
import Data.Default
import Data.Function (on)
import Data.Int
import Data.IORef
import Data.List
import qualified Data.Map as M
import Data.Maybe
import Data.Monoid ()
import qualified Data.Semigroup as Sem
import Data.Proxy
import Data.Scientific
import qualified Data.Serialize as Ser
import qualified Data.Set as S
import Data.String
import Data.Tagged
import qualified Data.Text as T
import qualified Data.Text.Encoding as T
import Data.Time
import Data.Typeable
import qualified Data.Vector as V
import Data.Word
import qualified Network.HTTP.Conduit as HTTP
import qualified Network.HTTP.Types as HTTP
import Safe
-------------------------------------------------------------------------------
import Aws.Core
-------------------------------------------------------------------------------
-------------------------------------------------------------------------------
-- | Boolean values stored in DynamoDb. Only used in defining new
-- 'DynVal' instances.
newtype DynBool = DynBool { unDynBool :: Bool }
deriving (Eq,Show,Read,Ord,Typeable)
-------------------------------------------------------------------------------
-- | Numeric values stored in DynamoDb. Only used in defining new
-- 'DynVal' instances.
newtype DynNumber = DynNumber { unDynNumber :: Scientific }
deriving (Eq,Show,Read,Ord,Typeable)
-------------------------------------------------------------------------------
-- | String values stored in DynamoDb. Only used in defining new
-- 'DynVal' instances.
newtype DynString = DynString { unDynString :: T.Text }
deriving (Eq,Show,Read,Ord,Typeable)
-------------------------------------------------------------------------------
-- | Binary values stored in DynamoDb. Only used in defining new
-- 'DynVal' instances.
newtype DynBinary = DynBinary { unDynBinary :: B.ByteString }
deriving (Eq,Show,Read,Ord,Typeable)
-------------------------------------------------------------------------------
-- | An internally used closed typeclass for values that have direct
-- DynamoDb representations. Based on AWS API, this is basically
-- numbers, strings and binary blobs.
--
-- This is here so that any 'DynVal' haskell value can automatically
-- be lifted to a list or a 'Set' without any instance code
-- duplication.
--
-- Do not try to create your own instances.
class Ord a => DynData a where
fromData :: a -> DValue
toData :: DValue -> Maybe a
instance DynData DynBool where
fromData (DynBool i) = DBool i
toData (DBool i) = Just $ DynBool i
toData (DNum i) = DynBool `fmap` do
(i' :: Int) <- toIntegral i
case i' of
0 -> return False
1 -> return True
_ -> Nothing
toData _ = Nothing
instance DynData (S.Set DynBool) where
fromData set = DBoolSet (S.map unDynBool set)
toData (DBoolSet i) = Just $ S.map DynBool i
toData _ = Nothing
instance DynData DynNumber where
fromData (DynNumber i) = DNum i
toData (DNum i) = Just $ DynNumber i
toData _ = Nothing
instance DynData (S.Set DynNumber) where
fromData set = DNumSet (S.map unDynNumber set)
toData (DNumSet i) = Just $ S.map DynNumber i
toData _ = Nothing
instance DynData DynString where
fromData (DynString i) = DString i
toData (DString i) = Just $ DynString i
toData _ = Nothing
instance DynData (S.Set DynString) where
fromData set = DStringSet (S.map unDynString set)
toData (DStringSet i) = Just $ S.map DynString i
toData _ = Nothing
instance DynData DynBinary where
fromData (DynBinary i) = DBinary i
toData (DBinary i) = Just $ DynBinary i
toData _ = Nothing
instance DynData (S.Set DynBinary) where
fromData set = DBinSet (S.map unDynBinary set)
toData (DBinSet i) = Just $ S.map DynBinary i
toData _ = Nothing
instance DynData DValue where
fromData = id
toData = Just
-------------------------------------------------------------------------------
-- | Class of Haskell types that can be represented as DynamoDb values.
--
-- This is the conversion layer; instantiate this class for your own
-- types and then use the 'toValue' and 'fromValue' combinators to
-- convert in application code.
--
-- Each Haskell type instantiated with this class will map to a
-- DynamoDb-supported type that most naturally represents it.
class DynData (DynRep a) => DynVal a where
-- | Which of the 'DynData' instances does this data type directly
-- map to?
type DynRep a
-- | Convert to representation
toRep :: a -> DynRep a
-- | Convert from representation
fromRep :: DynRep a -> Maybe a
-------------------------------------------------------------------------------
-- | Any singular 'DynVal' can be upgraded to a list.
instance (DynData (DynRep [a]), DynVal a) => DynVal [a] where
type DynRep [a] = S.Set (DynRep a)
fromRep set = mapM fromRep $ S.toList set
toRep as = S.fromList $ map toRep as
-------------------------------------------------------------------------------
-- | Any singular 'DynVal' can be upgraded to a 'Set'.
instance (DynData (DynRep (S.Set a)), DynVal a, Ord a) => DynVal (S.Set a) where
type DynRep (S.Set a) = S.Set (DynRep a)
fromRep set = fmap S.fromList . mapM fromRep $ S.toList set
toRep as = S.map toRep as
instance DynVal DValue where
type DynRep DValue = DValue
fromRep = Just
toRep = id
instance DynVal Bool where
type DynRep Bool = DynBool
fromRep (DynBool i) = Just i
toRep i = DynBool i
instance DynVal Int where
type DynRep Int = DynNumber
fromRep (DynNumber i) = toIntegral i
toRep i = DynNumber (fromIntegral i)
instance DynVal Int8 where
type DynRep Int8 = DynNumber
fromRep (DynNumber i) = toIntegral i
toRep i = DynNumber (fromIntegral i)
instance DynVal Int16 where
type DynRep Int16 = DynNumber
fromRep (DynNumber i) = toIntegral i
toRep i = DynNumber (fromIntegral i)
instance DynVal Int32 where
type DynRep Int32 = DynNumber
fromRep (DynNumber i) = toIntegral i
toRep i = DynNumber (fromIntegral i)
instance DynVal Int64 where
type DynRep Int64 = DynNumber
fromRep (DynNumber i) = toIntegral i
toRep i = DynNumber (fromIntegral i)
instance DynVal Word8 where
type DynRep Word8 = DynNumber
fromRep (DynNumber i) = toIntegral i
toRep i = DynNumber (fromIntegral i)
instance DynVal Word16 where
type DynRep Word16 = DynNumber
fromRep (DynNumber i) = toIntegral i
toRep i = DynNumber (fromIntegral i)
instance DynVal Word32 where
type DynRep Word32 = DynNumber
fromRep (DynNumber i) = toIntegral i
toRep i = DynNumber (fromIntegral i)
instance DynVal Word64 where
type DynRep Word64 = DynNumber
fromRep (DynNumber i) = toIntegral i
toRep i = DynNumber (fromIntegral i)
instance DynVal Integer where
type DynRep Integer = DynNumber
fromRep (DynNumber i) = toIntegral i
toRep i = DynNumber (fromIntegral i)
instance DynVal T.Text where
type DynRep T.Text = DynString
fromRep (DynString i) = Just i
toRep i = DynString i
instance DynVal B.ByteString where
type DynRep B.ByteString = DynBinary
fromRep (DynBinary i) = Just i
toRep i = DynBinary i
instance DynVal Double where
type DynRep Double = DynNumber
fromRep (DynNumber i) = Just $ toRealFloat i
toRep i = DynNumber (fromFloatDigits i)
-------------------------------------------------------------------------------
-- | Encoded as number of days
instance DynVal Day where
type DynRep Day = DynNumber
fromRep (DynNumber i) = ModifiedJulianDay <$> (toIntegral i)
toRep (ModifiedJulianDay i) = DynNumber (fromIntegral i)
-------------------------------------------------------------------------------
-- | Losslessly encoded via 'Integer' picoseconds
instance DynVal UTCTime where
type DynRep UTCTime = DynNumber
fromRep num = fromTS <$> fromRep num
toRep x = toRep (toTS x)
-------------------------------------------------------------------------------
pico :: Rational
pico = toRational $ (10 :: Integer) ^ (12 :: Integer)
-------------------------------------------------------------------------------
dayPico :: Integer
dayPico = 86400 * round pico
-------------------------------------------------------------------------------
-- | Convert UTCTime to picoseconds
--
-- TODO: Optimize performance?
toTS :: UTCTime -> Integer
toTS (UTCTime (ModifiedJulianDay i) diff) = i' + diff'
where
diff' = floor (toRational diff * pico)
i' = i * dayPico
-------------------------------------------------------------------------------
-- | Convert picoseconds to UTCTime
--
-- TODO: Optimize performance?
fromTS :: Integer -> UTCTime
fromTS i = UTCTime (ModifiedJulianDay days) diff
where
(days, secs) = i `divMod` dayPico
diff = fromRational ((toRational secs) / pico)
-- | Type wrapper for binary data to be written to DynamoDB. Wrap any
-- 'Serialize' instance in there and 'DynVal' will know how to
-- automatically handle conversions in binary form.
newtype Bin a = Bin { getBin :: a }
deriving (Eq,Show,Read,Ord,Typeable,Enum)
instance (Ser.Serialize a) => DynVal (Bin a) where
type DynRep (Bin a) = DynBinary
toRep (Bin i) = DynBinary (Ser.encode i)
fromRep (DynBinary i) = either (const Nothing) (Just . Bin) $
Ser.decode i
newtype OldBool = OldBool Bool
instance DynVal OldBool where
type DynRep OldBool = DynNumber
fromRep (DynNumber i) = OldBool `fmap` do
(i' :: Int) <- toIntegral i
case i' of
0 -> return False
1 -> return True
_ -> Nothing
toRep (OldBool b) = DynNumber (if b then 1 else 0)
-------------------------------------------------------------------------------
-- | Encode a Haskell value.
toValue :: DynVal a => a -> DValue
toValue a = fromData $ toRep a
-------------------------------------------------------------------------------
-- | Decode a Haskell value.
fromValue :: DynVal a => DValue -> Maybe a
fromValue d = toData d >>= fromRep
toIntegral :: (Integral a, RealFrac a1) => a1 -> Maybe a
toIntegral sc = Just $ floor sc
-- | Value types natively recognized by DynamoDb. We pretty much
-- exactly reflect the AWS API onto Haskell types.
data DValue
= DNull
| DNum Scientific
| DString T.Text
| DBinary B.ByteString
-- ^ Binary data will automatically be base64 marshalled.
| DNumSet (S.Set Scientific)
| DStringSet (S.Set T.Text)
| DBinSet (S.Set B.ByteString)
-- ^ Binary data will automatically be base64 marshalled.
| DBool Bool
| DBoolSet (S.Set Bool)
-- ^ Composite data
| DList (V.Vector DValue)
| DMap (M.Map T.Text DValue)
deriving (Eq,Show,Read,Ord,Typeable)
instance IsString DValue where
fromString t = DString (T.pack t)
-------------------------------------------------------------------------------
-- | Primary keys consist of either just a Hash key (mandatory) or a
-- hash key and a range key (optional).
data PrimaryKey = PrimaryKey {
pkHash :: Attribute
, pkRange :: Maybe Attribute
} deriving (Read,Show,Ord,Eq,Typeable)
-------------------------------------------------------------------------------
-- | Construct a hash-only primary key.
--
-- >>> hk "user-id" "ABCD"
--
-- >>> hk "user-id" (mkVal 23)
hk :: T.Text -> DValue -> PrimaryKey
hk k v = PrimaryKey (attr k v) Nothing
-------------------------------------------------------------------------------
-- | Construct a hash-and-range primary key.
hrk :: T.Text -- ^ Hash key name
-> DValue -- ^ Hash key value
-> T.Text -- ^ Range key name
-> DValue -- ^ Range key value
-> PrimaryKey
hrk k v k2 v2 = PrimaryKey (attr k v) (Just (attr k2 v2))
instance ToJSON PrimaryKey where
toJSON (PrimaryKey h Nothing) = toJSON h
toJSON (PrimaryKey h (Just r)) =
let Object p1 = toJSON h
Object p2 = toJSON r
in Object (p1 `KM.union` p2)
instance FromJSON PrimaryKey where
parseJSON p = do
l <- listPKey p
case length l of
1 -> return $ head l
_ -> fail "Unable to parse PrimaryKey"
where listPKey p'= map (\(k,dval)-> hk (AK.toText k) dval)
. KM.toList <$> parseJSON p'
-- | A key-value pair
data Attribute = Attribute {
attrName :: T.Text
, attrVal :: DValue
} deriving (Read,Show,Ord,Eq,Typeable)
-- | Convert attribute to a tuple representation
attrTuple :: Attribute -> (T.Text, DValue)
attrTuple (Attribute a b) = (a,b)
-- | Convenience function for constructing key-value pairs
attr :: DynVal a => T.Text -> a -> Attribute
attr k v = Attribute k (toValue v)
-- | 'attr' with type witness to help with cases where you're manually
-- supplying values in code.
--
-- >> item [ attrAs text "name" "john" ]
attrAs :: DynVal a => Proxy a -> T.Text -> a -> Attribute
attrAs _ k v = attr k v
-- | Type witness for 'Text'. See 'attrAs'.
text :: Proxy T.Text
text = Proxy
-- | Type witness for 'Integer'. See 'attrAs'.
int :: Proxy Integer
int = Proxy
-- | Type witness for 'Double'. See 'attrAs'.
double :: Proxy Double
double = Proxy
-- | A DynamoDb object is simply a key-value dictionary.
type Item = M.Map T.Text DValue
-------------------------------------------------------------------------------
-- | Pack a list of attributes into an Item.
item :: [Attribute] -> Item
item = M.fromList . map attrTuple
-------------------------------------------------------------------------------
-- | Unpack an 'Item' into a list of attributes.
attributes :: M.Map T.Text DValue -> [Attribute]
attributes = map (\ (k, v) -> Attribute k v) . M.toList
showT :: Show a => a -> T.Text
showT = T.pack . show
instance ToJSON DValue where
toJSON DNull = object ["NULL" .= True]
toJSON (DNum i) = object ["N" .= showT i]
toJSON (DString i) = object ["S" .= i]
toJSON (DBinary i) = object ["B" .= (T.decodeUtf8 $ Base64.encode i)]
toJSON (DNumSet i) = object ["NS" .= map showT (S.toList i)]
toJSON (DStringSet i) = object ["SS" .= S.toList i]
toJSON (DBinSet i) = object ["BS" .= map (T.decodeUtf8 . Base64.encode) (S.toList i)]
toJSON (DBool i) = object ["BOOL" .= i]
toJSON (DList i) = object ["L" .= i]
toJSON (DMap i) = object ["M" .= i]
toJSON x = error $ "aws: bug: DynamoDB can't handle " ++ show x
instance FromJSON DValue where
parseJSON o = do
(obj :: [(T.Text, Value)]) <- M.toList `liftM` parseJSON o
case obj of
[("NULL", _)] -> return DNull
[("N", numStr)] -> DNum <$> parseScientific numStr
[("S", str)] -> DString <$> parseJSON str
[("B", bin)] -> do
res <- (Base64.decode . T.encodeUtf8) <$> parseJSON bin
either fail (return . DBinary) res
[("NS", s)] -> do xs <- mapM parseScientific =<< parseJSON s
return $ DNumSet $ S.fromList xs
[("SS", s)] -> DStringSet <$> parseJSON s
[("BS", s)] -> do
xs <- mapM (either fail return . Base64.decode . T.encodeUtf8)
=<< parseJSON s
return $ DBinSet $ S.fromList xs
[("BOOL", b)] -> DBool <$> parseJSON b
[("L", attrs)] -> DList <$> parseJSON attrs
[("M", attrs)] -> DMap <$> parseJSON attrs
x -> fail $ "aws: unknown dynamodb value: " ++ show x
where
parseScientific (String str) =
case Atto.parseOnly Atto.scientific str of
Left e -> fail ("parseScientific failed: " ++ e)
Right a -> return a
parseScientific (Number n) = return n
parseScientific _ = fail "Unexpected JSON type in parseScientific"
instance ToJSON Attribute where
toJSON a = object $ [attributeJson a]
-------------------------------------------------------------------------------
-- | Parse a JSON object that contains attributes
parseAttributeJson :: Value -> A.Parser [Attribute]
parseAttributeJson (Object v) = mapM conv $ KM.toList v
where
conv (k, o) = Attribute (AK.toText k) <$> parseJSON o
parseAttributeJson _ = error "Attribute JSON must be an Object"
-- | Convert into JSON object for AWS.
attributesJson :: [Attribute] -> Value
attributesJson as = object $ map attributeJson as
-- | Convert into JSON pair
attributeJson :: Attribute -> Pair
attributeJson (Attribute nm v) = AK.fromText nm .= v
-------------------------------------------------------------------------------
-- | Errors defined by AWS.
data DdbErrCode
= AccessDeniedException
| ConditionalCheckFailedException
| IncompleteSignatureException
| InvalidSignatureException
| LimitExceededException
| MissingAuthenticationTokenException
| ProvisionedThroughputExceededException
| ResourceInUseException
| ResourceNotFoundException
| ThrottlingException
| ValidationException
| RequestTooLarge
| InternalFailure
| InternalServerError
| ServiceUnavailableException
| SerializationException
-- ^ Raised by AWS when the request JSON is missing fields or is
-- somehow malformed.
deriving (Read,Show,Eq,Typeable)
-------------------------------------------------------------------------------
-- | Whether the action should be retried based on the received error.
shouldRetry :: DdbErrCode -> Bool
shouldRetry e = go e
where
go LimitExceededException = True
go ProvisionedThroughputExceededException = True
go ResourceInUseException = True
go ThrottlingException = True
go InternalFailure = True
go InternalServerError = True
go ServiceUnavailableException = True
go _ = False
-------------------------------------------------------------------------------
-- | Errors related to this library.
data DdbLibraryError
= UnknownDynamoErrCode T.Text
-- ^ A DynamoDB error code we do not know about.
| JsonProtocolError Value T.Text
-- ^ A JSON response we could not parse.
deriving (Show,Eq,Typeable)
-- | Potential errors raised by DynamoDB
data DdbError = DdbError {
ddbStatusCode :: Int
-- ^ 200 if successful, 400 for client errors and 500 for
-- server-side errors.
, ddbErrCode :: DdbErrCode
, ddbErrMsg :: T.Text
} deriving (Show,Eq,Typeable)
instance C.Exception DdbError
instance C.Exception DdbLibraryError
-- | Response metadata that is present in every DynamoDB response.
data DdbResponse = DdbResponse {
ddbrCrc :: Maybe T.Text
, ddbrMsgId :: Maybe T.Text
}
instance Loggable DdbResponse where
toLogText (DdbResponse id2 rid) =
"DynamoDB: request ID=" `mappend`
fromMaybe "<none>" rid `mappend`
", x-amz-id-2=" `mappend`
fromMaybe "<none>" id2
instance Sem.Semigroup DdbResponse where
a <> b = DdbResponse (ddbrCrc a `mplus` ddbrCrc b) (ddbrMsgId a `mplus` ddbrMsgId b)
instance Monoid DdbResponse where
mempty = DdbResponse Nothing Nothing
mappend = (Sem.<>)
data Region = Region {
rUri :: B.ByteString
, rName :: B.ByteString
} deriving (Eq,Show,Read,Typeable)
data DdbConfiguration qt = DdbConfiguration {
ddbcRegion :: Region
-- ^ The regional endpoint. Ex: 'ddbUsEast'
, ddbcProtocol :: Protocol
-- ^ 'HTTP' or 'HTTPS'
, ddbcPort :: Maybe Int
-- ^ Port override (mostly for local dev connection)
} deriving (Show,Typeable)
instance Default (DdbConfiguration NormalQuery) where
def = DdbConfiguration ddbUsEast1 HTTPS Nothing
instance DefaultServiceConfiguration (DdbConfiguration NormalQuery) where
defServiceConfig = ddbHttps ddbUsEast1
debugServiceConfig = ddbHttp ddbUsEast1
-------------------------------------------------------------------------------
-- | DynamoDb local connection (for development)
ddbLocal :: Region
ddbLocal = Region "127.0.0.1" "local"
ddbUsEast1 :: Region
ddbUsEast1 = Region "dynamodb.us-east-1.amazonaws.com" "us-east-1"
ddbUsWest1 :: Region
ddbUsWest1 = Region "dynamodb.us-west-1.amazonaws.com" "us-west-1"
ddbUsWest2 :: Region
ddbUsWest2 = Region "dynamodb.us-west-2.amazonaws.com" "us-west-2"
ddbEuWest1 :: Region
ddbEuWest1 = Region "dynamodb.eu-west-1.amazonaws.com" "eu-west-1"
ddbEuWest2 :: Region
ddbEuWest2 = Region "dynamodb.eu-west-2.amazonaws.com" "eu-west-2"
ddbEuCentral1 :: Region
ddbEuCentral1 = Region "dynamodb.eu-central-1.amazonaws.com" "eu-central-1"
ddbApNe1 :: Region
ddbApNe1 = Region "dynamodb.ap-northeast-1.amazonaws.com" "ap-northeast-1"
ddbApSe1 :: Region
ddbApSe1 = Region "dynamodb.ap-southeast-1.amazonaws.com" "ap-southeast-1"
ddbApSe2 :: Region
ddbApSe2 = Region "dynamodb.ap-southeast-2.amazonaws.com" "ap-southeast-2"
ddbSaEast1 :: Region
ddbSaEast1 = Region "dynamodb.sa-east-1.amazonaws.com" "sa-east-1"
ddbHttp :: Region -> DdbConfiguration NormalQuery
ddbHttp endpoint = DdbConfiguration endpoint HTTP Nothing
ddbHttps :: Region -> DdbConfiguration NormalQuery
ddbHttps endpoint = DdbConfiguration endpoint HTTPS Nothing
ddbSignQuery
:: A.ToJSON a
=> B.ByteString
-> a
-> DdbConfiguration qt
-> SignatureData
-> SignedQuery
ddbSignQuery target body di sd
= SignedQuery {
sqMethod = Post
, sqProtocol = ddbcProtocol di
, sqHost = host
, sqPort = fromMaybe (defaultPort (ddbcProtocol di)) (ddbcPort di)
, sqPath = "/"
, sqQuery = []
, sqDate = Just $ signatureTime sd
, sqAuthorization = Just auth
, sqContentType = Just "application/x-amz-json-1.0"
, sqContentMd5 = Nothing
, sqAmzHeaders = amzHeaders ++ maybe [] (\tok -> [("x-amz-security-token",tok)]) (iamToken credentials)
, sqOtherHeaders = []
, sqBody = Just $ HTTP.RequestBodyLBS bodyLBS
, sqStringToSign = canonicalRequest
}
where
credentials = signatureCredentials sd
Region{..} = ddbcRegion di
host = rUri
sigTime = fmtTime "%Y%m%dT%H%M%SZ" $ signatureTime sd
bodyLBS = A.encode body
bodyHash = Base16.encode $ ByteArray.convert (CH.hashlazy bodyLBS :: CH.Digest CH.SHA256)
-- for some reason AWS doesn't want the x-amz-security-token in the canonical request
amzHeaders = [ ("x-amz-date", sigTime)
, ("x-amz-target", dyApiVersion Sem.<> target)
]
canonicalHeaders = sortBy (compare `on` fst) $ amzHeaders ++
[("host", host),
("content-type", "application/x-amz-json-1.0")]
canonicalRequest = B.concat $ intercalate ["\n"] (
[ ["POST"]
, ["/"]
, [] -- query string
] ++
map (\(a,b) -> [CI.foldedCase a,":",b]) canonicalHeaders ++
[ [] -- end headers
, intersperse ";" (map (CI.foldedCase . fst) canonicalHeaders)
, [bodyHash]
])
auth = authorizationV4 sd HmacSHA256 rName "dynamodb"
"content-type;host;x-amz-date;x-amz-target"
canonicalRequest
data AmazonError = AmazonError {
aeType :: T.Text
, aeMessage :: Maybe T.Text
}
instance FromJSON AmazonError where
parseJSON (Object v) = AmazonError
<$> v .: "__type"
<*> (Just <$> (v .: "message" <|> v .: "Message") <|> pure Nothing)
parseJSON _ = error $ "aws: unexpected AmazonError message"
-------------------------------------------------------------------------------
ddbResponseConsumer :: A.FromJSON a => IORef DdbResponse -> HTTPResponseConsumer a
ddbResponseConsumer ref resp = do
val <- runConduit $ HTTP.responseBody resp .| sinkParser (A.json' <* AttoB.endOfInput)
case statusCode of
200 -> rSuccess val
_ -> rError val
where
header = fmap T.decodeUtf8 . flip lookup (HTTP.responseHeaders resp)
amzId = header "x-amzn-RequestId"
amzCrc = header "x-amz-crc32"
meta = DdbResponse amzCrc amzId
tellMeta = liftIO $ tellMetadataRef ref meta
rSuccess val =
case A.fromJSON val of
A.Success a -> return a
A.Error err -> do
tellMeta
throwM $ JsonProtocolError val (T.pack err)
rError val = do
tellMeta
case parseEither parseJSON val of
Left e ->
throwM $ JsonProtocolError val (T.pack e)
Right err'' -> do
let e = T.drop 1 . snd . T.breakOn "#" $ aeType err''
errCode <- readErrCode e
throwM $ DdbError statusCode errCode (fromMaybe "" $ aeMessage err'')
readErrCode txt =
let txt' = T.unpack txt
in case readMay txt' of
Just e -> return $ e
Nothing -> throwM (UnknownDynamoErrCode txt)
HTTP.Status{..} = HTTP.responseStatus resp
-- | Conditions used by mutation operations ('PutItem', 'UpdateItem',
-- etc.). The default 'def' instance is empty (no condition).
data Conditions = Conditions CondMerge [Condition]
deriving (Eq,Show,Read,Ord,Typeable)
instance Default Conditions where
def = Conditions CondAnd []
expectsJson :: Conditions -> [A.Pair]
expectsJson = conditionsJson "Expected"
-- | JSON encoding of conditions parameter in various contexts.
conditionsJson :: T.Text -> Conditions -> [A.Pair]
conditionsJson key (Conditions op es) = b ++ a
where
a = if null es
then []
else [AK.fromText key .= object (map conditionJson es)]
b = if length (take 2 es) > 1
then ["ConditionalOperator" .= String (rendCondOp op) ]
else []
-------------------------------------------------------------------------------
rendCondOp :: CondMerge -> T.Text
rendCondOp CondAnd = "AND"
rendCondOp CondOr = "OR"
-------------------------------------------------------------------------------
-- | How to merge multiple conditions.
data CondMerge = CondAnd | CondOr
deriving (Eq,Show,Read,Ord,Typeable)
-- | A condition used by mutation operations ('PutItem', 'UpdateItem', etc.).
data Condition = Condition {
condAttr :: T.Text
-- ^ Attribute to use as the basis for this conditional
, condOp :: CondOp
-- ^ Operation on the selected attribute
} deriving (Eq,Show,Read,Ord,Typeable)
-------------------------------------------------------------------------------
-- | Conditional operation to perform on a field.
data CondOp
= DEq DValue
| NotEq DValue
| DLE DValue
| DLT DValue
| DGE DValue
| DGT DValue
| NotNull
| IsNull
| Contains DValue
| NotContains DValue
| Begins DValue
| In [DValue]
| Between DValue DValue
deriving (Eq,Show,Read,Ord,Typeable)
-------------------------------------------------------------------------------
getCondValues :: CondOp -> [DValue]
getCondValues c = case c of
DEq v -> [v]
NotEq v -> [v]
DLE v -> [v]
DLT v -> [v]
DGE v -> [v]
DGT v -> [v]
NotNull -> []
IsNull -> []
Contains v -> [v]
NotContains v -> [v]
Begins v -> [v]
In v -> v
Between a b -> [a,b]
-------------------------------------------------------------------------------
renderCondOp :: CondOp -> T.Text
renderCondOp c = case c of
DEq{} -> "EQ"
NotEq{} -> "NE"
DLE{} -> "LE"
DLT{} -> "LT"
DGE{} -> "GE"
DGT{} -> "GT"
NotNull -> "NOT_NULL"
IsNull -> "NULL"
Contains{} -> "CONTAINS"
NotContains{} -> "NOT_CONTAINS"
Begins{} -> "BEGINS_WITH"
In{} -> "IN"
Between{} -> "BETWEEN"
conditionJson :: Condition -> Pair
conditionJson Condition{..} = AK.fromText condAttr .= condOp
instance ToJSON CondOp where
toJSON c = object $ ("ComparisonOperator" .= String (renderCondOp c)) : valueList
where
valueList =
let vs = getCondValues c in
if null vs
then []
else ["AttributeValueList" .= vs]
-------------------------------------------------------------------------------
dyApiVersion :: B.ByteString
dyApiVersion = "DynamoDB_20120810."
-------------------------------------------------------------------------------
-- | The standard response metrics on capacity consumption.
data ConsumedCapacity = ConsumedCapacity {
capacityUnits :: Int64
, capacityGlobalIndex :: [(T.Text, Int64)]
, capacityLocalIndex :: [(T.Text, Int64)]
, capacityTableUnits :: Maybe Int64
, capacityTable :: T.Text
} deriving (Eq,Show,Read,Ord,Typeable)
instance FromJSON ConsumedCapacity where
parseJSON (Object o) = ConsumedCapacity
<$> o .: "CapacityUnits"
<*> (map (\(k, v) -> (AK.toText k, v)) . KM.toList <$> o .:? "GlobalSecondaryIndexes" .!= mempty)
<*> (map (\(k, v) -> (AK.toText k, v)) . KM.toList <$> o .:? "LocalSecondaryIndexes" .!= mempty)
<*> (o .:? "Table" >>= maybe (return Nothing) (.: "CapacityUnits"))
<*> o .: "TableName"
parseJSON _ = fail "ConsumedCapacity must be an Object."
data ReturnConsumption = RCIndexes | RCTotal | RCNone
deriving (Eq,Show,Read,Ord,Typeable)
instance ToJSON ReturnConsumption where
toJSON RCIndexes = String "INDEXES"
toJSON RCTotal = String "TOTAL"
toJSON RCNone = String "NONE"
instance Default ReturnConsumption where
def = RCNone
data ReturnItemCollectionMetrics = RICMSize | RICMNone
deriving (Eq,Show,Read,Ord,Typeable)
instance ToJSON ReturnItemCollectionMetrics where
toJSON RICMSize = String "SIZE"
toJSON RICMNone = String "NONE"
instance Default ReturnItemCollectionMetrics where
def = RICMNone
data ItemCollectionMetrics = ItemCollectionMetrics {
icmKey :: (T.Text, DValue)
, icmEstimate :: [Double]
} deriving (Eq,Show,Read,Ord,Typeable)
instance FromJSON ItemCollectionMetrics where
parseJSON (Object o) = ItemCollectionMetrics
<$> (do m <- o .: "ItemCollectionKey"
return $ (\(k, v) -> (AK.toText k, v)) $ head $ KM.toList m)
<*> o .: "SizeEstimateRangeGB"
parseJSON _ = fail "ItemCollectionMetrics must be an Object."
-------------------------------------------------------------------------------
-- | What to return from the current update operation
data UpdateReturn
= URNone -- ^ Return nothing
| URAllOld -- ^ Return old values
| URUpdatedOld -- ^ Return old values with a newer replacement
| URAllNew -- ^ Return new values
| URUpdatedNew -- ^ Return new values that were replacements
deriving (Eq,Show,Read,Ord,Typeable)
instance ToJSON UpdateReturn where
toJSON URNone = toJSON (String "NONE")
toJSON URAllOld = toJSON (String "ALL_OLD")
toJSON URUpdatedOld = toJSON (String "UPDATED_OLD")
toJSON URAllNew = toJSON (String "ALL_NEW")
toJSON URUpdatedNew = toJSON (String "UPDATED_NEW")
instance Default UpdateReturn where
def = URNone
-------------------------------------------------------------------------------
-- | What to return from a 'Query' or 'Scan' query.
data QuerySelect
= SelectSpecific [T.Text]
-- ^ Only return selected attributes
| SelectCount
-- ^ Return counts instead of attributes
| SelectProjected
-- ^ Return index-projected attributes
| SelectAll
-- ^ Default. Return everything.
deriving (Eq,Show,Read,Ord,Typeable)
instance Default QuerySelect where def = SelectAll
-------------------------------------------------------------------------------
querySelectJson :: KeyValue A.Value t => QuerySelect -> [t]
querySelectJson (SelectSpecific as) =
[ "Select" .= String "SPECIFIC_ATTRIBUTES"
, "AttributesToGet" .= as]
querySelectJson SelectCount = ["Select" .= String "COUNT"]
querySelectJson SelectProjected = ["Select" .= String "ALL_PROJECTED_ATTRIBUTES"]
querySelectJson SelectAll = ["Select" .= String "ALL_ATTRIBUTES"]
-------------------------------------------------------------------------------
-- | A class to help predict DynamoDb size of values, attributes and
-- entire items. The result is given in number of bytes.
class DynSize a where
dynSize :: a -> Int
instance DynSize DValue where
dynSize DNull = 8
dynSize (DBool _) = 8
dynSize (DBoolSet s) = sum $ map (dynSize . DBool) $ S.toList s
dynSize (DNum _) = 8
dynSize (DString a) = T.length a
dynSize (DBinary bs) = T.length . T.decodeUtf8 $ Base64.encode bs
dynSize (DNumSet s) = 8 * S.size s
dynSize (DStringSet s) = sum $ map (dynSize . DString) $ S.toList s
dynSize (DBinSet s) = sum $ map (dynSize . DBinary) $ S.toList s
dynSize (DList s) = sum $ map dynSize $ V.toList s
dynSize (DMap s) = sum $ map dynSize $ M.elems s
instance DynSize Attribute where
dynSize (Attribute k v) = T.length k + dynSize v
instance DynSize Item where
dynSize m = sum $ map dynSize $ attributes m
instance DynSize a => DynSize [a] where
dynSize as = sum $ map dynSize as
instance DynSize a => DynSize (Maybe a) where
dynSize = maybe 0 dynSize
instance (DynSize a, DynSize b) => DynSize (Either a b) where
dynSize = either dynSize dynSize
-------------------------------------------------------------------------------
-- | Will an attribute be considered empty by DynamoDb?
--
-- A 'PutItem' (or similar) with empty attributes will be rejected
-- with a 'ValidationException'.
nullAttr :: Attribute -> Bool
nullAttr (Attribute _ val) =
case val of
DString "" -> True
DBinary "" -> True
DNumSet s | S.null s -> True
DStringSet s | S.null s -> True
DBinSet s | S.null s -> True
_ -> False
-------------------------------------------------------------------------------
--
-- | Item Parsing
--
-------------------------------------------------------------------------------
-- | Failure continuation.
type Failure f r = String -> f r
-- | Success continuation.
type Success a f r = a -> f r
-- | A continuation-based parser type.
newtype Parser a = Parser {
runParser :: forall f r.
Failure f r
-> Success a f r
-> f r
}
instance Monad Parser where
m >>= g = Parser $ \kf ks -> let ks' a = runParser (g a) kf ks
in runParser m kf ks'
{-# INLINE (>>=) #-}
return = pure
{-# INLINE return #-}
#if !(MIN_VERSION_base(4,13,0))
fail msg = Parser $ \kf _ks -> kf msg
{-# INLINE fail #-}
#endif
#if MIN_VERSION_base(4,9,0)
instance Fail.MonadFail Parser where
fail msg = Parser $ \kf _ks -> kf msg
{-# INLINE fail #-}
#endif
instance Functor Parser where
fmap f m = Parser $ \kf ks -> let ks' a = ks (f a)
in runParser m kf ks'
{-# INLINE fmap #-}
instance Applicative Parser where
pure a = Parser $ \_kf ks -> ks a
{-# INLINE pure #-}
(<*>) = apP
{-# INLINE (<*>) #-}
instance Alternative Parser where
empty = fail "empty"
{-# INLINE empty #-}
(<|>) = mplus
{-# INLINE (<|>) #-}
instance MonadPlus Parser where
mzero = fail "mzero"
{-# INLINE mzero #-}
mplus a b = Parser $ \kf ks -> let kf' _ = runParser b kf ks
in runParser a kf' ks
{-# INLINE mplus #-}
instance Sem.Semigroup (Parser a) where
(<>) = mplus
{-# INLINE (<>) #-}
instance Monoid (Parser a) where
mempty = fail "mempty"
{-# INLINE mempty #-}
mappend = (Sem.<>)
{-# INLINE mappend #-}
apP :: Parser (a -> b) -> Parser a -> Parser b
apP d e = do
b <- d
a <- e
return (b a)
{-# INLINE apP #-}
-------------------------------------------------------------------------------
-- | Types convertible to DynamoDb 'Item' collections.
--
-- Use 'attr' and 'attrAs' combinators to conveniently define instances.
class ToDynItem a where
toItem :: a -> Item
-------------------------------------------------------------------------------
-- | Types parseable from DynamoDb 'Item' collections.
--
-- User 'getAttr' family of functions to applicatively or monadically
-- parse into your custom types.
class FromDynItem a where
parseItem :: Item -> Parser a
instance ToDynItem Item where toItem = id
instance FromDynItem Item where parseItem = return
instance DynVal a => ToDynItem [(T.Text, a)] where
toItem as = item $ map (uncurry attr) as
instance (Typeable a, DynVal a) => FromDynItem [(T.Text, a)] where
parseItem i = mapM f $ M.toList i
where
f (k,v) = do
v' <- maybe (fail (valErr (Tagged v :: Tagged a DValue))) return $
fromValue v
return (k, v')
instance DynVal a => ToDynItem (M.Map T.Text a) where
toItem m = toItem $ M.toList m
instance (Typeable a, DynVal a) => FromDynItem (M.Map T.Text a) where
parseItem i = M.fromList <$> parseItem i
valErr :: forall a. Typeable a => Tagged a DValue -> String
valErr (Tagged dv) = "Can't convert DynamoDb value " Sem.<> show dv Sem.<>
" into type " Sem.<> (show (typeOf (undefined :: a)))
-- | Convenience combinator for parsing fields from an 'Item' returned
-- by DynamoDb.
getAttr
:: forall a. (Typeable a, DynVal a)
=> T.Text
-- ^ Attribute name
-> Item
-- ^ Item from DynamoDb
-> Parser a
getAttr k m = do
case M.lookup k m of
Nothing -> fail ("Key " Sem.<> T.unpack k Sem.<> " not found")
Just dv -> maybe (fail (valErr (Tagged dv :: Tagged a DValue))) return $ fromValue dv
-- | Parse attribute if it's present in the 'Item'. Fail if attribute
-- is present but conversion fails.
getAttr'
:: forall a. (DynVal a)
=> T.Text
-- ^ Attribute name
-> Item
-- ^ Item from DynamoDb
-> Parser (Maybe a)
getAttr' k m = do
case M.lookup k m of
Nothing -> return Nothing
Just dv -> return $ fromValue dv
-- | Combinator for parsing an attribute into a 'FromDynItem'.
parseAttr
:: FromDynItem a
=> T.Text
-- ^ Attribute name
-> Item
-- ^ Item from DynamoDb
-> Parser a
parseAttr k m =
case M.lookup k m of
Nothing -> fail ("Key " Sem.<> T.unpack k Sem.<> " not found")
Just (DMap dv) -> either (const (fail "...")) return $ fromItem dv
_ -> fail ("Key " Sem.<> T.unpack k Sem.<> " is not a map!")
-------------------------------------------------------------------------------
-- | Parse an 'Item' into target type using the 'FromDynItem'
-- instance.
fromItem :: FromDynItem a => Item -> Either String a
fromItem i = runParser (parseItem i) Left Right
================================================
FILE: Aws/DynamoDb.hs
================================================
-----------------------------------------------------------------------------
-- |
-- Module : Aws.DynaboDb
-- Copyright : Ozgun Ataman, Soostone Inc.
-- License : BSD3
--
-- Maintainer : Ozgun Ataman <oz@soostone.com>
-- Stability : experimental
--
----------------------------------------------------------------------------
module Aws.DynamoDb
( module Aws.DynamoDb.Core
, module Aws.DynamoDb.Commands
) where
-------------------------------------------------------------------------------
import Aws.DynamoDb.Commands
import Aws.DynamoDb.Core
-------------------------------------------------------------------------------
================================================
FILE: Aws/Ec2/InstanceMetadata.hs
================================================
module Aws.Ec2.InstanceMetadata where
import Control.Applicative
import Control.Exception
import Control.Monad.Trans.Resource (throwM)
import qualified Data.ByteString.Lazy as L
import qualified Data.ByteString.Lazy.Char8 as B8
import Data.ByteString.Lazy.UTF8 as BU
import Data.Typeable
import qualified Network.HTTP.Conduit as HTTP
import Prelude
data InstanceMetadataException
= MetadataNotFound String
deriving (Show, Typeable)
instance Exception InstanceMetadataException
getInstanceMetadata :: HTTP.Manager -> String -> String -> IO L.ByteString
getInstanceMetadata mgr p x = do
req <- HTTP.parseUrlThrow ("http://169.254.169.254/" ++ p ++ '/' : x)
HTTP.responseBody <$> HTTP.httpLbs req mgr
getInstanceMetadataListing :: HTTP.Manager -> String -> IO [String]
getInstanceMetadataListing mgr p = map BU.toString . B8.split '\n' <$> getInstanceMetadata mgr p ""
getInstanceMetadataFirst :: HTTP.Manager -> String -> IO L.ByteString
getInstanceMetadataFirst mgr p = do listing <- getInstanceMetadataListing mgr p
case listing of
[] -> throwM (MetadataNotFound p)
(x:_) -> getInstanceMetadata mgr p x
getInstanceMetadataOrFirst :: HTTP.Manager -> String -> Maybe String -> IO L.ByteString
getInstanceMetadataOrFirst mgr p (Just x) = getInstanceMetadata mgr p x
getInstanceMetadataOrFirst mgr p Nothing = getInstanceMetadataFirst mgr p
================================================
FILE: Aws/Iam/Commands/AddUserToGroup.hs
================================================
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE TypeFamilies #-}
module Aws.Iam.Commands.AddUserToGroup
( AddUserToGroup(..)
, AddUserToGroupResponse(..)
) where
import Aws.Core
import Aws.Iam.Core
import Aws.Iam.Internal
import Data.Text (Text)
import Data.Typeable
-- | Adds the specified user to the specified group.
--
-- <http://docs.aws.amazon.com/IAM/latest/APIReference/API_AddUserToGroup.html>
data AddUserToGroup
= AddUserToGroup {
autgGroupName :: Text
-- ^ Name of the group to update.
, autgUserName :: Text
-- ^ The of the user to add.
}
deriving (Eq, Ord, Show, Typeable)
instance SignQuery AddUserToGroup where
type ServiceConfiguration AddUserToGroup = IamConfiguration
signQuery AddUserToGroup{..}
= iamAction "AddUserToGroup" [
("GroupName" , autgGroupName)
, ("UserName" , autgUserName)
]
data AddUserToGroupResponse = AddUserToGroupResponse
deriving (Eq, Ord, Show, Typeable)
instance ResponseConsumer AddUserToGroup AddUserToGroupResponse where
type ResponseMetadata AddUserToGroupResponse = IamMetadata
responseConsumer _ _
= iamResponseConsumer (const $ return AddUserToGroupResponse)
instance Transaction AddUserToGroup AddUserToGroupResponse
instance AsMemoryResponse AddUserToGroupResponse where
type MemoryResponse AddUserToGroupResponse = AddUserToGroupResponse
loadToMemory = return
================================================
FILE: Aws/Iam/Commands/CreateAccessKey.hs
================================================
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE TypeFamilies #-}
module Aws.Iam.Commands.CreateAccessKey
( CreateAccessKey(..)
, CreateAccessKeyResponse(..)
, AccessKey(..)
) where
import Aws.Core
import Aws.Iam.Core
import Aws.Iam.Internal
import Control.Applicative
import Data.Text (Text)
import qualified Data.Text as Text
import Data.Time
import Data.Typeable
import Prelude
import Text.XML.Cursor (($//))
-- | Creates a new AWS secret access key and corresponding AWS access key ID
-- for the given user name.
--
-- If a user name is not provided, IAM will determine the user name based on
-- the access key signing the request.
--
-- <http://docs.aws.amazon.com/IAM/latest/APIReference/API_CreateAccessKey.html>
data CreateAccessKey = CreateAccessKey (Maybe Text)
deriving (Eq, Ord, Show, Typeable)
instance SignQuery CreateAccessKey where
type ServiceConfiguration CreateAccessKey = IamConfiguration
signQuery (CreateAccessKey user)
= iamAction' "CreateAccessKey" [("UserName",) <$> user]
-- | Represents the IAM @AccessKey@ data type.
--
-- <http://docs.aws.amazon.com/IAM/latest/APIReference/API_AccessKey.html>
data AccessKey
= AccessKey {
akAccessKeyId :: Text
-- ^ The Access Key ID.
, akCreateDate :: Maybe UTCTime
-- ^ Date and time at which the access key was created.
, akSecretAccessKey :: Text
-- ^ Secret key used to sign requests. The secret key is accessible only
-- during key creation.
, akStatus :: AccessKeyStatus
-- ^ Whether the access key is active or not.
, akUserName :: Text
-- ^ The user name for which this key is defined.
}
deriving (Eq, Ord, Show, Typeable)
data CreateAccessKeyResponse
= CreateAccessKeyResponse AccessKey
deriving (Eq, Ord, Show, Typeable)
instance ResponseConsumer CreateAccessKey CreateAccessKeyResponse where
type ResponseMetadata CreateAccessKeyResponse = IamMetadata
responseConsumer _ _
= iamResponseConsumer $ \cursor -> do
let attr name = force ("Missing " ++ Text.unpack name) $
cursor $// elContent name
akAccessKeyId <- attr "AccessKeyId"
akSecretAccessKey <- attr "SecretAccessKey"
akStatus <- readAccessKeyStatus <$> attr "Status"
akUserName <- attr "UserName"
akCreateDate <- readDate cursor
return $ CreateAccessKeyResponse AccessKey{..}
where
readDate c = case c $// elCont "CreateDate" of
(x:_) -> Just <$> parseDateTime x
_ -> return Nothing
readAccessKeyStatus s
| Text.toCaseFold s == "Active" = AccessKeyActive
| otherwise = AccessKeyInactive
instance Transaction CreateAccessKey CreateAccessKeyResponse
instance AsMemoryResponse CreateAccessKeyResponse where
type MemoryResponse CreateAccessKeyResponse = CreateAccessKeyResponse
loadToMemory = return
================================================
FILE: Aws/Iam/Commands/CreateGroup.hs
================================================
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE TypeFamilies #-}
module Aws.Iam.Commands.CreateGroup
( CreateGroup(..)
, CreateGroupResponse(..)
, Group(..)
) where
import Aws.Core
import Aws.Iam.Core
import Aws.Iam.Internal
import Control.Applicative
import Data.Text (Text)
import Data.Typeable
import Prelude
-- | Creates a new group.
--
-- <http://docs.aws.amazon.com/IAM/latest/APIReference/API_CreateGroup.html>
data CreateGroup
= CreateGroup {
cgGroupName :: Text
-- ^ Name of the new group
, cgPath :: Maybe Text
-- ^ Path under which the group will be created. Defaults to @/@ if
-- omitted.
}
deriving (Eq, Ord, Show, Typeable)
instance SignQuery CreateGroup where
type ServiceConfiguration CreateGroup = IamConfiguration
signQuery CreateGroup{..}
= iamAction' "CreateGroup" [
Just ("GroupName", cgGroupName)
, ("Path",) <$> cgPath
]
data CreateGroupResponse = CreateGroupResponse Group
deriving (Eq, Ord, Show, Typeable)
instance ResponseConsumer CreateGroup CreateGroupResponse where
type ResponseMetadata CreateGroupResponse = IamMetadata
responseConsumer _ _
= iamResponseConsumer $
fmap CreateGroupResponse . parseGroup
instance Transaction CreateGroup CreateGroupResponse
instance AsMemoryResponse CreateGroupResponse where
type MemoryResponse CreateGroupResponse = CreateGroupResponse
loadToMemory = return
================================================
FILE: Aws/Iam/Commands/CreateUser.hs
================================================
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE TypeFamilies #-}
module Aws.Iam.Commands.CreateUser
( CreateUser(..)
, CreateUserResponse(..)
, User(..)
) where
import Aws.Core
import Aws.Iam.Core
import Aws.Iam.Internal
import Control.Applicative
import Data.Text (Text)
import Data.Typeable
import Prelude
-- | Creates a new user.
--
-- <http://docs.aws.amazon.com/IAM/latest/APIReference/API_CreateUser.html>
data CreateUser
= CreateUser {
cuUserName :: Text
-- ^ Name of the new user
, cuPath :: Maybe Text
-- ^ Path under which the user will be created. Defaults to @/@ if
-- omitted.
}
deriving (Eq, Ord, Show, Typeable)
instance SignQuery CreateUser where
type ServiceConfiguration CreateUser = IamConfiguration
signQuery CreateUser{..}
= iamAction' "CreateUser" [
Just ("UserName", cuUserName)
, ("Path",) <$> cuPath
]
data CreateUserResponse = CreateUserResponse User
deriving (Eq, Ord, Show, Typeable)
instance ResponseConsumer CreateUser CreateUserResponse where
type ResponseMetadata CreateUserResponse = IamMetadata
responseConsumer _ _
= iamResponseConsumer $
fmap CreateUserResponse . parseUser
instance Transaction CreateUser CreateUserResponse
instance AsMemoryResponse CreateUserResponse where
type MemoryResponse CreateUserResponse = CreateUserResponse
loadToMemory = return
================================================
FILE: Aws/Iam/Commands/DeleteAccessKey.hs
================================================
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE TypeFamilies #-}
module Aws.Iam.Commands.DeleteAccessKey
( DeleteAccessKey(..)
, DeleteAccessKeyResponse(..)
) where
import Aws.Core
import Aws.Iam.Core
import Aws.Iam.Internal
import Control.Applicative
import Data.Text (Text)
import Data.Typeable
import Prelude
-- | Deletes the access key associated with the specified user.
--
-- <http://docs.aws.amazon.com/IAM/latest/APIReference/API_DeleteAccessKey.html>
data DeleteAccessKey
= DeleteAccessKey {
dakAccessKeyId :: Text
-- ^ ID of the access key to be deleted.
, dakUserName :: Maybe Text
-- ^ User name with which the access key is associated.
}
deriving (Eq, Ord, Show, Typeable)
instance SignQuery DeleteAccessKey where
type ServiceConfiguration DeleteAccessKey = IamConfiguration
signQuery DeleteAccessKey{..}
= iamAction' "DeleteAccessKey" [
Just ("AccessKeyId", dakAccessKeyId)
, ("UserName",) <$> dakUserName
]
data DeleteAccessKeyResponse = DeleteAccessKeyResponse
deriving (Eq, Ord, Show, Typeable)
instance ResponseConsumer DeleteAccessKey DeleteAccessKeyResponse where
type ResponseMetadata DeleteAccessKeyResponse = IamMetadata
responseConsumer _ _
= iamResponseConsumer (const $ return DeleteAccessKeyResponse)
instance Transaction DeleteAccessKey DeleteAccessKeyResponse
instance AsMemoryResponse DeleteAccessKeyResponse where
type MemoryResponse DeleteAccessKeyResponse = DeleteAccessKeyResponse
loadToMemory = return
================================================
FILE: Aws/Iam/Commands/DeleteGroup.hs
================================================
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE TypeFamilies #-}
module Aws.Iam.Commands.DeleteGroup
( DeleteGroup(..)
, DeleteGroupResponse(..)
) where
import Aws.Core
import Aws.Iam.Core
import Aws.Iam.Internal
import Data.Text (Text)
import Data.Typeable
-- | Deletes the specified group.
--
-- <http://docs.aws.amazon.com/IAM/latest/APIReference/API_DeleteGroup.html>
data DeleteGroup = DeleteGroup Text
deriving (Eq, Ord, Show, Typeable)
instance SignQuery DeleteGroup where
type ServiceConfiguration DeleteGroup = IamConfiguration
signQuery (DeleteGroup groupName)
= iamAction "DeleteGroup" [("GroupName", groupName)]
data DeleteGroupResponse = DeleteGroupResponse
deriving (Eq, Ord, Show, Typeable)
instance ResponseConsumer DeleteGroup DeleteGroupResponse where
type ResponseMetadata DeleteGroupResponse = IamMetadata
responseConsumer _ _
= iamResponseConsumer (const $ return DeleteGroupResponse)
instance Transaction DeleteGroup DeleteGroupResponse
instance AsMemoryResponse DeleteGroupResponse where
type MemoryResponse DeleteGroupResponse = DeleteGroupResponse
loadToMemory = return
================================================
FILE: Aws/Iam/Commands/DeleteGroupPolicy.hs
================================================
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE TypeFamilies #-}
module Aws.Iam.Commands.DeleteGroupPolicy
( DeleteGroupPolicy(..)
, DeleteGroupPolicyResponse(..)
) where
import Aws.Core
import Aws.Iam.Core
import Aws.Iam.Internal
import Data.Text (Text)
import Data.Typeable
-- | Deletes the specified policy associated with the specified group.
--
-- <http://docs.aws.amazon.com/IAM/latest/APIReference/API_DeleteGroupPolicy.html>
data DeleteGroupPolicy
= DeleteGroupPolicy {
dgpPolicyName :: Text
-- ^ Name of the policy to be deleted.
, dgpGroupName :: Text
-- ^ Name of the group with whom the policy is associated.
}
deriving (Eq, Ord, Show, Typeable)
instance SignQuery DeleteGroupPolicy where
type ServiceConfiguration DeleteGroupPolicy = IamConfiguration
signQuery DeleteGroupPolicy{..}
= iamAction "DeleteGroupPolicy" [
("PolicyName", dgpPolicyName)
, ("GroupName", dgpGroupName)
]
data DeleteGroupPolicyResponse = DeleteGroupPolicyResponse
deriving (Eq, Ord, Show, Typeable)
instance ResponseConsumer DeleteGroupPolicy DeleteGroupPolicyResponse where
type ResponseMetadata DeleteGroupPolicyResponse = IamMetadata
responseConsumer _ _ =
iamResponseConsumer (const $ return DeleteGroupPolicyResponse)
instance Transaction DeleteGroupPolicy DeleteGroupPolicyResponse
instance AsMemoryResponse DeleteGroupPolicyResponse where
type MemoryResponse DeleteGroupPolicyResponse = DeleteGroupPolicyResponse
loadToMemory = return
================================================
FILE: Aws/Iam/Commands/DeleteUser.hs
================================================
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE TypeFamilies #-}
module Aws.Iam.Commands.DeleteUser
( DeleteUser(..)
, DeleteUserResponse(..)
) where
import Aws.Core
import Aws.Iam.Core
import Aws.Iam.Internal
import Data.Text (Text)
import Data.Typeable
-- | Deletes the specified user.
--
-- <http://docs.aws.amazon.com/IAM/latest/APIReference/API_DeleteUser.html>
data DeleteUser = DeleteUser Text
deriving (Eq, Ord, Show, Typeable)
instance SignQuery DeleteUser where
type ServiceConfiguration DeleteUser = IamConfiguration
signQuery (DeleteUser userName)
= iamAction "DeleteUser" [("UserName", userName)]
data DeleteUserResponse = DeleteUserResponse
deriving (Eq, Ord, Show, Typeable)
instance ResponseConsumer DeleteUser DeleteUserResponse where
type ResponseMetadata DeleteUserResponse = IamMetadata
responseConsumer _ _
= iamResponseConsumer (const $ return DeleteUserResponse)
instance Transaction DeleteUser DeleteUserResponse
instance AsMemoryResponse DeleteUserResponse where
type MemoryResponse DeleteUserResponse = DeleteUserResponse
loadToMemory = return
================================================
FILE: Aws/Iam/Commands/DeleteUserPolicy.hs
================================================
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE TypeFamilies #-}
module Aws.Iam.Commands.DeleteUserPolicy
( DeleteUserPolicy(..)
, DeleteUserPolicyResponse(..)
) where
import Aws.Core
import Aws.Iam.Core
import Aws.Iam.Internal
import Data.Text (Text)
import Data.Typeable
-- | Deletes the specified policy associated with the specified user.
--
-- <http://docs.aws.amazon.com/IAM/latest/APIReference/API_DeleteUserPolicy.html>
data DeleteUserPolicy
= DeleteUserPolicy {
dupPolicyName :: Text
-- ^ Name of the policy to be deleted.
, dupUserName :: Text
-- ^ Name of the user with whom the policy is associated.
}
deriving (Eq, Ord, Show, Typeable)
instance SignQuery DeleteUserPolicy where
type ServiceConfiguration DeleteUserPolicy = IamConfiguration
signQuery DeleteUserPolicy{..}
= iamAction "DeleteUserPolicy" [
("PolicyName", dupPolicyName)
, ("UserName", dupUserName)
]
data DeleteUserPolicyResponse = DeleteUserPolicyResponse
deriving (Eq, Ord, Show, Typeable)
instance ResponseConsumer DeleteUserPolicy DeleteUserPolicyResponse where
type ResponseMetadata DeleteUserPolicyResponse = IamMetadata
responseConsumer _ _ =
iamResponseConsumer (const $ return DeleteUserPolicyResponse)
instance Transaction DeleteUserPolicy DeleteUserPolicyResponse
instance AsMemoryResponse DeleteUserPolicyResponse where
type MemoryResponse DeleteUserPolicyResponse = DeleteUserPolicyResponse
loadToMemory = return
================================================
FILE: Aws/Iam/Commands/GetGroup.hs
================================================
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE TypeFamilies #-}
module Aws.Iam.Commands.GetUser
( GetUser(..)
, GetUserResponse(..)
, User(..)
) where
import Aws.Core
import Aws.Iam.Core
import Aws.Iam.Internal
import Control.Applicative
import Data.Text (Text)
import Data.Typeable
import Prelude
-- | Retrieves information about the given user.
--
-- If a user name is not given, IAM determines the user name based on the
-- access key signing the request.
--
-- <http://docs.aws.amazon.com/IAM/latest/APIReference/API_GetUser.html>
data GetUser = GetUser (Maybe Text)
deriving (Eq, Ord, Show, Typeable)
instance SignQuery GetUser where
type ServiceConfiguration GetUser = IamConfiguration
signQuery (GetUser user)
= iamAction' "GetUser" [("UserName",) <$> user]
data GetUserResponse = GetUserResponse User
deriving (Eq, Ord, Show, Typeable)
instance ResponseConsumer GetUser GetUserResponse where
type ResponseMetadata GetUserResponse = IamMetadata
responseConsumer _ _ = iamResponseConsumer $
fmap GetUserResponse . parseUser
instance Transaction GetUser GetUserResponse
instance AsMemoryResponse GetUserResponse where
type MemoryResponse GetUserResponse = GetUserResponse
loadToMemory = return
================================================
FILE: Aws/Iam/Commands/GetGroupPolicy.hs
================================================
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE TypeFamilies #-}
module Aws.Iam.Commands.GetGroupPolicy
( GetGroupPolicy(..)
, GetGroupPolicyResponse(..)
) where
import Aws.Core
import Aws.Iam.Core
import Aws.Iam.Internal
import Control.Applicative
import Data.Text (Text)
import qualified Data.Text as Text
import qualified Data.Text.Encoding as Text
import Data.Typeable
import qualified Network.HTTP.Types as HTTP
import Text.XML.Cursor (($//))
import Prelude
-- | Retrieves the specified policy document for the specified group.
--
-- <http://docs.aws.amazon.com/IAM/latest/APIReference/API_GetGroupPolicy.html>
data GetGroupPolicy
= GetGroupPolicy {
ggpPolicyName :: Text
-- ^ Name of the policy.
, ggpGroupName :: Text
-- ^ Name of the group with whom the policy is associated.
}
deriving (Eq, Ord, Show, Typeable)
instance SignQuery GetGroupPolicy where
type ServiceConfiguration GetGroupPolicy = IamConfiguration
signQuery GetGroupPolicy{..}
= iamAction "GetGroupPolicy" [
("PolicyName", ggpPolicyName)
, ("GroupName", ggpGroupName)
]
data GetGroupPolicyResponse
= GetGroupPolicyResponse {
ggprPolicyDocument :: Text
-- ^ The policy document.
, ggprPolicyName :: Text
-- ^ Name of the policy.
, ggprGroupName :: Text
-- ^ Name of the group with whom the policy is associated.
}
deriving (Eq, Ord, Show, Typeable)
instance ResponseConsumer GetGroupPolicy GetGroupPolicyResponse where
type ResponseMetadata GetGroupPolicyResponse = IamMetadata
responseConsumer _ _
= iamResponseConsumer $ \cursor -> do
let attr name = force ("Missing " ++ Text.unpack name) $
cursor $// elContent name
ggprPolicyDocument <- decodePolicy <$>
attr "PolicyDocument"
ggprPolicyName <- attr "PolicyName"
ggprGroupName <- attr "GroupName"
return GetGroupPolicyResponse{..}
where
decodePolicy = Text.decodeUtf8 . HTTP.urlDecode False
. Text.encodeUtf8
instance Transaction GetGroupPolicy GetGroupPolicyResponse
instance AsMemoryResponse GetGroupPolicyResponse where
type MemoryResponse GetGroupPolicyResponse = GetGroupPolicyResponse
loadToMemory = return
================================================
FILE: Aws/Iam/Commands/GetUser.hs
================================================
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE TypeFamilies #-}
module Aws.Iam.Commands.GetUser
( GetUser(..)
, GetUserResponse(..)
, User(..)
) where
import Aws.Core
import Aws.Iam.Core
import Aws.Iam.Internal
import Control.Applicative
import Data.Text (Text)
import Data.Typeable
import Prelude
-- | Retrieves information about the given user.
--
-- If a user name is not given, IAM determines the user name based on the
-- access key signing the request.
--
-- <http://docs.aws.amazon.com/IAM/latest/APIReference/API_GetUser.html>
data GetUser = GetUser (Maybe Text)
deriving (Eq, Ord, Show, Typeable)
instance SignQuery GetUser where
type ServiceConfiguration GetUser = IamConfiguration
signQuery (GetUser user)
= iamAction' "GetUser" [("UserName",) <$> user]
data GetUserResponse = GetUserResponse User
deriving (Eq, Ord, Show, Typeable)
instance ResponseConsumer GetUser GetUserResponse where
type ResponseMetadata GetUserResponse = IamMetadata
responseConsumer _ _ = iamResponseConsumer $
fmap GetUserResponse . parseUser
instance Transaction GetUser GetUserResponse
instance AsMemoryResponse GetUserResponse where
type MemoryResponse GetUserResponse = GetUserResponse
loadToMemory = return
================================================
FILE: Aws/Iam/Commands/GetUserPolicy.hs
================================================
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE TypeFamilies #-}
module Aws.Iam.Commands.GetUserPolicy
( GetUserPolicy(..)
, GetUserPolicyResponse(..)
) where
import Aws.Core
import Aws.Iam.Core
import Aws.Iam.Internal
import Control.Applicative
import Data.Text (Text)
import qualified Data.Text as Text
import qualified Data.Text.Encoding as Text
import Data.Typeable
import qualified Network.HTTP.Types as HTTP
import Text.XML.Cursor (($//))
import Prelude
-- | Retrieves the specified policy document for the specified user.
--
-- <http://docs.aws.amazon.com/IAM/latest/APIReference/API_GetUserPolicy.html>
data GetUserPolicy
= GetUserPolicy {
gupPolicyName :: Text
-- ^ Name of the policy.
, gupUserName :: Text
-- ^ Name of the user with whom the policy is associated.
}
deriving (Eq, Ord, Show, Typeable)
instance SignQuery GetUserPolicy where
type ServiceConfiguration GetUserPolicy = IamConfiguration
signQuery GetUserPolicy{..}
= iamAction "GetUserPolicy" [
("PolicyName", gupPolicyName)
, ("UserName", gupUserName)
]
data GetUserPolicyResponse
= GetUserPolicyResponse {
guprPolicyDocument :: Text
-- ^ The policy document.
, guprPolicyName :: Text
-- ^ Name of the policy.
, guprUserName :: Text
-- ^ Name of the user with whom the policy is associated.
}
deriving (Eq, Ord, Show, Typeable)
instance ResponseConsumer GetUserPolicy GetUserPolicyResponse where
type ResponseMetadata GetUserPolicyResponse = IamMetadata
responseConsumer _ _
= iamResponseConsumer $ \cursor -> do
let attr name = force ("Missing " ++ Text.unpack name) $
cursor $// elContent name
guprPolicyDocument <- decodePolicy <$>
attr "PolicyDocument"
guprPolicyName <- attr "PolicyName"
guprUserName <- attr "UserName"
return GetUserPolicyResponse{..}
where
decodePolicy = Text.decodeUtf8 . HTTP.urlDecode False
. Text.encodeUtf8
instance Transaction GetUserPolicy GetUserPolicyResponse
instance AsMemoryResponse GetUserPolicyResponse where
type MemoryResponse GetUserPolicyResponse = GetUserPolicyResponse
loadToMemory = return
================================================
FILE: Aws/Iam/Commands/ListAccessKeys.hs
================================================
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE TypeFamilies #-}
module Aws.Iam.Commands.ListAccessKeys
( ListAccessKeys(..)
, ListAccessKeysResponse(..)
) where
import Aws.Core
import Aws.Iam.Core
import Aws.Iam.Internal
import Control.Applicative
import Data.Text (Text)
import Data.Time
import Data.Typeable
import Prelude
import Text.XML.Cursor (laxElement, ($/), ($//), (&|))
-- | Returns the access keys associated with the specified user.
--
-- <http://docs.aws.amazon.com/IAM/latest/APIReference/API_ListAccessKeys.html>
data ListAccessKeys
= ListAccessKeys {
lakUserName :: Maybe Text
-- ^ Name of the user. If the user name is not specified, IAM will
-- determine the user based on the key sigining the request.
, lakMarker :: Maybe Text
-- ^ Used for paginating requests. Marks the position of the last
-- request.
, lakMaxItems :: Maybe Integer
-- ^ Used for paginating requests. Specifies the maximum number of items
-- to return in the response. Defaults to 100.
}
deriving (Eq, Ord, Show, Typeable)
instance SignQuery ListAccessKeys where
type ServiceConfiguration ListAccessKeys = IamConfiguration
signQuery ListAccessKeys{..}
= iamAction' "ListAccessKeys" $ [
("UserName",) <$> lakUserName
] <> markedIter lakMarker lakMaxItems
-- | Represents the IAM @AccessKeyMetadata@ data type.
--
-- <http://docs.aws.amazon.com/IAM/latest/APIReference/API_AccessKeyMetadata.html>
data AccessKeyMetadata
= AccessKeyMetadata {
akmAccessKeyId :: Maybe Text
-- ^ ID of the access key.
, akmCreateDate :: Maybe UTCTime
-- ^ Date and time at which the access key was created.
, akmStatus :: Maybe Text
-- ^ Whether the access key is active.
, akmUserName :: Maybe Text
-- ^ Name of the user with whom the access key is associated.
}
deriving (Eq, Ord, Show, Typeable)
data ListAccessKeysResponse
= ListAccessKeysResponse {
lakrAccessKeyMetadata :: [AccessKeyMetadata]
-- ^ List of 'AccessKeyMetadata' objects
, lakrIsTruncated :: Bool
-- ^ @True@ if the request was truncated because of too many items.
, lakrMarker :: Maybe Text
-- ^ Marks the position at which the request was truncated. This value
-- must be passed with the next request to continue listing from the
-- last position.
}
deriving (Eq, Ord, Show, Typeable)
instance ResponseConsumer ListAccessKeys ListAccessKeysResponse where
type ResponseMetadata ListAccessKeysResponse = IamMetadata
responseConsumer _ _
= iamResponseConsumer $ \cursor -> do
(lakrIsTruncated, lakrMarker) <- markedIterResponse cursor
lakrAccessKeyMetadata <- sequence $
cursor $// laxElement "member" &| buildAKM
return ListAccessKeysResponse{..}
where
buildAKM m = do
let mattr name = mhead $ m $/ elContent name
let akmAccessKeyId = mattr "AccessKeyId"
akmStatus = mattr "Status"
akmUserName = mattr "UserName"
akmCreateDate <- case m $/ elCont "CreateDate" of
(x:_) -> Just <$> parseDateTime x
_ -> return Nothing
return AccessKeyMetadata{..}
mhead (x:_) = Just x
mhead _ = Nothing
instance Transaction ListAccessKeys ListAccessKeysResponse
instance IteratedTransaction ListAccessKeys ListAccessKeysResponse where
nextIteratedRequest request response
= case lakrMarker response of
Nothing -> Nothing
Just marker -> Just $ request { lakMarker = Just marker }
instance AsMemoryResponse ListAccessKeysResponse where
type MemoryResponse ListAccessKeysResponse = ListAccessKeysResponse
loadToMemory = return
================================================
FILE: Aws/Iam/Commands/ListGroupPolicies.hs
================================================
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE TypeFamilies #-}
module Aws.Iam.Commands.ListGroupPolicies
( ListGroupPolicies(..)
, ListGroupPoliciesResponse(..)
) where
import Aws.Core
import Aws.Iam.Core
import Aws.Iam.Internal
import Data.Text (Text)
import Data.Typeable
import Text.XML.Cursor (content, laxElement, ($//), (&/))
-- | Lists the group policies associated with the specified group.
--
-- <http://docs.aws.amazon.com/IAM/latest/APIReference/API_ListGroupPolicies.html>
data ListGroupPolicies
= ListGroupPolicies {
lgpGroupName :: Text
-- ^ Policies associated with this group will be listed.
, lgpMarker :: Maybe Text
-- ^ Used for paginating requests. Marks the position of the last
-- request.
, lgpMaxItems :: Maybe Integer
-- ^ Used for paginating requests. Specifies the maximum number of items
-- to return in the response. Defaults to 100.
}
deriving (Eq, Ord, Show, Typeable)
instance SignQuery ListGroupPolicies where
type ServiceConfiguration ListGroupPolicies = IamConfiguration
signQuery ListGroupPolicies{..}
= iamAction' "ListGroupPolicies" $ [
Just ("GroupName", lgpGroupName)
] <> markedIter lgpMarker lgpMaxItems
data ListGroupPoliciesResponse
= ListGroupPoliciesResponse {
lgprPolicyNames :: [Text]
-- ^ List of policy names.
, lgprIsTruncated :: Bool
-- ^ @True@ if the request was truncated because of too many items.
, lgprMarker :: Maybe Text
-- ^ Marks the position at which the request was truncated. This value
-- must be passed with the next request to continue listing from the
-- last position.
}
deriving (Eq, Ord, Show, Typeable)
instance ResponseConsumer ListGroupPolicies ListGroupPoliciesResponse where
type ResponseMetadata ListGroupPoliciesResponse = IamMetadata
responseConsumer _ _
= iamResponseConsumer $ \cursor -> do
(lgprIsTruncated, lgprMarker) <- markedIterResponse cursor
let lgprPolicyNames = cursor $// laxElement "member" &/ content
return ListGroupPoliciesResponse{..}
instance Transaction ListGroupPolicies ListGroupPoliciesResponse
instance IteratedTransaction ListGroupPolicies ListGroupPoliciesResponse where
nextIteratedRequest request response
= case lgprMarker response of
Nothing -> Nothing
Just marker -> Just $ request { lgpMarker = Just marker }
instance AsMemoryResponse ListGroupPoliciesResponse where
type MemoryResponse ListGroupPoliciesResponse = ListGroupPoliciesResponse
loadToMemory = return
================================================
FILE: Aws/Iam/Commands/ListGroups.hs
================================================
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE TypeFamilies #-}
module Aws.Iam.Commands.ListGroups
( ListGroups(..)
, ListGroupsResponse(..)
, Group(..)
) where
import Aws.Core
import Aws.Iam.Core
import Aws.Iam.Internal
import Control.Applicative
import Data.Text (Text)
import Data.Typeable
import Prelude
import Text.XML.Cursor (laxElement, ($//), (&|))
-- | Lists groups that have the specified path prefix.
--
-- <http://docs.aws.amazon.com/IAM/latest/APIReference/API_ListGroups.html>
data ListGroups
= ListGroups {
lgPathPrefix :: Maybe Text
-- ^ Groups defined under this path will be listed. If omitted, defaults
-- to @/@, which lists all groups.
, lgMarker :: Maybe Text
-- ^ Used for paginating requests. Marks the position of the last
-- request.
, lgMaxItems :: Maybe Integer
-- ^ Used for paginating requests. Specifies the maximum number of items
-- to return in the response. Defaults to 100.
}
deriving (Eq, Ord, Show, Typeable)
instance SignQuery ListGroups where
type ServiceConfiguration ListGroups = IamConfiguration
signQuery ListGroups{..}
= iamAction' "ListGroups" $ [
("PathPrefix",) <$> lgPathPrefix
] <> markedIter lgMarker lgMaxItems
data ListGroupsResponse
= ListGroupsResponse {
lgrGroups :: [Group]
-- ^ List of 'Group's.
, lgrIsTruncated :: Bool
-- ^ @True@ if the request was truncated because of too many items.
, lgrMarker :: Maybe Text
-- ^ Marks the position at which the request was truncated. This value
-- must be passed with the next request to continue listing from the
-- last position.
}
deriving (Eq, Ord, Show, Typeable)
instance ResponseConsumer ListGroups ListGroupsResponse where
type ResponseMetadata ListGroupsResponse = IamMetadata
responseConsumer _ _
= iamResponseConsumer $ \cursor -> do
(lgrIsTruncated, lgrMarker) <- markedIterResponse cursor
lgrGroups <- sequence $
cursor $// laxElement "member" &| parseGroup
return ListGroupsResponse{..}
instance Transaction ListGroups ListGroupsResponse
instance IteratedTransaction ListGroups ListGroupsResponse where
nextIteratedRequest request response
= case lgrMarker response of
Nothing -> Nothing
Just marker -> Just $ request { lgMarker = Just marker }
instance AsMemoryResponse ListGroupsResponse where
type MemoryResponse ListGroupsResponse = ListGroupsResponse
loadToMemory = return
================================================
FILE: Aws/Iam/Commands/ListMfaDevices.hs
================================================
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE RecordWildCards #-}
module Aws.Iam.Commands.ListMfaDevices
( ListMfaDevices(..)
, ListMfaDevicesResponse(..)
) where
import Aws.Core
import Aws.Iam.Core
import Aws.Iam.Internal
import Control.Applicative
import Data.Text (Text)
import Data.Typeable
import Prelude
import Text.XML.Cursor (laxElement, ($//), (&|))
-- | Lists the MFA devices. If the request includes the user name,
-- then this action lists all the MFA devices associated with the
-- specified user name. If you do not specify a user name, IAM
-- determines the user name implicitly based on the AWS access key ID
-- signing the request.
--
-- <https://docs.aws.amazon.com/IAM/latest/APIReference/API_ListMFADevices.html>
data ListMfaDevices = ListMfaDevices
{ lmfaUserName :: Maybe Text
-- ^ The name of the user whose MFA devices
-- you want to list. If you do not specify a
-- user name, IAM determines the user name
-- implicitly based on the AWS access key ID
-- signing the request
, lmfaMarker :: Maybe Text
-- ^ Used for paginating requests. Marks the
-- position of the last request.
, lmfaMaxItems :: Maybe Integer
-- ^ Used for paginating requests. Specifies
-- the maximum number of items to return in
-- the response. Defaults to 100.
} deriving (Eq, Ord, Show, Typeable)
instance SignQuery ListMfaDevices where
type ServiceConfiguration ListMfaDevices = IamConfiguration
signQuery ListMfaDevices{..} = iamAction' "ListMFADevices"
([ ("UserName",) <$> lmfaUserName ]
<> markedIter lmfaMarker lmfaMaxItems)
data ListMfaDevicesResponse = ListMfaDevicesResponse
{ lmfarMfaDevices :: [MfaDevice]
-- ^ List of 'MFA Device's.
, lmfarIsTruncated :: Bool
-- ^ @True@ if the request was
-- truncated because of too many
-- items.
, lmfarMarker :: Maybe Text
-- ^ Marks the position at which the
-- request was truncated. This value
-- must be passed with the next
-- request to continue listing from
-- the last position.
} deriving (Eq, Ord, Show, Typeable)
instance ResponseConsumer ListMfaDevices ListMfaDevicesResponse where
type ResponseMetadata ListMfaDevicesResponse = IamMetadata
responseConsumer _ _req =
iamResponseConsumer $ \ cursor -> do
(lmfarIsTruncated, lmfarMarker) <- markedIterResponse cursor
lmfarMfaDevices <-
sequence $ cursor $// laxElement "member" &| parseMfaDevice
return ListMfaDevicesResponse{..}
instance Transaction ListMfaDevices ListMfaDevicesResponse
instance IteratedTransaction ListMfaDevices ListMfaDevicesResponse where
nextIteratedRequest request response
= case lmfarMarker response of
Nothing -> Nothing
Just marker -> Just $ request { lmfaMarker = Just marker }
instance AsMemoryResponse ListMfaDevicesResponse where
type MemoryResponse ListMfaDevicesResponse = ListMfaDevicesResponse
loadToMemory = return
================================================
FILE: Aws/Iam/Commands/ListUserPolicies.hs
================================================
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE TypeFamilies #-}
module Aws.Iam.Commands.ListUserPolicies
( ListUserPolicies(..)
, ListUserPoliciesResponse(..)
) where
import Aws.Core
import Aws.Iam.Core
import Aws.Iam.Internal
import Data.Text (Text)
import Data.Typeable
import Text.XML.Cursor (content, laxElement, ($//), (&/))
-- | Lists the user policies associated with the specified user.
--
-- <http://docs.aws.amazon.com/IAM/latest/APIReference/API_ListUserPolicies.html>
data ListUserPolicies
= ListUserPolicies {
lupUserName :: Text
-- ^ Policies associated with this user will be listed.
, lupMarker :: Maybe Text
-- ^ Used for paginating requests. Marks the position of the last
-- request.
, lupMaxItems :: Maybe Integer
-- ^ Used for paginating requests. Specifies the maximum number of items
-- to return in the response. Defaults to 100.
}
deriving (Eq, Ord, Show, Typeable)
instance SignQuery ListUserPolicies where
type ServiceConfiguration ListUserPolicies = IamConfiguration
signQuery ListUserPolicies{..}
= iamAction' "ListUserPolicies" $ [
Just ("UserName", lupUserName)
] <> markedIter lupMarker lupMaxItems
data ListUserPoliciesResponse
= ListUserPoliciesResponse {
luprPolicyNames :: [Text]
-- ^ List of policy names.
, luprIsTruncated :: Bool
-- ^ @True@ if the request was truncated because of too many items.
, luprMarker :: Maybe Text
-- ^ Marks the position at which the request was truncated. This value
-- must be passed with the next request to continue listing from the
-- last position.
}
deriving (Eq, Ord, Show, Typeable)
instance ResponseConsumer ListUserPolicies ListUserPoliciesResponse where
type ResponseMetadata ListUserPoliciesResponse = IamMetadata
responseConsumer _ _
= iamResponseConsumer $ \cursor -> do
(luprIsTruncated, luprMarker) <- markedIterResponse cursor
let luprPolicyNames = cursor $// laxElement "member" &/ content
return ListUserPoliciesResponse{..}
instance Transaction ListUserPolicies ListUserPoliciesResponse
instance IteratedTransaction ListUserPolicies ListUserPoliciesResponse where
nextIteratedRequest request response
= case luprMarker response of
Nothing -> Nothing
Just marker -> Just $ request { lupMarker = Just marker }
instance AsMemoryResponse ListUserPoliciesResponse where
type MemoryResponse ListUserPoliciesResponse = ListUserPoliciesResponse
loadToMemory = return
================================================
FILE: Aws/Iam/Commands/ListUsers.hs
================================================
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE TypeFamilies #-}
module Aws.Iam.Commands.ListUsers
( ListUsers(..)
, ListUsersResponse(..)
, User(..)
) where
import Aws.Core
import Aws.Iam.Core
import Aws.Iam.Internal
import Control.Applicative
import Data.Text (Text)
import Data.Typeable
import Prelude
import Text.XML.Cursor (laxElement, ($//), (&|))
-- | Lists users that have the specified path prefix.
--
-- <http://docs.aws.amazon.com/IAM/latest/APIReference/API_ListUsers.html>
data ListUsers
= ListUsers {
luPathPrefix :: Maybe Text
-- ^ Users defined under this path will be listed. If omitted, defaults
-- to @/@, which lists all users.
, luMarker :: Maybe Text
-- ^ Used for paginating requests. Marks the position of the last
-- request.
, luMaxItems :: Maybe Integer
-- ^ Used for paginating requests. Specifies the maximum number of items
-- to return in the response. Defaults to 100.
}
deriving (Eq, Ord, Show, Typeable)
instance SignQuery ListUsers where
type ServiceConfiguration ListUsers = IamConfiguration
signQuery ListUsers{..}
= iamAction' "ListUsers" $ [
("PathPrefix",) <$> luPathPrefix
] <> markedIter luMarker luMaxItems
data ListUsersResponse
= ListUsersResponse {
lurUsers :: [User]
-- ^ List of 'User's.
, lurIsTruncated :: Bool
-- ^ @True@ if the request was truncated because of too many items.
, lurMarker :: Maybe Text
-- ^ Marks the position at which the request was truncated. This value
-- must be passed with the next request to continue listing from the
-- last position.
}
deriving (Eq, Ord, Show, Typeable)
instance ResponseConsumer ListUsers ListUsersResponse where
type ResponseMetadata ListUsersResponse = IamMetadata
responseConsumer _ _
= iamResponseConsumer $ \cursor -> do
(lurIsTruncated, lurMarker) <- markedIterResponse cursor
lurUsers <- sequence $
cursor $// laxElement "member" &| parseUser
return ListUsersResponse{..}
instance Transaction ListUsers ListUsersResponse
instance IteratedTransaction ListUsers ListUsersResponse where
nextIteratedRequest request response
= case lurMarker response of
Nothing -> Nothing
Just marker -> Just $ request { luMarker = Just marker }
instance AsMemoryResponse ListUsersResponse where
type MemoryResponse ListUsersResponse = ListUsersResponse
loadToMemory = return
================================================
FILE: Aws/Iam/Commands/PutGroupPolicy.hs
================================================
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE TypeFamilies #-}
module Aws.Iam.Commands.PutGroupPolicy
( PutGroupPolicy(..)
, PutGroupPolicyResponse(..)
) where
import Aws.Core
import Aws.Iam.Core
import Aws.Iam.Internal
import Data.Text (Text)
import Data.Typeable
-- | Adds a policy document with the specified name, associated with the
-- specified group.
--
-- <http://docs.aws.amazon.com/IAM/latest/APIReference/API_PutGroupPolicy.html>
data PutGroupPolicy
= PutGroupPolicy {
pgpPolicyDocument :: Text
-- ^ The policy document.
, pgpPolicyName :: Text
-- ^ Name of the policy.
, pgpGroupName :: Text
-- ^ Name of the group with whom this policy is associated.
}
deriving (Eq, Ord, Show, Typeable)
instance SignQuery PutGroupPolicy where
type ServiceConfiguration PutGroupPolicy = IamConfiguration
signQuery PutGroupPolicy{..}
= iamAction "PutGroupPolicy" [
("PolicyDocument", pgpPolicyDocument)
, ("PolicyName" , pgpPolicyName)
, ("GroupName" , pgpGroupName)
]
data PutGroupPolicyResponse = PutGroupPolicyResponse
deriving (Eq, Ord, Show, Typeable)
instance ResponseConsumer PutGroupPolicy PutGroupPolicyResponse where
type ResponseMetadata PutGroupPolicyResponse = IamMetadata
responseConsumer _ _
= iamResponseConsumer (const $ return PutGroupPolicyResponse)
instance Transaction PutGroupPo
gitextract_7y2rbhgn/
├── .ghci
├── .gitignore
├── .travis.yml
├── Aws/
│ ├── Aws.hs
│ ├── Core.hs
│ ├── DynamoDb/
│ │ ├── Commands/
│ │ │ ├── BatchGetItem.hs
│ │ │ ├── BatchWriteItem.hs
│ │ │ ├── DeleteItem.hs
│ │ │ ├── GetItem.hs
│ │ │ ├── PutItem.hs
│ │ │ ├── Query.hs
│ │ │ ├── Scan.hs
│ │ │ ├── Table.hs
│ │ │ └── UpdateItem.hs
│ │ ├── Commands.hs
│ │ └── Core.hs
│ ├── DynamoDb.hs
│ ├── Ec2/
│ │ └── InstanceMetadata.hs
│ ├── Iam/
│ │ ├── Commands/
│ │ │ ├── AddUserToGroup.hs
│ │ │ ├── CreateAccessKey.hs
│ │ │ ├── CreateGroup.hs
│ │ │ ├── CreateUser.hs
│ │ │ ├── DeleteAccessKey.hs
│ │ │ ├── DeleteGroup.hs
│ │ │ ├── DeleteGroupPolicy.hs
│ │ │ ├── DeleteUser.hs
│ │ │ ├── DeleteUserPolicy.hs
│ │ │ ├── GetGroup.hs
│ │ │ ├── GetGroupPolicy.hs
│ │ │ ├── GetUser.hs
│ │ │ ├── GetUserPolicy.hs
│ │ │ ├── ListAccessKeys.hs
│ │ │ ├── ListGroupPolicies.hs
│ │ │ ├── ListGroups.hs
│ │ │ ├── ListMfaDevices.hs
│ │ │ ├── ListUserPolicies.hs
│ │ │ ├── ListUsers.hs
│ │ │ ├── PutGroupPolicy.hs
│ │ │ ├── PutUserPolicy.hs
│ │ │ ├── RemoveUserFromGroup.hs
│ │ │ ├── UpdateAccessKey.hs
│ │ │ ├── UpdateGroup.hs
│ │ │ └── UpdateUser.hs
│ │ ├── Commands.hs
│ │ ├── Core.hs
│ │ └── Internal.hs
│ ├── Iam.hs
│ ├── Network.hs
│ ├── S3/
│ │ ├── Commands/
│ │ │ ├── CopyObject.hs
│ │ │ ├── DeleteBucket.hs
│ │ │ ├── DeleteObject.hs
│ │ │ ├── DeleteObjectVersion.hs
│ │ │ ├── DeleteObjects.hs
│ │ │ ├── GetBucket.hs
│ │ │ ├── GetBucketLocation.hs
│ │ │ ├── GetBucketObjectVersions.hs
│ │ │ ├── GetBucketVersioning.hs
│ │ │ ├── GetObject.hs
│ │ │ ├── GetService.hs
│ │ │ ├── HeadObject.hs
│ │ │ ├── Multipart.hs
│ │ │ ├── PutBucket.hs
│ │ │ ├── PutBucketVersioning.hs
│ │ │ ├── PutObject.hs
│ │ │ └── RestoreObject.hs
│ │ ├── Commands.hs
│ │ └── Core.hs
│ ├── S3.hs
│ ├── Ses/
│ │ ├── Commands/
│ │ │ ├── DeleteIdentity.hs
│ │ │ ├── GetIdentityDkimAttributes.hs
│ │ │ ├── GetIdentityNotificationAttributes.hs
│ │ │ ├── GetIdentityVerificationAttributes.hs
│ │ │ ├── ListIdentities.hs
│ │ │ ├── SendRawEmail.hs
│ │ │ ├── SetIdentityDkimEnabled.hs
│ │ │ ├── SetIdentityFeedbackForwardingEnabled.hs
│ │ │ ├── SetIdentityNotificationTopic.hs
│ │ │ ├── VerifyDomainDkim.hs
│ │ │ ├── VerifyDomainIdentity.hs
│ │ │ └── VerifyEmailIdentity.hs
│ │ ├── Commands.hs
│ │ └── Core.hs
│ ├── Ses.hs
│ ├── SimpleDb/
│ │ ├── Commands/
│ │ │ ├── Attributes.hs
│ │ │ ├── Domain.hs
│ │ │ └── Select.hs
│ │ ├── Commands.hs
│ │ └── Core.hs
│ ├── SimpleDb.hs
│ ├── Sqs/
│ │ ├── Commands/
│ │ │ ├── Message.hs
│ │ │ ├── Permission.hs
│ │ │ ├── Queue.hs
│ │ │ └── QueueAttributes.hs
│ │ ├── Commands.hs
│ │ └── Core.hs
│ └── Sqs.hs
├── Aws.hs
├── CHANGELOG.md
├── Examples/
│ ├── DynamoDb.hs
│ ├── GetObject.hs
│ ├── GetObjectGoogle.hs
│ ├── GetObjectV4.hs
│ ├── MultipartTransfer.hs
│ ├── MultipartUpload.hs
│ ├── NukeBucket.hs
│ ├── PutBucketNearLine.hs
│ ├── PutObjectIA.hs
│ ├── SimpleDb.hs
│ └── Sqs.hs
├── LICENSE
├── README.md
├── Setup.hs
├── VERSIONING
├── aws.cabal
├── default.nix
├── ghci.hs
├── shell.nix
├── stack.yaml
└── tests/
├── DynamoDb/
│ ├── Main.hs
│ └── Utils.hs
├── S3/
│ └── Main.hs
├── Sqs/
│ └── Main.hs
└── Utils.hs
Condensed preview — 123 files, each showing path, character count, and a content snippet. Download the .json file or copy for the full structured content (578K chars).
[
{
"path": ".ghci",
"chars": 327,
"preview": ":set -XRecordWildCards\n:set -XTypeFamilies\n:set -XMultiParamTypeClasses\n:set -XFlexibleContexts\n:set -XFlexibleInstances"
},
{
"path": ".gitignore",
"chars": 85,
"preview": "*~\ndist/*\n*.swp\n/.cabal-sandbox\n/cabal.sandbox.config\ncloud-remote.pdf\n/.stack-work/\n"
},
{
"path": ".travis.yml",
"chars": 399,
"preview": "sudo: false\naddons:\n apt:\n sources:\n - hvr-ghc\n packages:\n - libgmp-dev\n - ghc-8.0.1\n "
},
{
"path": "Aws/Aws.hs",
"chars": 12873,
"preview": "{-# LANGUAGE CPP #-}\n{-# LANGUAGE FlexibleContexts #-}\n{-# LANGUAGE MultiParamTypeClasses #-}\n{-#"
},
{
"path": "Aws/Core.hs",
"chars": 36578,
"preview": "{-# LANGUAGE CPP #-}\nmodule Aws.Core\n( -- * Logging\n Loggable(..)\n -- * Response\n -- ** Metadata in responses\n, Respo"
},
{
"path": "Aws/DynamoDb/Commands/BatchGetItem.hs",
"chars": 5207,
"preview": "{-# LANGUAGE DeriveDataTypeable #-}\n{-# LANGUAGE FlexibleContexts #-}\n{-# LANGUAGE FlexibleInstances "
},
{
"path": "Aws/DynamoDb/Commands/BatchWriteItem.hs",
"chars": 4911,
"preview": "{-# LANGUAGE DeriveDataTypeable #-}\n{-# LANGUAGE FlexibleContexts #-}\n{-# LANGUAGE FlexibleInstances "
},
{
"path": "Aws/DynamoDb/Commands/DeleteItem.hs",
"chars": 3540,
"preview": "{-# LANGUAGE DeriveDataTypeable #-}\n{-# LANGUAGE FlexibleContexts #-}\n{-# LANGUAGE FlexibleInstances "
},
{
"path": "Aws/DynamoDb/Commands/GetItem.hs",
"chars": 2936,
"preview": "{-# LANGUAGE RecordWildCards #-}\n{-# LANGUAGE TypeFamilies #-}\n------------------------------------------------------"
},
{
"path": "Aws/DynamoDb/Commands/PutItem.hs",
"chars": 3512,
"preview": "{-# LANGUAGE DeriveDataTypeable #-}\n{-# LANGUAGE FlexibleContexts #-}\n{-# LANGUAGE FlexibleInstances "
},
{
"path": "Aws/DynamoDb/Commands/Query.hs",
"chars": 5243,
"preview": "{-# LANGUAGE RecordWildCards #-}\n{-# LANGUAGE TypeFamilies #-}\n------------------------------------------------------"
},
{
"path": "Aws/DynamoDb/Commands/Scan.hs",
"chars": 4300,
"preview": "{-# LANGUAGE RecordWildCards #-}\n{-# LANGUAGE TypeFamilies #-}\n------------------------------------------------------"
},
{
"path": "Aws/DynamoDb/Commands/Table.hs",
"chars": 18888,
"preview": "{-# LANGUAGE DeriveGeneric #-}\n{-# LANGUAGE GeneralizedNewtypeDeriving #-}\n{-# LANGUAGE TypeFamilies "
},
{
"path": "Aws/DynamoDb/Commands/UpdateItem.hs",
"chars": 5397,
"preview": "{-# LANGUAGE DeriveDataTypeable #-}\n{-# LANGUAGE FlexibleContexts #-}\n{-# LANGUAGE FlexibleInstances "
},
{
"path": "Aws/DynamoDb/Commands.hs",
"chars": 1034,
"preview": "module Aws.DynamoDb.Commands\n ( module Aws.DynamoDb.Commands.BatchGetItem\n , module Aws.DynamoDb.Commands.BatchWri"
},
{
"path": "Aws/DynamoDb/Core.hs",
"chars": 43053,
"preview": "{-# LANGUAGE CPP #-}\n{-# LANGUAGE DeriveDataTypeable #-}\n{-# LANGUAGE FlexibleContexts "
},
{
"path": "Aws/DynamoDb.hs",
"chars": 680,
"preview": "-----------------------------------------------------------------------------\n-- |\n-- Module : Aws.DynaboDb\n-- Cop"
},
{
"path": "Aws/Ec2/InstanceMetadata.hs",
"chars": 1528,
"preview": "module Aws.Ec2.InstanceMetadata where\n\nimport Control.Applicative\nimport Control.Exception\nimport "
},
{
"path": "Aws/Iam/Commands/AddUserToGroup.hs",
"chars": 1573,
"preview": "{-# LANGUAGE MultiParamTypeClasses #-}\n{-# LANGUAGE RecordWildCards #-}\n{-# LANGUAGE TypeFamilies #-}\nmod"
},
{
"path": "Aws/Iam/Commands/CreateAccessKey.hs",
"chars": 3281,
"preview": "{-# LANGUAGE MultiParamTypeClasses #-}\n{-# LANGUAGE RecordWildCards #-}\n{-# LANGUAGE TupleSections #-}\n{-#"
},
{
"path": "Aws/Iam/Commands/CreateGroup.hs",
"chars": 1660,
"preview": "{-# LANGUAGE MultiParamTypeClasses #-}\n{-# LANGUAGE RecordWildCards #-}\n{-# LANGUAGE TupleSections #-}\n{-#"
},
{
"path": "Aws/Iam/Commands/CreateUser.hs",
"chars": 1630,
"preview": "{-# LANGUAGE MultiParamTypeClasses #-}\n{-# LANGUAGE RecordWildCards #-}\n{-# LANGUAGE TupleSections #-}\n{-#"
},
{
"path": "Aws/Iam/Commands/DeleteAccessKey.hs",
"chars": 1752,
"preview": "{-# LANGUAGE MultiParamTypeClasses #-}\n{-# LANGUAGE RecordWildCards #-}\n{-# LANGUAGE TupleSections #-}\n{-#"
},
{
"path": "Aws/Iam/Commands/DeleteGroup.hs",
"chars": 1234,
"preview": "{-# LANGUAGE MultiParamTypeClasses #-}\n{-# LANGUAGE TypeFamilies #-}\nmodule Aws.Iam.Commands.DeleteGroup\n ( "
},
{
"path": "Aws/Iam/Commands/DeleteGroupPolicy.hs",
"chars": 1683,
"preview": "{-# LANGUAGE MultiParamTypeClasses #-}\n{-# LANGUAGE RecordWildCards #-}\n{-# LANGUAGE TypeFamilies #-}\nmod"
},
{
"path": "Aws/Iam/Commands/DeleteUser.hs",
"chars": 1209,
"preview": "{-# LANGUAGE MultiParamTypeClasses #-}\n{-# LANGUAGE TypeFamilies #-}\nmodule Aws.Iam.Commands.DeleteUser\n ( D"
},
{
"path": "Aws/Iam/Commands/DeleteUserPolicy.hs",
"chars": 1657,
"preview": "{-# LANGUAGE MultiParamTypeClasses #-}\n{-# LANGUAGE RecordWildCards #-}\n{-# LANGUAGE TypeFamilies #-}\nmod"
},
{
"path": "Aws/Iam/Commands/GetGroup.hs",
"chars": 1422,
"preview": "{-# LANGUAGE MultiParamTypeClasses #-}\n{-# LANGUAGE TupleSections #-}\n{-# LANGUAGE TypeFamilies #-}\nmod"
},
{
"path": "Aws/Iam/Commands/GetGroupPolicy.hs",
"chars": 2572,
"preview": "{-# LANGUAGE MultiParamTypeClasses #-}\n{-# LANGUAGE RecordWildCards #-}\n{-# LANGUAGE TypeFamilies #-}\nmod"
},
{
"path": "Aws/Iam/Commands/GetUser.hs",
"chars": 1422,
"preview": "{-# LANGUAGE MultiParamTypeClasses #-}\n{-# LANGUAGE TupleSections #-}\n{-# LANGUAGE TypeFamilies #-}\nmod"
},
{
"path": "Aws/Iam/Commands/GetUserPolicy.hs",
"chars": 2542,
"preview": "{-# LANGUAGE MultiParamTypeClasses #-}\n{-# LANGUAGE RecordWildCards #-}\n{-# LANGUAGE TypeFamilies #-}\nmod"
},
{
"path": "Aws/Iam/Commands/ListAccessKeys.hs",
"chars": 4181,
"preview": "{-# LANGUAGE MultiParamTypeClasses #-}\n{-# LANGUAGE RecordWildCards #-}\n{-# LANGUAGE TupleSections #-}\n{-#"
},
{
"path": "Aws/Iam/Commands/ListGroupPolicies.hs",
"chars": 2833,
"preview": "{-# LANGUAGE MultiParamTypeClasses #-}\n{-# LANGUAGE RecordWildCards #-}\n{-# LANGUAGE TupleSections #-}\n{-#"
},
{
"path": "Aws/Iam/Commands/ListGroups.hs",
"chars": 2810,
"preview": "{-# LANGUAGE MultiParamTypeClasses #-}\n{-# LANGUAGE RecordWildCards #-}\n{-# LANGUAGE TupleSections #-}\n{-#"
},
{
"path": "Aws/Iam/Commands/ListMfaDevices.hs",
"chars": 3734,
"preview": "{-# LANGUAGE MultiParamTypeClasses #-}\n{-# LANGUAGE TypeFamilies #-}\n{-# LANGUAGE RecordWildCards #-}\nmod"
},
{
"path": "Aws/Iam/Commands/ListUserPolicies.hs",
"chars": 2804,
"preview": "{-# LANGUAGE MultiParamTypeClasses #-}\n{-# LANGUAGE RecordWildCards #-}\n{-# LANGUAGE TupleSections #-}\n{-#"
},
{
"path": "Aws/Iam/Commands/ListUsers.hs",
"chars": 2778,
"preview": "{-# LANGUAGE MultiParamTypeClasses #-}\n{-# LANGUAGE RecordWildCards #-}\n{-# LANGUAGE TupleSections #-}\n{-#"
},
{
"path": "Aws/Iam/Commands/PutGroupPolicy.hs",
"chars": 1763,
"preview": "{-# LANGUAGE MultiParamTypeClasses #-}\n{-# LANGUAGE RecordWildCards #-}\n{-# LANGUAGE TypeFamilies #-}\nmod"
},
{
"path": "Aws/Iam/Commands/PutUserPolicy.hs",
"chars": 1737,
"preview": "{-# LANGUAGE MultiParamTypeClasses #-}\n{-# LANGUAGE RecordWildCards #-}\n{-# LANGUAGE TypeFamilies #-}\nmod"
},
{
"path": "Aws/Iam/Commands/RemoveUserFromGroup.hs",
"chars": 1683,
"preview": "{-# LANGUAGE MultiParamTypeClasses #-}\n{-# LANGUAGE RecordWildCards #-}\n{-# LANGUAGE TypeFamilies #-}\nmod"
},
{
"path": "Aws/Iam/Commands/UpdateAccessKey.hs",
"chars": 2090,
"preview": "{-# LANGUAGE MultiParamTypeClasses #-}\n{-# LANGUAGE RecordWildCards #-}\n{-# LANGUAGE TupleSections #-}\n{-#"
},
{
"path": "Aws/Iam/Commands/UpdateGroup.hs",
"chars": 1765,
"preview": "{-# LANGUAGE MultiParamTypeClasses #-}\n{-# LANGUAGE RecordWildCards #-}\n{-# LANGUAGE TupleSections #-}\n{-#"
},
{
"path": "Aws/Iam/Commands/UpdateUser.hs",
"chars": 1734,
"preview": "{-# LANGUAGE MultiParamTypeClasses #-}\n{-# LANGUAGE RecordWildCards #-}\n{-# LANGUAGE TupleSections #-}\n{-#"
},
{
"path": "Aws/Iam/Commands.hs",
"chars": 2251,
"preview": "module Aws.Iam.Commands\n ( module Aws.Iam.Commands.AddUserToGroup\n , module Aws.Iam.Commands.CreateAccessKey\n ,"
},
{
"path": "Aws/Iam/Core.hs",
"chars": 9747,
"preview": "{-# LANGUAGE CPP #-}\n{-# LANGUAGE FlexibleContexts #-}\n{-# LANGUAGE MultiParamTypeClasses #-}\n{-# LANGUAGE RecordWi"
},
{
"path": "Aws/Iam/Internal.hs",
"chars": 2468,
"preview": "{-# LANGUAGE FlexibleContexts #-}\n{-# LANGUAGE MultiParamTypeClasses #-}\n{-# LANGUAGE TupleSections #-}\nmod"
},
{
"path": "Aws/Iam.hs",
"chars": 148,
"preview": "module Aws.Iam\n ( module Aws.Iam.Commands\n , module Aws.Iam.Core\n ) where\n\nimport Aws.Iam.Commands\nim"
},
{
"path": "Aws/Network.hs",
"chars": 677,
"preview": "module Aws.Network where\n\nimport Data.Maybe\nimport Control.Exception\nimport Network.BSD (getProtocolNumber)\nimport Netwo"
},
{
"path": "Aws/S3/Commands/CopyObject.hs",
"chars": 5634,
"preview": "{-# LANGUAGE CPP #-}\nmodule Aws.S3.Commands.CopyObject\nwhere\n\nimport Aws.Core\nimport Aws.S3.Core\nimp"
},
{
"path": "Aws/S3/Commands/DeleteBucket.hs",
"chars": 1564,
"preview": "module Aws.S3.Commands.DeleteBucket\nwhere\n\nimport Aws.Core\nimport Aws.S3.Core\nimport Data."
},
{
"path": "Aws/S3/Commands/DeleteObject.hs",
"chars": 1666,
"preview": "module Aws.S3.Commands.DeleteObject\nwhere\n\nimport Aws.Core\nimport Aws.S3.Core\nimport Data."
},
{
"path": "Aws/S3/Commands/DeleteObjectVersion.hs",
"chars": 2114,
"preview": "module Aws.S3.Commands.DeleteObjectVersion\nwhere\n\nimport Aws.Core\nimport Aws.S3.Core\nimport "
},
{
"path": "Aws/S3/Commands/DeleteObjects.hs",
"chars": 5069,
"preview": "module Aws.S3.Commands.DeleteObjects where\n\nimport Aws.Core\nimport Aws.S3.Core\nimport qualified Cryp"
},
{
"path": "Aws/S3/Commands/GetBucket.hs",
"chars": 5187,
"preview": "module Aws.S3.Commands.GetBucket\nwhere\n\nimport Aws.Core\nimport Aws.S3.Core\nimport Control."
},
{
"path": "Aws/S3/Commands/GetBucketLocation.hs",
"chars": 2244,
"preview": "module Aws.S3.Commands.GetBucketLocation\n where\n\nimport Aws.Core\nimport Aws.S3.Core\n\nimport qu"
},
{
"path": "Aws/S3/Commands/GetBucketObjectVersions.hs",
"chars": 6902,
"preview": "module Aws.S3.Commands.GetBucketObjectVersions\nwhere\n\nimport Aws.Core\nimport Aws.S3.Core\nimport "
},
{
"path": "Aws/S3/Commands/GetBucketVersioning.hs",
"chars": 2408,
"preview": "module Aws.S3.Commands.GetBucketVersioning \n( \n module Aws.S3.Commands.GetBucketVersioning\n, VersioningState(..)\n) wher"
},
{
"path": "Aws/S3/Commands/GetObject.hs",
"chars": 5222,
"preview": "{-# LANGUAGE CPP #-}\n\nmodule Aws.S3.Commands.GetObject\nwhere\n\nimport Aws.Core\nimport Aws.S3.Core\nimp"
},
{
"path": "Aws/S3/Commands/GetService.hs",
"chars": 2408,
"preview": "{-# LANGUAGE CPP #-}\nmodule Aws.S3.Commands.GetService\nwhere\n\nimport Aws.Core\nimport Aws.S3.Core\nimp"
},
{
"path": "Aws/S3/Commands/HeadObject.hs",
"chars": 3469,
"preview": "module Aws.S3.Commands.HeadObject\nwhere\n\nimport Aws.Core\nimport Aws.S3.Core\nimport Control"
},
{
"path": "Aws/S3/Commands/Multipart.hs",
"chars": 17950,
"preview": "module Aws.S3.Commands.Multipart\nwhere\nimport Aws.Aws\nimport Aws.Core\nimport Aws.S3.Core\ni"
},
{
"path": "Aws/S3/Commands/PutBucket.hs",
"chars": 4145,
"preview": "module Aws.S3.Commands.PutBucket where\n\nimport Aws.Core\nimport Aws.S3.Core\nimport Control."
},
{
"path": "Aws/S3/Commands/PutBucketVersioning.hs",
"chars": 2779,
"preview": "module Aws.S3.Commands.PutBucketVersioning where\n\nimport Aws.Core\nimport Aws.S3.Core\nimport "
},
{
"path": "Aws/S3/Commands/PutObject.hs",
"chars": 4840,
"preview": "{-# LANGUAGE CPP #-}\nmodule Aws.S3.Commands.PutObject\nwhere\n\nimport Aws.Core\nimport Aws.S3.Core\nimpo"
},
{
"path": "Aws/S3/Commands/RestoreObject.hs",
"chars": 4391,
"preview": "{-# LANGUAGE CPP #-}\nmodule Aws.S3.Commands.RestoreObject\nwhere\n\nimport Aws.Core\nimport Aws.S3.Core\n"
},
{
"path": "Aws/S3/Commands.hs",
"chars": 1328,
"preview": "module Aws.S3.Commands\n(\n module Aws.S3.Commands.CopyObject\n, module Aws.S3.Commands.DeleteBucket\n, module Aws.S3.Comma"
},
{
"path": "Aws/S3/Core.hs",
"chars": 34656,
"preview": "{-# LANGUAGE CPP, BangPatterns #-}\nmodule Aws.S3.Core where\n\nimport Aws.Core\nimport Control.Arrow "
},
{
"path": "Aws/S3.hs",
"chars": 113,
"preview": "module Aws.S3\n(\n module Aws.S3.Commands\n, module Aws.S3.Core\n)\nwhere\n\nimport Aws.S3.Commands\nimport Aws.S3.Core\n"
},
{
"path": "Aws/Ses/Commands/DeleteIdentity.hs",
"chars": 1305,
"preview": "module Aws.Ses.Commands.DeleteIdentity\n ( DeleteIdentity(..)\n , DeleteIdentityResponse(..)\n ) where\n\nimport Dat"
},
{
"path": "Aws/Ses/Commands/GetIdentityDkimAttributes.hs",
"chars": 2929,
"preview": "module Aws.Ses.Commands.GetIdentityDkimAttributes\n ( GetIdentityDkimAttributes(..)\n , GetIdentityDkimAttributesRes"
},
{
"path": "Aws/Ses/Commands/GetIdentityNotificationAttributes.hs",
"chars": 3028,
"preview": "module Aws.Ses.Commands.GetIdentityNotificationAttributes\n ( GetIdentityNotificationAttributes(..)\n , GetIdentityN"
},
{
"path": "Aws/Ses/Commands/GetIdentityVerificationAttributes.hs",
"chars": 2791,
"preview": "module Aws.Ses.Commands.GetIdentityVerificationAttributes\n ( GetIdentityVerificationAttributes(..)\n , GetIdentityV"
},
{
"path": "Aws/Ses/Commands/ListIdentities.hs",
"chars": 2200,
"preview": "module Aws.Ses.Commands.ListIdentities\n ( ListIdentities(..)\n , ListIdentitiesResponse(..)\n , IdentityType(..)\n"
},
{
"path": "Aws/Ses/Commands/SendRawEmail.hs",
"chars": 1950,
"preview": "module Aws.Ses.Commands.SendRawEmail\n ( SendRawEmail(..)\n , SendRawEmailResponse(..)\n ) where\n\nimport Data.Text"
},
{
"path": "Aws/Ses/Commands/SetIdentityDkimEnabled.hs",
"chars": 1676,
"preview": "module Aws.Ses.Commands.SetIdentityDkimEnabled\n ( SetIdentityDkimEnabled(..)\n , SetIdentityDkimEnabledResponse(..)"
},
{
"path": "Aws/Ses/Commands/SetIdentityFeedbackForwardingEnabled.hs",
"chars": 1977,
"preview": "module Aws.Ses.Commands.SetIdentityFeedbackForwardingEnabled\n ( SetIdentityFeedbackForwardingEnabled(..)\n , SetIde"
},
{
"path": "Aws/Ses/Commands/SetIdentityNotificationTopic.hs",
"chars": 2544,
"preview": "module Aws.Ses.Commands.SetIdentityNotificationTopic\n ( SetIdentityNotificationTopic(..)\n , SetIdentityNotificatio"
},
{
"path": "Aws/Ses/Commands/VerifyDomainDkim.hs",
"chars": 1489,
"preview": "module Aws.Ses.Commands.VerifyDomainDkim\n ( VerifyDomainDkim(..)\n , VerifyDomainDkimResponse(..)\n ) where\n\nimpo"
},
{
"path": "Aws/Ses/Commands/VerifyDomainIdentity.hs",
"chars": 1574,
"preview": "module Aws.Ses.Commands.VerifyDomainIdentity\n ( VerifyDomainIdentity(..)\n , VerifyDomainIdentityResponse(..)\n )"
},
{
"path": "Aws/Ses/Commands/VerifyEmailIdentity.hs",
"chars": 1414,
"preview": "module Aws.Ses.Commands.VerifyEmailIdentity\n ( VerifyEmailIdentity(..)\n , VerifyEmailIdentityResponse(..)\n ) wh"
},
{
"path": "Aws/Ses/Commands.hs",
"chars": 1253,
"preview": "module Aws.Ses.Commands\n ( module Aws.Ses.Commands.SendRawEmail\n , module Aws.Ses.Commands.ListIdentities\n , mo"
},
{
"path": "Aws/Ses/Core.hs",
"chars": 6911,
"preview": "module Aws.Ses.Core\n ( SesError(..)\n , SesMetadata(..)\n\n , SesConfiguration(..)\n , sesEuWest1\n , sesUsEas"
},
{
"path": "Aws/Ses.hs",
"chars": 128,
"preview": "module Aws.Ses\n ( module Aws.Ses.Commands\n , module Aws.Ses.Core\n ) where\n\nimport Aws.Ses.Commands\nimport Aws.S"
},
{
"path": "Aws/SimpleDb/Commands/Attributes.hs",
"chars": 8479,
"preview": "module Aws.SimpleDb.Commands.Attributes where\n\nimport Aws.Core\nimport Aws.SimpleDb.Core\nimport "
},
{
"path": "Aws/SimpleDb/Commands/Domain.hs",
"chars": 6685,
"preview": "module Aws.SimpleDb.Commands.Domain where\n\nimport Aws.Core\nimport Aws.SimpleDb.Core\nimport "
},
{
"path": "Aws/SimpleDb/Commands/Select.hs",
"chars": 2307,
"preview": "module Aws.SimpleDb.Commands.Select\nwhere\n\nimport Aws.Core\nimport Aws.SimpleDb.Core\nimport "
},
{
"path": "Aws/SimpleDb/Commands.hs",
"chars": 270,
"preview": "module Aws.SimpleDb.Commands\n(\n module Aws.SimpleDb.Commands.Attributes\n, module Aws.SimpleDb.Commands.Domain\n, module "
},
{
"path": "Aws/SimpleDb/Core.hs",
"chars": 9525,
"preview": "module Aws.SimpleDb.Core where\n\nimport Aws.Core\nimport qualified Blaze.ByteString.Builder as Blaze\nimpor"
},
{
"path": "Aws/SimpleDb.hs",
"chars": 143,
"preview": "module Aws.SimpleDb\n(\n module Aws.SimpleDb.Commands\n, module Aws.SimpleDb.Core\n)\nwhere\n\nimport Aws.SimpleDb.Commands\nim"
},
{
"path": "Aws/Sqs/Commands/Message.hs",
"chars": 29719,
"preview": "module Aws.Sqs.Commands.Message\n(\n-- * User Message Attributes\n UserMessageAttributeCustomType\n, UserMessageAttributeVa"
},
{
"path": "Aws/Sqs/Commands/Permission.hs",
"chars": 3144,
"preview": "\nmodule Aws.Sqs.Commands.Permission where\n\nimport Aws.Core\nimport Aws.Sqs.Core\nimport qualified Data"
},
{
"path": "Aws/Sqs/Commands/Queue.hs",
"chars": 4425,
"preview": "\nmodule Aws.Sqs.Commands.Queue where\n\nimport Aws.Core\nimport Aws.Sqs.Core\nimport Control.A"
},
{
"path": "Aws/Sqs/Commands/QueueAttributes.hs",
"chars": 3736,
"preview": "\nmodule Aws.Sqs.Commands.QueueAttributes where\n\nimport Aws.Core\nimport Aws.Sqs.Core\nimport "
},
{
"path": "Aws/Sqs/Commands.hs",
"chars": 320,
"preview": "module Aws.Sqs.Commands (\n module Aws.Sqs.Commands.Message,\n module Aws.Sqs.Commands.Permission,\n module Aws.Sqs.Comm"
},
{
"path": "Aws/Sqs/Core.hs",
"chars": 14771,
"preview": "{-# LANGUAGE CPP #-}\nmodule Aws.Sqs.Core where\n\nimport Aws.Core\nimport Aws.S3.Core "
},
{
"path": "Aws/Sqs.hs",
"chars": 118,
"preview": "module Aws.Sqs\n(\n module Aws.Sqs.Commands\n, module Aws.Sqs.Core\n)\nwhere\n\nimport Aws.Sqs.Commands\nimport Aws.Sqs.Core\n"
},
{
"path": "Aws.hs",
"chars": 1264,
"preview": "module Aws\n( -- * Logging\n LogLevel(..)\n, Logger\n, defaultLog\n -- * Configuration\n, Configuration(..)\n, baseConfigurat"
},
{
"path": "CHANGELOG.md",
"chars": 13564,
"preview": "0.25 series\n-----------\n\nNOTES: 0.25 brings technically breaking changes, which should not affect\nmost users. I recommen"
},
{
"path": "Examples/DynamoDb.hs",
"chars": 4161,
"preview": "{-# LANGUAGE OverloadedStrings #-}\n{-# LANGUAGE ScopedTypeVariables #-}\n{-# LANGUAGE FlexibleContexts #-}\n\nmodule Main"
},
{
"path": "Examples/GetObject.hs",
"chars": 964,
"preview": "{-# LANGUAGE OverloadedStrings #-}\n\nimport qualified Aws\nimport qualified Aws.S3 as S3\nimport Control.Monad.Tr"
},
{
"path": "Examples/GetObjectGoogle.hs",
"chars": 1074,
"preview": "{-# LANGUAGE OverloadedStrings #-}\n\nimport qualified Aws\nimport qualified Aws.Core as Aws\nimport qualified Aws.S3 as S3\n"
},
{
"path": "Examples/GetObjectV4.hs",
"chars": 1095,
"preview": "{-# LANGUAGE OverloadedStrings #-}\n\nimport qualified Aws\nimport qualified Aws.Core as Aws\nimport qualified Aws.S3 as S3\n"
},
{
"path": "Examples/MultipartTransfer.hs",
"chars": 1578,
"preview": "{-# LANGUAGE OverloadedStrings #-}\n\n{- This example demonstrates an ability to stream in constant space content from a r"
},
{
"path": "Examples/MultipartUpload.hs",
"chars": 1290,
"preview": "{-# LANGUAGE OverloadedStrings #-}\n\nimport qualified Aws\nimport qualified Aws.Core as Aws\nimport qualified Aws.S3 as S3\n"
},
{
"path": "Examples/NukeBucket.hs",
"chars": 1407,
"preview": "{-# LANGUAGE OverloadedStrings #-}\n\nimport qualified Aws\nimport qualified Aws.S3 as S3\nimport qualified Data.Conduit as "
},
{
"path": "Examples/PutBucketNearLine.hs",
"chars": 1281,
"preview": "-- | Example of creating a Nearline bucket on Google Cloud Storage.\n\n{-# LANGUAGE OverloadedStrings #-}\n\nimport qualifie"
},
{
"path": "Examples/PutObjectIA.hs",
"chars": 1749,
"preview": "{-# LANGUAGE OverloadedStrings #-}\n\nimport qualified Aws\nimport qualified Aws.Core as Aws\nimport qualified Aws.S3 as S3\n"
},
{
"path": "Examples/SimpleDb.hs",
"chars": 554,
"preview": "import qualified Aws\nimport qualified Aws.SimpleDb as Sdb\nimport qualified Data.Text as T\nimport qualified "
},
{
"path": "Examples/Sqs.hs",
"chars": 5002,
"preview": "{-# LANGUAGE OverloadedStrings #-}\n\nimport qualified Aws\nimport qualified Aws.Core\nimport qualified Aws.Sqs as Sqs\nimpor"
},
{
"path": "LICENSE",
"chars": 1546,
"preview": "Copyright (c) 2010, 2011, 2012, Aristid Breitkreuz\n\nAll rights reserved.\n\nRedistribution and use in source and binary fo"
},
{
"path": "README.md",
"chars": 6197,
"preview": "Introduction\n============\n\nThe `aws` package attempts to provide support for using Amazon Web\nServices like S3 (storage)"
},
{
"path": "Setup.hs",
"chars": 46,
"preview": "import Distribution.Simple\nmain = defaultMain\n"
},
{
"path": "VERSIONING",
"chars": 703,
"preview": "The AWS package is, starting with the 0.4 release, following the following versioning scheme:\n\n- Releases follow the Maj"
},
{
"path": "aws.cabal",
"chars": 14938,
"preview": "Name: aws\nVersion: 0.25.2\nSynopsis: Amazon Web Services (AWS) for Haskell\nDescript"
},
{
"path": "default.nix",
"chars": 1589,
"preview": "{ mkDerivation, aeson, attoparsec, base, base16-bytestring\n, base64-bytestring, blaze-builder, byteable, bytestring\n, ca"
},
{
"path": "ghci.hs",
"chars": 781,
"preview": "-- GHCI convenience code\n\nimport Aws\nimport Aws.Ec2.InstanceMetadata\nimport qualified Aws.S3 as S3\ni"
},
{
"path": "shell.nix",
"chars": 94,
"preview": "with (import <nixpkgs> {}).pkgs;\nlet\n pkg = haskellPackages.callPackage ./. {};\nin\n pkg.env\n"
},
{
"path": "stack.yaml",
"chars": 2175,
"preview": "# This file was automatically generated by 'stack init'\n#\n# Some commonly used options have been documented as comments "
},
{
"path": "tests/DynamoDb/Main.hs",
"chars": 4513,
"preview": "-- ------------------------------------------------------ --\n-- Copyright © 2014 AlephCloud Systems, Inc.\n-- -----------"
},
{
"path": "tests/DynamoDb/Utils.hs",
"chars": 4632,
"preview": "-- ------------------------------------------------------ --\n-- Copyright © 2014 AlephCloud Systems, Inc.\n-- -----------"
},
{
"path": "tests/S3/Main.hs",
"chars": 11476,
"preview": "{-# LANGUAGE CPP #-}\n{-# LANGUAGE DeriveDataTypeable #-}\n{-# LANGUAGE GeneralizedNewtypeD"
},
{
"path": "tests/Sqs/Main.hs",
"chars": 13163,
"preview": "-- ------------------------------------------------------ --\n-- Copyright © 2014 AlephCloud Systems, Inc.\n-- -----------"
},
{
"path": "tests/Utils.hs",
"chars": 6127,
"preview": "{-# LANGUAGE OverloadedStrings #-}\n{-# LANGUAGE ScopedTypeVariables #-}\n{-# LANGUAGE GADTs #-}\n{-# LANGUAGE CPP #-}\n{-# "
}
]
About this extraction
This page contains the full source code of the aristidb/aws GitHub repository, extracted and formatted as plain text for AI agents and large language models (LLMs). The extraction includes 123 files (540.2 KB), approximately 130.5k tokens. Use this with OpenClaw, Claude, ChatGPT, Cursor, Windsurf, or any other AI tool that accepts text input. You can copy the full output to your clipboard or download it as a .txt file.
Extracted by GitExtract — free GitHub repo to text converter for AI. Built by Nikandr Surkov.