aws 0.0.5 → 0.0.6
raw patch · 46 files changed
+1254/−84 lines, 46 filesdep +transformers-composedep +utf8-stringdep ~http-enumeratordep ~textdep ~tls
Dependencies added: transformers-compose, utf8-string
Dependency ranges changed: http-enumerator, text, tls, xml-enumerator
Files
- Aws/Aws.hs +12/−2
- Aws/Http.hs +2/−0
- Aws/Query.hs +1/−0
- Aws/Response.hs +4/−4
- Aws/S3/Commands.hs +7/−1
- Aws/S3/Commands/DeleteObject.hs +43/−0
- Aws/S3/Commands/GetBucket.hs +3/−2
- Aws/S3/Commands/GetObject.hs +68/−0
- Aws/S3/Commands/GetService.hs +3/−2
- Aws/S3/Commands/PutBucket.hs +4/−3
- Aws/S3/Commands/PutObject.hs +75/−0
- Aws/S3/Model.hs +19/−3
- Aws/S3/Query.hs +6/−3
- Aws/S3/Response.hs +8/−13
- Aws/SimpleDb/Commands/BatchDeleteAttributes.hs +2/−2
- Aws/SimpleDb/Commands/BatchPutAttributes.hs +2/−2
- Aws/SimpleDb/Commands/CreateDomain.hs +2/−2
- Aws/SimpleDb/Commands/DeleteAttributes.hs +2/−2
- Aws/SimpleDb/Commands/DeleteDomain.hs +2/−2
- Aws/SimpleDb/Commands/DomainMetadata.hs +2/−2
- Aws/SimpleDb/Commands/GetAttributes.hs +2/−2
- Aws/SimpleDb/Commands/ListDomains.hs +2/−2
- Aws/SimpleDb/Commands/PutAttributes.hs +2/−2
- Aws/SimpleDb/Commands/Select.hs +2/−2
- Aws/Sqs.hs +17/−0
- Aws/Sqs/Commands.hs +24/−0
- Aws/Sqs/Commands/AddPermission.hs +48/−0
- Aws/Sqs/Commands/ChangeMessageVisibility.hs +39/−0
- Aws/Sqs/Commands/CreateQueue.hs +49/−0
- Aws/Sqs/Commands/DeleteMessage.hs +38/−0
- Aws/Sqs/Commands/DeleteQueue.hs +33/−0
- Aws/Sqs/Commands/GetQueueAttributes.hs +56/−0
- Aws/Sqs/Commands/ListQueues.hs +45/−0
- Aws/Sqs/Commands/ReceiveMessage.hs +92/−0
- Aws/Sqs/Commands/RemovePermission.hs +41/−0
- Aws/Sqs/Commands/SendMessage.hs +48/−0
- Aws/Sqs/Commands/SetQueueAttributes.hs +40/−0
- Aws/Sqs/Error.hs +27/−0
- Aws/Sqs/Info.hs +85/−0
- Aws/Sqs/Metadata.hs +16/−0
- Aws/Sqs/Model.hs +96/−0
- Aws/Sqs/Query.hs +69/−0
- Aws/Sqs/Response.hs +66/−0
- Aws/Transaction.hs +1/−1
- Aws/Util.hs +19/−13
- aws.cabal +30/−17
Aws/Aws.hs view
@@ -10,6 +10,7 @@ import Aws.S3.Info import Aws.Signature import Aws.SimpleDb.Info+import Aws.Sqs.Info import Aws.Transaction import Control.Applicative import Data.Attempt (attemptIO)@@ -28,6 +29,8 @@ , sdbInfoUri :: SdbInfo , s3Info :: S3Info , s3InfoUri :: S3Info+ , sqsInfo :: SqsInfo+ , sqsInfoUri :: SqsInfo } class ConfigurationFetch a where@@ -46,6 +49,10 @@ configurationFetch = s3Info configurationFetchUri = s3InfoUri +instance ConfigurationFetch SqsInfo where+ configurationFetch = sqsInfo+ configurationFetchUri = sqsInfoUri+ baseConfiguration :: IO Configuration baseConfiguration = do Just cr <- loadCredentialsDefault@@ -56,6 +63,8 @@ , sdbInfoUri = sdbHttpsGet sdbUsEast , s3Info = s3 HTTP s3EndpointUsClassic False , s3InfoUri = s3 HTTP s3EndpointUsClassic True+ , sqsInfo = sqs HTTP sqsEndpointUsClassic False+ , sqsInfoUri = sqs HTTP sqsEndpointUsClassic True } -- TODO: better error handling when credentials cannot be loaded @@ -70,7 +79,7 @@ aws = unsafeAws unsafeAws- :: (ResponseIteratee a,+ :: (ResponseIteratee r a, Monoid (ResponseMetadata a), SignQuery r, ConfigurationFetch (Info r)) =>@@ -83,7 +92,7 @@ let httpRequest = queryToHttpRequest q metadataRef <- newIORef mempty resp <- attemptIO (id :: E.SomeException -> E.SomeException) $- HTTP.withManager $ En.run_ . HTTP.httpRedirect httpRequest (responseIteratee metadataRef)+ HTTP.withManager $ En.run_ . HTTP.httpRedirect httpRequest (responseIteratee request metadataRef) metadata <- readIORef metadataRef return $ Response metadata resp @@ -98,3 +107,4 @@ let q = signQuery request info sd debugPrint "String to sign" $ sqStringToSign q return $ queryToUri q+
Aws/Http.hs view
@@ -19,6 +19,7 @@ | PostQuery | Post | Put+ | Delete deriving (Show, Eq) httpMethod :: Method -> HTTP.Method@@ -26,3 +27,4 @@ httpMethod PostQuery = "POST" httpMethod Post = "POST" httpMethod Put = "PUT"+httpMethod Delete = "DELETE"
Aws/Query.hs view
@@ -57,6 +57,7 @@ Just x -> x , HTTP.proxy = Nothing , HTTP.rawBody = False+ , HTTP.decompress = HTTP.alwaysDecompress } where contentType = case sqMethod of PostQuery -> Just "application/x-www-form-urlencoded; charset=utf-8"
Aws/Response.hs view
@@ -31,10 +31,10 @@ tellMetadataRef :: Monoid m => IORef m -> m -> IO () tellMetadataRef r m = modifyIORef r (`mappend` m) -class ResponseIteratee a where+class ResponseIteratee r a where type ResponseMetadata a- responseIteratee :: IORef (ResponseMetadata a) -> HTTP.Status -> HTTP.ResponseHeaders -> En.Iteratee B.ByteString IO a+ responseIteratee :: r -> IORef (ResponseMetadata a) -> HTTP.Status -> HTTP.ResponseHeaders -> En.Iteratee B.ByteString IO a -instance ResponseIteratee HTTP.Response where+instance ResponseIteratee r HTTP.Response where type ResponseMetadata HTTP.Response = ()- responseIteratee _ = HTTP.lbsIter+ responseIteratee _ _ = HTTP.lbsIter
Aws/S3/Commands.hs view
@@ -1,11 +1,17 @@ module Aws.S3.Commands (- module Aws.S3.Commands.GetBucket+ module Aws.S3.Commands.DeleteObject+, module Aws.S3.Commands.GetBucket+, module Aws.S3.Commands.GetObject , module Aws.S3.Commands.GetService , module Aws.S3.Commands.PutBucket+, module Aws.S3.Commands.PutObject ) where +import Aws.S3.Commands.DeleteObject import Aws.S3.Commands.GetBucket+import Aws.S3.Commands.GetObject import Aws.S3.Commands.GetService import Aws.S3.Commands.PutBucket+import Aws.S3.Commands.PutObject
+ Aws/S3/Commands/DeleteObject.hs view
@@ -0,0 +1,43 @@+{-# LANGUAGE TypeFamilies, RecordWildCards, TupleSections, OverloadedStrings, MultiParamTypeClasses, FlexibleInstances, UndecidableInstances, GADTs, RankNTypes #-}+module Aws.S3.Commands.DeleteObject+where++import Aws.Http+import Aws.Response+import Aws.S3.Info+import Aws.S3.Metadata+import Aws.S3.Model+import Aws.S3.Query+import Aws.Signature+import Aws.Transaction+import Data.ByteString.Char8 ({- IsString -})+import qualified Data.Text as T+import qualified Data.Text.Encoding as T++data DeleteObject = DeleteObject {+ doObjectName :: T.Text,+ doBucket :: Bucket+}++data DeleteObjectResponse = DeleteObjectResponse{+}++instance SignQuery DeleteObject where+ type Info DeleteObject = S3Info+ signQuery DeleteObject {..} = s3SignQuery S3Query { + s3QMethod = Delete+ , s3QBucket = Just $ T.encodeUtf8 doBucket+ , s3QSubresources = []+ , s3QQuery = []+ , s3QAmzHeaders = []+ , s3QRequestBody = Nothing+ , s3QObject = Just $ T.encodeUtf8 doObjectName+ }++instance ResponseIteratee DeleteObject DeleteObjectResponse where+ type ResponseMetadata DeleteObjectResponse = S3Metadata+ responseIteratee _ _ _ _ = return DeleteObjectResponse+ ++instance Transaction DeleteObject DeleteObjectResponse+
Aws/S3/Commands/GetBucket.hs view
@@ -60,6 +60,7 @@ signQuery GetBucket {..} = s3SignQuery S3Query { s3QMethod = Get , s3QBucket = Just $ T.encodeUtf8 gbBucket+ , s3QObject = Nothing , s3QSubresources = [] , s3QQuery = HTTP.simpleQueryToQuery $ map (second T.encodeUtf8) $ catMaybes [ ("delimiter",) <$> gbDelimiter@@ -71,10 +72,10 @@ , s3QRequestBody = Nothing } -instance ResponseIteratee GetBucketResponse where+instance ResponseIteratee r GetBucketResponse where type ResponseMetadata GetBucketResponse = S3Metadata - responseIteratee = s3XmlResponseIteratee parse+ responseIteratee _ = s3XmlResponseIteratee parse where parse cursor = do name <- force "Missing Name" $ cursor $/ elContent "Name" let delimiter = listToMaybe $ cursor $/ elContent "Delimiter"
+ Aws/S3/Commands/GetObject.hs view
@@ -0,0 +1,68 @@+{-# LANGUAGE TypeFamilies, RecordWildCards, TupleSections, OverloadedStrings, MultiParamTypeClasses, FlexibleInstances, UndecidableInstances, GADTs, RankNTypes #-}+module Aws.S3.Commands.GetObject+where++import Aws.Http+import Aws.Response+import Aws.S3.Info+import Aws.S3.Metadata+import Aws.S3.Model+import Aws.S3.Query+import Aws.S3.Response+import Aws.Signature+import Aws.Transaction+import Control.Applicative+import Control.Arrow (second)+import Data.ByteString.Char8 ({- IsString -})+import Data.Maybe+import qualified Data.ByteString as B+import qualified Data.Enumerator as En+import qualified Data.Text as T+import qualified Data.Text.Encoding as T+import qualified Network.HTTP.Types as HTTP++data GetObject a+ = GetObject {+ goBucket :: Bucket+ , goObjectName :: Object+ , goResponseIteratee :: HTTP.Status -> HTTP.ResponseHeaders -> En.Iteratee B.ByteString IO a+ , goResponseContentType :: Maybe T.Text+ , goResponseContentLanguage :: Maybe T.Text+ , goResponseExpires :: Maybe T.Text+ , goResponseCacheControl :: Maybe T.Text+ , goResponseContentDisposition :: Maybe T.Text+ , goResponseContentEncoding :: Maybe T.Text+ }++getObject :: Bucket -> T.Text -> (HTTP.Status -> HTTP.ResponseHeaders -> En.Iteratee B.ByteString IO a) -> GetObject a+getObject b o i = GetObject b o i Nothing Nothing Nothing Nothing Nothing Nothing++data GetObjectResponse a+ = GetObjectResponse a+ deriving (Show)++instance SignQuery (GetObject a) where+ type Info (GetObject a) = S3Info+ signQuery GetObject {..} = s3SignQuery S3Query { + s3QMethod = Get+ , s3QBucket = Just $ T.encodeUtf8 goBucket+ , s3QObject = Just $ T.encodeUtf8 goObjectName + , s3QSubresources = []+ , s3QQuery = HTTP.simpleQueryToQuery $ map (second T.encodeUtf8) $ catMaybes [+ ("response-content-type",) <$> goResponseContentType+ , ("response-content-language",) <$> goResponseContentLanguage+ , ("response-expires",) <$> goResponseExpires+ , ("response-cache-control",) <$> goResponseCacheControl+ , ("response-content-disposition",) <$> goResponseContentDisposition+ , ("response-content-encoding",) <$> goResponseContentEncoding+ ]+ , s3QAmzHeaders = []+ , s3QRequestBody = Nothing+ }++instance ResponseIteratee (GetObject a) (GetObjectResponse a) where+ type ResponseMetadata (GetObjectResponse a) = S3Metadata+ responseIteratee GetObject{..} metadata status headers+ = GetObjectResponse <$> s3BinaryResponseIteratee (goResponseIteratee) metadata status headers++instance Transaction (GetObject a) (GetObjectResponse a)
Aws/S3/Commands/GetService.hs view
@@ -28,10 +28,10 @@ } deriving (Show) -instance ResponseIteratee GetServiceResponse where+instance ResponseIteratee r GetServiceResponse where type ResponseMetadata GetServiceResponse = S3Metadata - responseIteratee = s3XmlResponseIteratee parse+ responseIteratee _ = s3XmlResponseIteratee parse where parse el = do owner <- forceM "Missing Owner" $ el $/ Cu.laxElement "Owner" &| parseUserInfo@@ -49,6 +49,7 @@ signQuery GetService = s3SignQuery S3Query { s3QMethod = Get , s3QBucket = Nothing+ , s3QObject = Nothing , s3QSubresources = [] , s3QQuery = [] , s3QAmzHeaders = []
Aws/S3/Commands/PutBucket.hs view
@@ -1,4 +1,4 @@-{-# LANGUAGE RecordWildCards, TypeFamilies, OverloadedStrings, MultiParamTypeClasses #-}+{-# LANGUAGE RecordWildCards, TypeFamilies, OverloadedStrings, MultiParamTypeClasses, FlexibleInstances #-} module Aws.S3.Commands.PutBucket where import Aws.Http@@ -36,6 +36,7 @@ , s3QBucket = Just $ T.encodeUtf8 pbBucket , s3QSubresources = [] , s3QQuery = []+ , s3QObject = Nothing , s3QAmzHeaders = case pbCannedAcl of Nothing -> [] Just acl -> [("x-amz-acl", T.encodeUtf8 $ writeCannedAcl acl)]@@ -60,10 +61,10 @@ ] } -instance ResponseIteratee PutBucketResponse where+instance ResponseIteratee r PutBucketResponse where type ResponseMetadata PutBucketResponse = S3Metadata - responseIteratee = s3ResponseIteratee inner+ responseIteratee _ = s3ResponseIteratee inner where inner _status _headers = return PutBucketResponse instance Transaction PutBucket PutBucketResponse
+ Aws/S3/Commands/PutObject.hs view
@@ -0,0 +1,75 @@+{-# LANGUAGE TypeFamilies, RecordWildCards, TupleSections, OverloadedStrings, MultiParamTypeClasses, FlexibleInstances, UndecidableInstances, GADTs, RankNTypes #-}+module Aws.S3.Commands.PutObject+where++import Aws.Http+import Aws.Response+import Aws.S3.Info+import Aws.S3.Metadata+import Aws.S3.Model+import Aws.S3.Query+import Aws.Signature+import Aws.Transaction+import Control.Applicative+import Control.Arrow (second)+import Data.ByteString.Char8 ({- IsString -})+import Data.Maybe+import qualified Data.CaseInsensitive as CI+import qualified Data.Text as T+import qualified Data.Text.Encoding as T+import qualified Network.HTTP.Enumerator as HTTP+import qualified Network.HTTP.Types as HTTP++data PutObject = PutObject {+ poObjectName :: T.Text,+ poBucket :: Bucket,+ poContentType :: Maybe T.Text,+ poCacheControl :: Maybe T.Text,+ poContentDisposition :: Maybe T.Text,+ poContentEncoding :: Maybe T.Text,+ poContentMD5 :: Maybe T.Text,+ poExpires :: Maybe Int,+ poAcl :: Maybe CannedAcl,+ poStorageClass :: Maybe StorageClass,+ poRequestBody :: HTTP.RequestBody IO,+ poMetadata :: [(T.Text,T.Text)]+}++data PutObjectResponse = PutObjectResponse{+ porVersionId :: Maybe T.Text+}++instance SignQuery PutObject where+ type Info PutObject = S3Info+ signQuery PutObject {..} = s3SignQuery S3Query { + s3QMethod = Put+ , s3QBucket = Just $ T.encodeUtf8 poBucket+ , s3QSubresources = []+ , s3QQuery = HTTP.simpleQueryToQuery $ map (second T.encodeUtf8) $ catMaybes [+ ("Content-Type",) <$> poContentType+ , ("Expires",) <$> case poExpires of+ Just x -> Just $ T.pack $ show x+ Nothing -> Nothing+ , ("Cache-Control",) <$> poCacheControl+ , ("Content-Disposition",) <$> poContentDisposition+ , ("Content-Encoding",) <$> poContentEncoding+ , ("Content-MD5",) <$> poContentMD5+ ]+ , s3QAmzHeaders = catMaybes [+ (CI.mk $ T.encodeUtf8 "x-amz-acl",) <$> case poAcl of+ Just x -> Just $ T.encodeUtf8 $ writeCannedAcl x+ Nothing -> Nothing+ , ("x-amz-storage-class",) <$> case poStorageClass of+ Just x -> Just $ T.encodeUtf8 $ writeStorageClass x+ Nothing -> Nothing+ ] ++ map( \x -> (CI.mk . T.encodeUtf8 $ T.concat ["x-amz-meta-", fst x], T.encodeUtf8 $ snd x)) poMetadata + , s3QRequestBody = Just poRequestBody+ , s3QObject = Just $ T.encodeUtf8 poObjectName+ }++instance ResponseIteratee PutObject PutObjectResponse where+ type ResponseMetadata PutObjectResponse = S3Metadata+ responseIteratee _ _ _ _ = do return $ PutObjectResponse Nothing++instance Transaction PutObject PutObjectResponse+
Aws/S3/Model.hs view
@@ -43,6 +43,20 @@ writeCannedAcl AclBucketOwnerFullControl = "bucket-owner-full-control" writeCannedAcl AclLogDeliveryWrite = "log-delivery-write" +data StorageClass+ = Standard+ | ReducedRedundancy+ deriving (Show)++parseStorageClass :: F.Failure XmlException m => T.Text -> m StorageClass+parseStorageClass "STANDARD" = return Standard+parseStorageClass "REDUCED_REDUNDANCY" = return ReducedRedundancy+parseStorageClass s = F.failure . XmlException $ "Invalid Storage Class: " ++ T.unpack s++writeStorageClass :: StorageClass -> T.Text+writeStorageClass Standard = "STANDARD"+writeStorageClass ReducedRedundancy = "REDUCED_REDUNDANCY"+ type Bucket = T.Text data BucketInfo@@ -52,13 +66,15 @@ } deriving (Show) +type Object = T.Text+ data ObjectInfo = ObjectInfo { objectKey :: T.Text , objectLastModified :: UTCTime , objectETag :: T.Text , objectSize :: Integer- , objectStorageClass :: T.Text+ , objectStorageClass :: StorageClass , objectOwner :: UserInfo } deriving (Show)@@ -69,10 +85,10 @@ let time s = case parseTime defaultTimeLocale "%Y-%m-%dT%H:%M:%S%QZ" $ T.unpack s of Nothing -> F.failure $ XmlException "Invalid time" Just v -> return v- lastModified <- forceM "Missing object LastModified" $ el $/ Cu.laxElement "LastModified" >=> Cu.content &| time+ lastModified <- forceM "Missing object LastModified" $ el $/ elContent "LastModified" &| time eTag <- force "Missing object ETag" $ el $/ elContent "ETag" size <- forceM "Missing object Size" $ el $/ elContent "Size" &| textReadInt- storageClass <- force "Missing object StorageClass" $ el $/ elContent "StorageClass"+ storageClass <- forceM "Missing object StorageClass" $ el $/ elContent "StorageClass" &| parseStorageClass owner <- forceM "Missing object Owner" $ el $/ Cu.laxElement "Owner" &| parseUserInfo return ObjectInfo{ objectKey = key
Aws/S3/Query.hs view
@@ -26,6 +26,7 @@ = S3Query { s3QMethod :: Method , s3QBucket :: Maybe B.ByteString+ , s3QObject :: Maybe B.ByteString , s3QSubresources :: HTTP.Query , s3QQuery :: HTTP.Query , s3QAmzHeaders :: HTTP.RequestHeaders@@ -66,13 +67,15 @@ then (k1, B8.intercalate "," [v1, v2]):merge xs else x1:x2:merge xs merge xs = xs+ (host, path) = case s3RequestStyle of - PathStyle -> ([Just s3Endpoint], [Just "/", fmap (`B8.snoc` '/') s3QBucket])- BucketStyle -> ([s3QBucket, Just s3Endpoint], [Just "/"])- VHostStyle -> ([Just $ fromMaybe s3Endpoint s3QBucket], [Just "/"])+ PathStyle -> ([Just s3Endpoint], [Just "/", fmap (`B8.snoc` '/') s3QBucket, s3QObject])+ BucketStyle -> ([s3QBucket, Just s3Endpoint], [Just "/", s3QObject])+ VHostStyle -> ([Just $ fromMaybe s3Endpoint s3QBucket], [Just "/", s3QObject]) sortedSubresources = sort s3QSubresources canonicalizedResource = Blaze8.fromChar '/' `mappend` maybe mempty (\s -> Blaze.copyByteString s `mappend` Blaze8.fromChar '/') s3QBucket `mappend`+ maybe mempty Blaze.copyByteString s3QObject `mappend` HTTP.renderQueryBuilder True sortedSubresources ti = case (s3UseUri, signatureTimeInfo) of (False, ti') -> ti'
Aws/S3/Response.hs view
@@ -1,18 +1,17 @@-{-# LANGUAGE FlexibleInstances, OverloadedStrings, ScopedTypeVariables, RecordWildCards, TypeFamilies #-}+{-# LANGUAGE FlexibleInstances, OverloadedStrings, ScopedTypeVariables, RecordWildCards, TypeFamilies, RankNTypes #-} module Aws.S3.Response where import Aws.Response import Aws.S3.Error import Aws.S3.Metadata+import Aws.Util import Aws.Xml import Control.Monad.IO.Class import Data.Attempt (Attempt(..))-import Data.Char import Data.Enumerator ((=$)) import Data.IORef import Data.Maybe-import Data.Word import Text.XML.Enumerator.Cursor (($/)) import qualified Data.ByteString as B import qualified Data.Enumerator as En@@ -44,6 +43,12 @@ -> HTTP.Status -> HTTP.ResponseHeaders -> En.Iteratee B.ByteString IO a s3XmlResponseIteratee parse metadataRef = s3ResponseIteratee (xmlCursorIteratee parse metadataRef) metadataRef +s3BinaryResponseIteratee ::+ (HTTP.Status -> HTTP.ResponseHeaders -> En.Iteratee B.ByteString IO a)+ -> IORef S3Metadata+ -> HTTP.Status -> HTTP.ResponseHeaders -> En.Iteratee B.ByteString IO a+s3BinaryResponseIteratee inner metadataRef = s3ResponseIteratee inner metadataRef + s3ErrorResponseIteratee :: HTTP.Status -> HTTP.ResponseHeaders -> En.Iteratee B.ByteString IO a s3ErrorResponseIteratee status _headers = do doc <- XML.parseBytes XML.decodeEntities =$ XML.fromEvents@@ -70,13 +75,3 @@ , s3ErrorAccessKeyId = accessKeyId , s3ErrorStringToSign = stringToSign }- where readHex2 :: [Char] -> Maybe Word8- readHex2 [c1,c2] = do n1 <- readHex1 c1- n2 <- readHex1 c2- return . fromIntegral $ n1 * 16 + n2- readHex2 _ = Nothing- - 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
Aws/SimpleDb/Commands/BatchDeleteAttributes.hs view
@@ -36,8 +36,8 @@ , ("DomainName", T.encodeUtf8 bdaDomainName)] ++ queryList (itemQuery $ queryList (attributeQuery deleteAttributeQuery) "Attribute") "Item" bdaItems -instance ResponseIteratee BatchDeleteAttributesResponse where+instance ResponseIteratee r BatchDeleteAttributesResponse where type ResponseMetadata BatchDeleteAttributesResponse = SdbMetadata- responseIteratee = sdbResponseIteratee $ sdbCheckResponseType BatchDeleteAttributesResponse "BatchDeleteAttributesResponse"+ responseIteratee _ = sdbResponseIteratee $ sdbCheckResponseType BatchDeleteAttributesResponse "BatchDeleteAttributesResponse" instance Transaction BatchDeleteAttributes BatchDeleteAttributesResponse
Aws/SimpleDb/Commands/BatchPutAttributes.hs view
@@ -36,8 +36,8 @@ , ("DomainName", T.encodeUtf8 bpaDomainName)] ++ queryList (itemQuery $ queryList (attributeQuery setAttributeQuery) "Attribute") "Item" bpaItems -instance ResponseIteratee BatchPutAttributesResponse where+instance ResponseIteratee r BatchPutAttributesResponse where type ResponseMetadata BatchPutAttributesResponse = SdbMetadata- responseIteratee = sdbResponseIteratee $ sdbCheckResponseType BatchPutAttributesResponse "BatchPutAttributesResponse"+ responseIteratee _ = sdbResponseIteratee $ sdbCheckResponseType BatchPutAttributesResponse "BatchPutAttributesResponse" instance Transaction BatchPutAttributes BatchPutAttributesResponse
Aws/SimpleDb/Commands/CreateDomain.hs view
@@ -29,8 +29,8 @@ type Info CreateDomain = SdbInfo signQuery CreateDomain{..} = sdbSignQuery [("Action", "CreateDomain"), ("DomainName", T.encodeUtf8 cdDomainName)] -instance ResponseIteratee CreateDomainResponse where+instance ResponseIteratee r CreateDomainResponse where type ResponseMetadata CreateDomainResponse = SdbMetadata- responseIteratee = sdbResponseIteratee $ sdbCheckResponseType CreateDomainResponse "CreateDomainResponse"+ responseIteratee _ = sdbResponseIteratee $ sdbCheckResponseType CreateDomainResponse "CreateDomainResponse" instance Transaction CreateDomain CreateDomainResponse
Aws/SimpleDb/Commands/DeleteAttributes.hs view
@@ -43,8 +43,8 @@ queryList (attributeQuery deleteAttributeQuery) "Attribute" daAttributes ++ queryList (attributeQuery expectedAttributeQuery) "Expected" daExpected -instance ResponseIteratee DeleteAttributesResponse where+instance ResponseIteratee r DeleteAttributesResponse where type ResponseMetadata DeleteAttributesResponse = SdbMetadata- responseIteratee = sdbResponseIteratee $ sdbCheckResponseType DeleteAttributesResponse "DeleteAttributesResponse"+ responseIteratee _ = sdbResponseIteratee $ sdbCheckResponseType DeleteAttributesResponse "DeleteAttributesResponse" instance Transaction DeleteAttributes DeleteAttributesResponse
Aws/SimpleDb/Commands/DeleteDomain.hs view
@@ -29,8 +29,8 @@ type Info DeleteDomain = SdbInfo signQuery DeleteDomain{..} = sdbSignQuery [("Action", "DeleteDomain"), ("DomainName", T.encodeUtf8 ddDomainName)] -instance ResponseIteratee DeleteDomainResponse where+instance ResponseIteratee r DeleteDomainResponse where type ResponseMetadata DeleteDomainResponse = SdbMetadata- responseIteratee = sdbResponseIteratee $ sdbCheckResponseType DeleteDomainResponse "DeleteDomainResponse"+ responseIteratee _ = sdbResponseIteratee $ sdbCheckResponseType DeleteDomainResponse "DeleteDomainResponse" instance Transaction DeleteDomain DeleteDomainResponse
Aws/SimpleDb/Commands/DomainMetadata.hs view
@@ -41,10 +41,10 @@ type Info DomainMetadata = SdbInfo signQuery DomainMetadata{..} = sdbSignQuery [("Action", "DomainMetadata"), ("DomainName", T.encodeUtf8 dmDomainName)] -instance ResponseIteratee DomainMetadataResponse where+instance ResponseIteratee r DomainMetadataResponse where type ResponseMetadata DomainMetadataResponse = SdbMetadata - responseIteratee = sdbResponseIteratee parse+ responseIteratee _ = sdbResponseIteratee parse where parse cursor = do sdbCheckResponseType () "DomainMetadataResponse" cursor dmrTimestamp <- forceM "Timestamp expected" $ cursor $// elCont "Timestamp" &| (fmap posixSecondsToUTCTime . readInt)
Aws/SimpleDb/Commands/GetAttributes.hs view
@@ -45,9 +45,9 @@ maybeToList (("AttributeName",) <$> T.encodeUtf8 <$> gaAttributeName) ++ (guard gaConsistentRead >> [("ConsistentRead", awsTrue)]) -instance ResponseIteratee GetAttributesResponse where+instance ResponseIteratee r GetAttributesResponse where type ResponseMetadata GetAttributesResponse = SdbMetadata- responseIteratee = sdbResponseIteratee parse+ responseIteratee _ = sdbResponseIteratee parse where parse cursor = do sdbCheckResponseType () "GetAttributesResponse" cursor attributes <- sequence $ cursor $// Cu.laxElement "Attribute" &| readAttribute
Aws/SimpleDb/Commands/ListDomains.hs view
@@ -41,9 +41,9 @@ , ("NextToken",) . T.encodeUtf8 <$> ldNextToken ] -instance ResponseIteratee ListDomainsResponse where+instance ResponseIteratee r ListDomainsResponse where type ResponseMetadata ListDomainsResponse = SdbMetadata- responseIteratee = sdbResponseIteratee parse + responseIteratee _ = sdbResponseIteratee parse where parse cursor = do sdbCheckResponseType () "ListDomainsResponse" cursor let names = cursor $// elContent "DomainName"
Aws/SimpleDb/Commands/PutAttributes.hs view
@@ -43,8 +43,8 @@ queryList (attributeQuery setAttributeQuery) "Attribute" paAttributes ++ queryList (attributeQuery expectedAttributeQuery) "Expected" paExpected -instance ResponseIteratee PutAttributesResponse where+instance ResponseIteratee r PutAttributesResponse where type ResponseMetadata PutAttributesResponse = SdbMetadata- responseIteratee = sdbResponseIteratee $ sdbCheckResponseType PutAttributesResponse "PutAttributesResponse"+ responseIteratee _ = sdbResponseIteratee $ sdbCheckResponseType PutAttributesResponse "PutAttributesResponse" instance Transaction PutAttributes PutAttributesResponse
Aws/SimpleDb/Commands/Select.hs view
@@ -48,9 +48,9 @@ , (("NextToken",) . T.encodeUtf8) <$> sNextToken ] -instance ResponseIteratee SelectResponse where+instance ResponseIteratee r SelectResponse where type ResponseMetadata SelectResponse = SdbMetadata- responseIteratee = sdbResponseIteratee parse+ responseIteratee _ = sdbResponseIteratee parse where parse cursor = do sdbCheckResponseType () "SelectResponse" cursor items <- sequence $ cursor $// Cu.laxElement "Item" &| readItem
+ Aws/Sqs.hs view
@@ -0,0 +1,17 @@+module Aws.Sqs+(+ module Aws.Sqs.Commands+, module Aws.Sqs.Error+, module Aws.Sqs.Info+, module Aws.Sqs.Metadata+, module Aws.Sqs.Query+, module Aws.Sqs.Response+)+where++import Aws.Sqs.Commands+import Aws.Sqs.Error+import Aws.Sqs.Info+import Aws.Sqs.Metadata+import Aws.Sqs.Query+import Aws.Sqs.Response
+ Aws/Sqs/Commands.hs view
@@ -0,0 +1,24 @@+module Aws.Sqs.Commands(+ module Aws.Sqs.Commands.AddPermission,+ module Aws.Sqs.Commands.DeleteMessage,+ module Aws.Sqs.Commands.DeleteQueue,+ module Aws.Sqs.Commands.ListQueues,+ module Aws.Sqs.Commands.GetQueueAttributes,+ module Aws.Sqs.Commands.ChangeMessageVisibility,+ module Aws.Sqs.Commands.CreateQueue,+ module Aws.Sqs.Commands.ReceiveMessage,+ module Aws.Sqs.Commands.RemovePermission,+ module Aws.Sqs.Commands.SendMessage,+ module Aws.Sqs.Commands.SetQueueAttributes+)where+import Aws.Sqs.Commands.AddPermission+import Aws.Sqs.Commands.DeleteMessage+import Aws.Sqs.Commands.DeleteQueue+import Aws.Sqs.Commands.ListQueues+import Aws.Sqs.Commands.GetQueueAttributes+import Aws.Sqs.Commands.ChangeMessageVisibility+import Aws.Sqs.Commands.CreateQueue+import Aws.Sqs.Commands.ReceiveMessage+import Aws.Sqs.Commands.RemovePermission+import Aws.Sqs.Commands.SendMessage+import Aws.Sqs.Commands.SetQueueAttributes
+ Aws/Sqs/Commands/AddPermission.hs view
@@ -0,0 +1,48 @@+{-# LANGUAGE RecordWildCards, TypeFamilies, FlexibleInstances, MultiParamTypeClasses, OverloadedStrings, TupleSections #-}++module Aws.Sqs.Commands.AddPermission where++import Aws.Response+import Aws.Sqs.Info+import Aws.Sqs.Metadata+import Aws.Sqs.Model+import Aws.Sqs.Query+import Aws.Sqs.Response+import Aws.Signature+import Aws.Transaction+import qualified Data.Text as T+import qualified Data.ByteString.Char8 as B+import qualified Network.HTTP.Types as HTTP+++data AddPermission = AddPermission{+ apLabel :: T.Text,+ apPermissions :: [(T.Text,SqsPermission)],+ apQueueName :: QueueName+}deriving (Show)++data AddPermissionResponse = AddPermissionResponse{+} deriving (Show)+++formatPermissions :: [(T.Text,SqsPermission)] -> [HTTP.QueryItem]+formatPermissions perms = + concat $ zipWith(\ x y -> [(B.pack $ "AwsAccountId." ++ show y, Just $ B.pack $ T.unpack $ fst x), + (B.pack $ "ActionName." ++ show y, Just $ B.pack $ T.unpack $ printPermission $ snd x)]) perms [1 :: Integer ..]++instance ResponseIteratee r AddPermissionResponse where+ type ResponseMetadata AddPermissionResponse = SqsMetadata+ responseIteratee _ = sqsXmlResponseIteratee parse+ where+ parse _ = do+ return AddPermissionResponse {}+ +instance SignQuery AddPermission where + type Info AddPermission = SqsInfo+ signQuery AddPermission {..} = sqsSignQuery SqsQuery {+ sqsQueueName = Just apQueueName, + sqsQuery = [("Action", Just "AddPermission"), + ("QueueName", Just $ B.pack $ T.unpack $ printQueueName apQueueName),+ ("Label", Just $ B.pack $ T.unpack apLabel)] ++ formatPermissions apPermissions}++instance Transaction AddPermission AddPermissionResponse
+ Aws/Sqs/Commands/ChangeMessageVisibility.hs view
@@ -0,0 +1,39 @@+{-# LANGUAGE RecordWildCards, TypeFamilies, FlexibleInstances, MultiParamTypeClasses, OverloadedStrings, TupleSections #-}++module Aws.Sqs.Commands.ChangeMessageVisibility where++import Aws.Response+import Aws.Sqs.Info+import Aws.Sqs.Metadata+import qualified Aws.Sqs.Model as M+import Aws.Sqs.Query+import Aws.Sqs.Response+import Aws.Signature+import Aws.Transaction+import qualified Data.Text.Encoding as TE+import qualified Data.ByteString.Char8 as B++data ChangeMessageVisibility = ChangeMessageVisibility {+ cmvReceiptHandle :: M.ReceiptHandle,+ cmvVisibilityTimeout :: Int,+ cmvQueueName :: M.QueueName+}deriving (Show)++data ChangeMessageVisibilityResponse = ChangeMessageVisibilityResponse{+} deriving (Show)++instance ResponseIteratee r ChangeMessageVisibilityResponse where+ type ResponseMetadata ChangeMessageVisibilityResponse = SqsMetadata+ responseIteratee _ = sqsXmlResponseIteratee parse+ where + parse _ = do return ChangeMessageVisibilityResponse{}+ +instance SignQuery ChangeMessageVisibility where + type Info ChangeMessageVisibility = SqsInfo+ signQuery ChangeMessageVisibility {..} = sqsSignQuery SqsQuery { + sqsQueueName = Just cmvQueueName, + sqsQuery = [("Action", Just "ChangeMessageVisibility"), + ("ReceiptHandle", Just $ TE.encodeUtf8 $ M.printReceiptHandle cmvReceiptHandle),+ ("VisibilityTimeout", Just $ B.pack $ show cmvVisibilityTimeout)]}++instance Transaction ChangeMessageVisibility ChangeMessageVisibilityResponse
+ Aws/Sqs/Commands/CreateQueue.hs view
@@ -0,0 +1,49 @@+{-# LANGUAGE RecordWildCards, TypeFamilies, FlexibleInstances, MultiParamTypeClasses, OverloadedStrings, TupleSections #-}++module Aws.Sqs.Commands.CreateQueue where++import Aws.Response+import Aws.Sqs.Info+import Aws.Sqs.Metadata+import Aws.Sqs.Query+import Aws.Sqs.Response+import Aws.Signature+import Aws.Transaction+import Aws.Xml+import Control.Applicative+import Data.Maybe+import Text.XML.Enumerator.Cursor (($//), (&/))+import qualified Data.Text as T+import qualified Data.Text.Encoding as TE+import qualified Text.XML.Enumerator.Cursor as Cu+import qualified Data.ByteString.Char8 as B++data CreateQueue = CreateQueue{+ cqDefaultVisibilityTimeout :: Maybe Int,+ cqQueueName :: T.Text+}deriving (Show)++data CreateQueueResponse = CreateQueueResponse{+ cqrQueueUrl :: T.Text+} deriving (Show)+++instance ResponseIteratee r CreateQueueResponse where+ type ResponseMetadata CreateQueueResponse = SqsMetadata+ responseIteratee _ = sqsXmlResponseIteratee parse+ where + parse el = do + url <- force "Missing Queue Url" $ el $// Cu.laxElement "QueueUrl" &/ Cu.content+ return CreateQueueResponse{ cqrQueueUrl = url}+ +instance SignQuery CreateQueue where + type Info CreateQueue = SqsInfo+ signQuery CreateQueue {..} = sqsSignQuery SqsQuery {+ sqsQueueName = Nothing, + sqsQuery = [("Action", Just "CreateQueue"), + ("QueueName", Just $ TE.encodeUtf8 cqQueueName)] ++ + catMaybes [("DefaultVisibilityTimeout",) <$> case cqDefaultVisibilityTimeout of+ Just x -> Just $ Just $ B.pack $ show x+ Nothing -> Nothing]}++instance Transaction CreateQueue CreateQueueResponse
+ Aws/Sqs/Commands/DeleteMessage.hs view
@@ -0,0 +1,38 @@+{-# LANGUAGE RecordWildCards, TypeFamilies, FlexibleInstances, MultiParamTypeClasses, OverloadedStrings, TupleSections #-}++module Aws.Sqs.Commands.DeleteMessage where++import Aws.Response+import Aws.Sqs.Info+import Aws.Sqs.Metadata+import qualified Aws.Sqs.Model as M+import Aws.Sqs.Query+import Aws.Sqs.Response+import Aws.Signature+import Aws.Transaction+import qualified Data.Text.Encoding as TE++data DeleteMessage = DeleteMessage{+ dmReceiptHandle :: M.ReceiptHandle,+ dmQueueName :: M.QueueName +}deriving (Show)++data DeleteMessageResponse = DeleteMessageResponse{+} deriving (Show)++instance ResponseIteratee r DeleteMessageResponse where+ type ResponseMetadata DeleteMessageResponse = SqsMetadata+ responseIteratee _ = sqsXmlResponseIteratee parse+ where+ parse _ = do return DeleteMessageResponse {}+ +instance SignQuery DeleteMessage where + type Info DeleteMessage = SqsInfo+ signQuery DeleteMessage {..} = sqsSignQuery SqsQuery {+ sqsQueueName = Just dmQueueName, + sqsQuery = [("Action", Just "DeleteMessage"), + ("ReceiptHandle", Just $ TE.encodeUtf8 $ M.printReceiptHandle dmReceiptHandle )]} ++instance Transaction DeleteMessage DeleteMessageResponse++
+ Aws/Sqs/Commands/DeleteQueue.hs view
@@ -0,0 +1,33 @@+{-# LANGUAGE RecordWildCards, TypeFamilies, FlexibleInstances, MultiParamTypeClasses, OverloadedStrings, TupleSections #-}++module Aws.Sqs.Commands.DeleteQueue where++import Aws.Response+import Aws.Sqs.Info+import Aws.Sqs.Metadata+import qualified Aws.Sqs.Model as M+import Aws.Sqs.Query+import Aws.Sqs.Response+import Aws.Signature+import Aws.Transaction++data DeleteQueue = DeleteQueue{+ dqQueueName :: M.QueueName +}deriving (Show)++data DeleteQueueResponse = DeleteQueueResponse{+} deriving (Show)++instance ResponseIteratee r DeleteQueueResponse where+ type ResponseMetadata DeleteQueueResponse = SqsMetadata+ responseIteratee _ = sqsXmlResponseIteratee parse+ where+ parse _ = do return DeleteQueueResponse{}+ +instance SignQuery DeleteQueue where + type Info DeleteQueue = SqsInfo+ signQuery DeleteQueue {..} = sqsSignQuery SqsQuery {+ sqsQueueName = Just dqQueueName, + sqsQuery = [("Action", Just "DeleteQueue")]}++instance Transaction DeleteQueue DeleteQueueResponse
+ Aws/Sqs/Commands/GetQueueAttributes.hs view
@@ -0,0 +1,56 @@+{-# LANGUAGE RecordWildCards, TypeFamilies, FlexibleInstances, MultiParamTypeClasses, OverloadedStrings, TupleSections #-}++module Aws.Sqs.Commands.GetQueueAttributes where++import Aws.Response+import Aws.Sqs.Info+import Aws.Sqs.Metadata+import qualified Aws.Sqs.Model as M+import Aws.Sqs.Query+import Aws.Sqs.Response+import Aws.Signature+import Aws.Transaction+import Aws.Xml+import Text.XML.Enumerator.Cursor (($/), ($//), (&/), (&|))+import qualified Data.Text as T+import qualified Text.XML.Enumerator.Cursor as Cu+import qualified Data.ByteString.Char8 as B++data GetQueueAttributes = GetQueueAttributes {+ gqaQueueName :: M.QueueName,+ gqaAttributes :: [M.QueueAttribute]+}deriving (Show)++data GetQueueAttributesResponse = GetQueueAttributesResponse{+ gqarAttributes :: [(M.QueueAttribute,T.Text)]+} deriving (Show)++parseAttributes :: Cu.Cursor -> [(M.QueueAttribute, T.Text)]+parseAttributes el = do+ name <- force "Missing Name" $ el $/ Cu.laxElement "Name" &/ Cu.content+ value <- force "Missing Value" $ el $/ Cu.laxElement "Value" &/ Cu.content+ parsedName <- M.parseQueueAttribute name+ return (parsedName, value)++instance ResponseIteratee r GetQueueAttributesResponse where+ type ResponseMetadata GetQueueAttributesResponse = SqsMetadata+ responseIteratee _ = sqsXmlResponseIteratee parse+ where+ parse el = do+ let attributes = concat $ el $// Cu.laxElement "Attribute" &| parseAttributes + return GetQueueAttributesResponse{ gqarAttributes = attributes }+ +formatAttributes :: [M.QueueAttribute] -> [(B.ByteString, Maybe B.ByteString)]+formatAttributes attrs =+ case length attrs of+ 0 -> undefined+ 1 -> [("AttributeName", Just $ B.pack $ T.unpack $ M.printQueueAttribute $ attrs !! 0)]+ _ -> zipWith (\ x y -> ((B.concat ["AttributeName.", B.pack $ show $ y]), Just $ B.pack $ T.unpack $ M.printQueueAttribute x) ) attrs [1 :: Integer ..]+ +instance SignQuery GetQueueAttributes where + type Info GetQueueAttributes = SqsInfo+ signQuery GetQueueAttributes{..} = sqsSignQuery SqsQuery { + sqsQueueName = Just gqaQueueName, + sqsQuery = [("Action", Just "GetQueueAttributes")] ++ (formatAttributes gqaAttributes)}++instance Transaction GetQueueAttributes GetQueueAttributesResponse
+ Aws/Sqs/Commands/ListQueues.hs view
@@ -0,0 +1,45 @@+{-# LANGUAGE RecordWildCards, TypeFamilies, FlexibleInstances, MultiParamTypeClasses, OverloadedStrings, TupleSections #-}++module Aws.Sqs.Commands.ListQueues where++import Aws.Response+import Aws.Sqs.Info+import Aws.Sqs.Metadata+import Aws.Sqs.Query+import Aws.Sqs.Response+import Aws.Signature+import Aws.Transaction+import Control.Applicative+import Data.Maybe+import Text.XML.Enumerator.Cursor (($//), (&/))+import qualified Data.Text as T+import qualified Data.Text.Encoding as TE+import qualified Text.XML.Enumerator.Cursor as Cu++data ListQueues = ListQueues {+ lqQueueNamePrefix :: Maybe T.Text+}deriving (Show)++data ListQueuesResponse = ListQueuesResponse{+ lqrQueueUrls :: [T.Text]+} deriving (Show)++instance ResponseIteratee r ListQueuesResponse where+ type ResponseMetadata ListQueuesResponse = SqsMetadata+ responseIteratee _ = sqsXmlResponseIteratee parse+ where+ parse el = do + let queues = el $// Cu.laxElement "QueueUrl" &/ Cu.content+ return ListQueuesResponse { lqrQueueUrls = queues }+ +instance SignQuery ListQueues where + type Info ListQueues = SqsInfo+ signQuery ListQueues{..} = sqsSignQuery SqsQuery { + sqsQueueName = Nothing, + sqsQuery = [("Action", Just "ListQueues")] ++ catMaybes [+ ("QueueNamePrefix",) <$> case lqQueueNamePrefix of+ Just x -> Just $ Just $ TE.encodeUtf8 x+ Nothing -> Nothing]}++instance Transaction ListQueues ListQueuesResponse+
+ Aws/Sqs/Commands/ReceiveMessage.hs view
@@ -0,0 +1,92 @@+{-# LANGUAGE RecordWildCards, TypeFamilies, FlexibleInstances, MultiParamTypeClasses, OverloadedStrings, TupleSections, FlexibleContexts, ScopedTypeVariables #-}++module Aws.Sqs.Commands.ReceiveMessage where++import Aws.Response+import Aws.Signature+import Aws.Sqs.Info+import Aws.Sqs.Metadata+import Aws.Sqs.Query+import Aws.Sqs.Response+import Aws.Transaction+import Aws.Xml+import Control.Applicative+import Data.Maybe+import Text.XML.Enumerator.Cursor (($/), ($//), (&/), (&|))+import qualified Aws.Sqs.Model as M+import qualified Control.Failure as F+import qualified Data.ByteString.Char8 as B+import qualified Data.Text as T+import qualified Data.Text.Encoding as TE+import qualified Text.XML.Enumerator.Cursor as Cu++data ReceiveMessage + = ReceiveMessage {+ rmVisibilityTimeout :: Maybe Int+ , rmAttributes :: [M.MessageAttribute]+ , rmMaxNumberOfMessages :: Maybe Int+ , rmQueueName :: M.QueueName+ }+ deriving (Show)++data Message+ = Message {+ mMessageId :: T.Text+ , mReceiptHandle :: M.ReceiptHandle+ , mMD5OfBody :: T.Text+ , mBody :: T.Text+ , mAttributes :: [(M.MessageAttribute,T.Text)]+ }+ deriving(Show)++data ReceiveMessageResponse+ = ReceiveMessageResponse {+ rmrMessages :: [Message]+ }+ deriving (Show)++readMessageAttribute :: F.Failure XmlException m => Cu.Cursor -> m (M.MessageAttribute,T.Text)+readMessageAttribute cursor = do+ name <- force "Missing Name" $ cursor $/ Cu.laxElement "Name" &/ Cu.content+ value <- force "Missing Value" $ cursor $/ Cu.laxElement "Value" &/ Cu.content+ parsedName <- M.parseMessageAttribute name+ return (parsedName, value)++readMessage :: Cu.Cursor -> [Message]+readMessage cursor = do+ mid :: T.Text <- force "Missing Message Id" $ cursor $// Cu.laxElement "MessageId" &/ Cu.content+ rh <- force "Missing Reciept Handle" $ cursor $// Cu.laxElement "ReceiptHandle" &/ Cu.content+ md5 <- force "Missing MD5 Signature" $ cursor $// Cu.laxElement "MD5OfBody" &/ Cu.content+ body <- force "Missing Body" $ cursor $// Cu.laxElement "Body" &/ Cu.content+ let attributes :: [(M.MessageAttribute, T.Text)] = concat $ cursor $// Cu.laxElement "Attribute" &| readMessageAttribute+ + return Message{ mMessageId = mid, mReceiptHandle = M.ReceiptHandle rh, mMD5OfBody = md5, mBody = body, mAttributes = attributes}++formatMAttributes :: [M.MessageAttribute] -> [(B.ByteString, Maybe B.ByteString)]+formatMAttributes attrs =+ case length attrs of+ 0 -> []+ 1 -> [("AttributeName", Just $ B.pack $ show $ attrs !! 0)]+ _ -> zipWith (\ x y -> ((B.concat ["AttributeName.", B.pack $ show $ y]), Just $ TE.encodeUtf8 $ M.printMessageAttribute x) ) attrs [1 :: Integer ..]++instance ResponseIteratee r ReceiveMessageResponse where+ type ResponseMetadata ReceiveMessageResponse = SqsMetadata+ responseIteratee _ = sqsXmlResponseIteratee parse+ where + parse el = do+ let messages = concat $ el $// Cu.laxElement "Message" &| readMessage+ return ReceiveMessageResponse{ rmrMessages = messages }+ +instance SignQuery ReceiveMessage where + type Info ReceiveMessage = SqsInfo+ signQuery ReceiveMessage {..} = sqsSignQuery SqsQuery {+ sqsQueueName = Just rmQueueName, + sqsQuery = [("Action", Just "ReceiveMessage")] ++ + catMaybes[("VisibilityTimeout",) <$> case rmVisibilityTimeout of+ Just x -> Just $ Just $ B.pack $ show x+ Nothing -> Nothing,+ ("MaxNumberOfMessages",) <$> case rmMaxNumberOfMessages of+ Just x -> Just $ Just $ B.pack $ show x+ Nothing -> Nothing] ++ formatMAttributes rmAttributes}++instance Transaction ReceiveMessage ReceiveMessageResponse
+ Aws/Sqs/Commands/RemovePermission.hs view
@@ -0,0 +1,41 @@+{-# LANGUAGE RecordWildCards, TypeFamilies, FlexibleInstances, MultiParamTypeClasses, OverloadedStrings, TupleSections #-}++module Aws.Sqs.Commands.RemovePermission where++import Aws.Response+import Aws.Sqs.Info+import Aws.Sqs.Metadata+import qualified Aws.Sqs.Model as M+import Aws.Sqs.Query+import Aws.Sqs.Response+import Aws.Signature+import Aws.Transaction+import qualified Data.Text as T+import qualified Data.Text.Encoding as TE++data RemovePermission = RemovePermission{+ rpLabel :: T.Text,+ rpQueueName :: M.QueueName +}deriving (Show)++data RemovePermissionResponse = RemovePermissionResponse{+} deriving (Show)++instance ResponseIteratee r RemovePermissionResponse where+ type ResponseMetadata RemovePermissionResponse = SqsMetadata+ responseIteratee _ = sqsXmlResponseIteratee parse+ where + parse _ = do+ return RemovePermissionResponse {} + +instance SignQuery RemovePermission where + type Info RemovePermission = SqsInfo+ signQuery RemovePermission {..} = sqsSignQuery SqsQuery {+ sqsQueueName = Just rpQueueName, + sqsQuery = [("Action", Just "RemovePermission"), + ("Label", Just $ TE.encodeUtf8 rpLabel )]} ++instance Transaction RemovePermission RemovePermissionResponse+++
+ Aws/Sqs/Commands/SendMessage.hs view
@@ -0,0 +1,48 @@+{-# LANGUAGE RecordWildCards, TypeFamilies, FlexibleInstances, MultiParamTypeClasses, OverloadedStrings, TupleSections #-}++module Aws.Sqs.Commands.SendMessage where++import Aws.Response+import Aws.Sqs.Info+import Aws.Sqs.Metadata+import qualified Aws.Sqs.Model as M+import Aws.Sqs.Query+import Aws.Sqs.Response+import Aws.Signature+import Aws.Transaction+import Aws.Xml+import Text.XML.Enumerator.Cursor (($//), (&/))+import qualified Data.Text as T+import qualified Data.Text.Encoding as TE+import qualified Text.XML.Enumerator.Cursor as Cu++data SendMessage = SendMessage{+ smMessage :: T.Text,+ smQueueName :: M.QueueName +}deriving (Show)++data SendMessageResponse = SendMessageResponse{+ smrMD5OfMessageBody :: T.Text,+ smrMessageId :: M.MessageId+} deriving (Show)++instance ResponseIteratee r SendMessageResponse where+ type ResponseMetadata SendMessageResponse = SqsMetadata+ responseIteratee _ = sqsXmlResponseIteratee parse+ where + parse el = do+ md5 <- force "Missing MD5 Signature" $ el $// Cu.laxElement "MD5OfMessageBody" &/ Cu.content+ mid <- force "Missing Message Id" $ el $// Cu.laxElement "MessageId" &/ Cu.content+ return SendMessageResponse { smrMD5OfMessageBody = md5, smrMessageId = M.MessageId mid }++instance SignQuery SendMessage where + type Info SendMessage = SqsInfo+ signQuery SendMessage {..} = sqsSignQuery SqsQuery {+ sqsQueueName = Just smQueueName,+ sqsQuery = [("Action", Just "SendMessage"), + ("MessageBody", Just $ TE.encodeUtf8 smMessage )]} ++instance Transaction SendMessage SendMessageResponse+++
+ Aws/Sqs/Commands/SetQueueAttributes.hs view
@@ -0,0 +1,40 @@+{-# LANGUAGE RecordWildCards, TypeFamilies, FlexibleInstances, MultiParamTypeClasses, OverloadedStrings, TupleSections #-}++module Aws.Sqs.Commands.SetQueueAttributes where++import Aws.Response+import Aws.Sqs.Info+import Aws.Sqs.Metadata+import qualified Aws.Sqs.Model as M+import Aws.Sqs.Query+import Aws.Sqs.Response+import Aws.Signature+import Aws.Transaction+import qualified Data.Text as T+import qualified Data.Text.Encoding as TE++data SetQueueAttributes = SetQueueAttributes{+ sqaAttribute :: M.QueueAttribute,+ sqaValue :: T.Text,+ sqaQueueName :: M.QueueName +}deriving (Show)++data SetQueueAttributesResponse = SetQueueAttributesResponse{+} deriving (Show)++instance ResponseIteratee r SetQueueAttributesResponse where+ type ResponseMetadata SetQueueAttributesResponse = SqsMetadata+ responseIteratee _ = sqsXmlResponseIteratee parse+ where + parse _ = do+ return SetQueueAttributesResponse {}+ +instance SignQuery SetQueueAttributes where + type Info SetQueueAttributes = SqsInfo+ signQuery SetQueueAttributes {..} = sqsSignQuery SqsQuery { + sqsQueueName = Just sqaQueueName,+ sqsQuery = [("Action", Just "SetQueueAttributes"), + ("Attribute.Name", Just $ TE.encodeUtf8 $ M.printQueueAttribute sqaAttribute),+ ("Attribute.Value", Just $ TE.encodeUtf8 sqaValue)]} ++instance Transaction SetQueueAttributes SetQueueAttributesResponse
+ Aws/Sqs/Error.hs view
@@ -0,0 +1,27 @@+{-# LANGUAGE DeriveDataTypeable, MultiParamTypeClasses #-}+module Aws.Sqs.Error where++import Aws.Sqs.Metadata+import Data.Typeable+import qualified Control.Exception as C+import qualified Data.Text as T+import qualified Network.HTTP.Types as HTTP++type ErrorCode = T.Text++data SqsError+ = SqsError {+ sqsStatusCode :: HTTP.Status+ , sqsErrorCode :: ErrorCode+ , sqsErrorType :: T.Text+ , sqsErrorMessage :: T.Text+ , sqsErrorDetail :: Maybe T.Text+ , sqsErrorMetadata :: Maybe SqsMetadata+ }+ | SqsXmlError { + sqsXmlErrorMessage :: T.Text+ , sqsXmlErrorMetadata :: Maybe SqsMetadata+ }+ deriving (Show, Typeable)++instance C.Exception SqsError
+ Aws/Sqs/Info.hs view
@@ -0,0 +1,85 @@+{-# LANGUAGE OverloadedStrings #-}+module Aws.Sqs.Info where++import Aws.Http+import Aws.S3.Model+import Data.Time+import qualified Data.ByteString as B++data SqsAuthorization + = SqsAuthorizationHeader + | SqsAuthorizationQuery+ deriving (Show)++data Endpoint+ = Endpoint {+ endpointHost :: B.ByteString+ , endpointDefaultLocationConstraint :: LocationConstraint+ , endpointAllowedLocationConstraints :: [LocationConstraint]+ }+ deriving (Show)++data SqsInfo+ = SqsInfo {+ sqsProtocol :: Protocol+ , sqsEndpoint :: Endpoint+ , sqsPort :: Int+ , sqsUseUri :: Bool+ , sqsDefaultExpiry :: NominalDiffTime+ }+ deriving (Show)++sqsEndpointUsClassic :: Endpoint+sqsEndpointUsClassic + = Endpoint { + endpointHost = "queue.amazonaws.com"+ , endpointDefaultLocationConstraint = locationUsClassic+ , endpointAllowedLocationConstraints = [locationUsClassic+ , locationUsWest+ , locationEu+ , locationApSouthEast+ , locationApNorthEast]+ }++sqsEndpointUsWest :: Endpoint+sqsEndpointUsWest+ = Endpoint {+ endpointHost = "us-west-1.queue.amazonaws.com"+ , endpointDefaultLocationConstraint = locationUsWest+ , endpointAllowedLocationConstraints = [locationUsWest]+ }++sqsEndpointEu :: Endpoint+sqsEndpointEu+ = Endpoint {+ endpointHost = "eu-west-1.queue.amazonaws.com"+ , endpointDefaultLocationConstraint = locationEu+ , endpointAllowedLocationConstraints = [locationEu]+ }++sqsEndpointApSouthEast :: Endpoint+sqsEndpointApSouthEast+ = Endpoint {+ endpointHost = "ap-southeast-1.queue.amazonaws.com"+ , endpointDefaultLocationConstraint = locationApSouthEast+ , endpointAllowedLocationConstraints = [locationApSouthEast]+ }++sqsEndpointApNorthEast :: Endpoint+sqsEndpointApNorthEast+ = Endpoint {+ endpointHost = "sqs.ap-northeast-1.amazonaws.com"+ , endpointDefaultLocationConstraint = locationApNorthEast+ , endpointAllowedLocationConstraints = [locationApNorthEast]+ }++sqs :: Protocol -> Endpoint -> Bool -> SqsInfo+sqs protocol endpoint uri + = SqsInfo { + sqsProtocol = protocol+ , sqsEndpoint = endpoint+ , sqsPort = defaultPort protocol+ , sqsUseUri = uri+ , sqsDefaultExpiry = 15*60+ }+
+ Aws/Sqs/Metadata.hs view
@@ -0,0 +1,16 @@+module Aws.Sqs.Metadata where++import Control.Monad+import Data.Monoid+import qualified Data.Text as T++data SqsMetadata+ = SqsMetadata {+ sqsMAmzId2 :: Maybe T.Text+ , sqsMRequestId :: Maybe T.Text+ }+ deriving (Show)++instance Monoid SqsMetadata where+ mempty = SqsMetadata Nothing Nothing+ SqsMetadata a1 r1 `mappend` SqsMetadata a2 r2 = SqsMetadata (a1 `mplus` a2) (r1 `mplus` r2)
+ Aws/Sqs/Model.hs view
@@ -0,0 +1,96 @@+{-# LANGUAGE OverloadedStrings, FlexibleContexts #-}+module Aws.Sqs.Model where++import Aws.Xml+import qualified Control.Failure as F+import qualified Data.Text as T++data QueueName = QueueName{+ qName :: T.Text,+ qAccountNumber :: T.Text+} deriving(Show)++printQueueName :: QueueName -> T.Text+printQueueName queue = T.concat ["/", (qAccountNumber queue), "/", (qName queue), "/"]++data QueueAttribute+ = QueueAll+ | ApproximateNumberOfMessages+ | ApproximateNumberOfMessagesNotVisible+ | VisibilityTimeout+ | CreatedTimestamp+ | LastModifiedTimestamp+ | Policy+ | MaximumMessageSize+ | MessageRetentionPeriod+ | QueueArn+ deriving(Show, Enum, Eq)++data MessageAttribute+ = MessageAll+ | SenderId+ | SentTimestamp+ | ApproximateReceiveCount+ | ApproximateFirstReceiveTimestamp+ deriving(Show,Eq,Enum)++data SqsPermission+ = PermissionAll+ | SendMessage+ | ReceiveMessage+ | DeleteMessage+ | ChangeMessageVisibility+ | GetQueueAttributes+ deriving (Show, Enum, Eq)++parseQueueAttribute :: F.Failure XmlException m => T.Text -> m QueueAttribute+parseQueueAttribute "ApproximateNumberOfMessages" = return ApproximateNumberOfMessages +parseQueueAttribute "ApproximateNumberOfMessagesNotVisible" = return ApproximateNumberOfMessagesNotVisible+parseQueueAttribute "VisibilityTimeout" = return VisibilityTimeout+parseQueueAttribute "CreatedTimestamp" = return CreatedTimestamp+parseQueueAttribute "LastModifiedTimestamp" = return LastModifiedTimestamp+parseQueueAttribute "Policy" = return Policy+parseQueueAttribute "MaximumMessageSize" = return MaximumMessageSize+parseQueueAttribute "MessageRetentionPeriod" = return MessageRetentionPeriod+parseQueueAttribute "QueueArn" = return QueueArn+parseQueueAttribute x = F.failure $ XmlException ( "Invalid Attribute Name. " ++ show x)++printQueueAttribute :: QueueAttribute -> T.Text+printQueueAttribute QueueAll = "All"+printQueueAttribute ApproximateNumberOfMessages = "ApproximateNumberOfMessages"+printQueueAttribute ApproximateNumberOfMessagesNotVisible = "ApproximateNumberOfMessagesNotVisible"+printQueueAttribute VisibilityTimeout = "VisibilityTimeout"+printQueueAttribute CreatedTimestamp = "CreatedTimestamp"+printQueueAttribute LastModifiedTimestamp = "LastModifiedTimestamp"+printQueueAttribute Policy = "Policy"+printQueueAttribute MaximumMessageSize = "MaximumMessageSize"+printQueueAttribute MessageRetentionPeriod = "MessageRetentionPeriod"+printQueueAttribute QueueArn = "QueueArn"++parseMessageAttribute :: F.Failure XmlException m => T.Text -> m MessageAttribute+parseMessageAttribute "SenderId" = return SenderId+parseMessageAttribute "SentTimestamp" = return SentTimestamp+parseMessageAttribute "ApproximateReceiveCount" = return ApproximateReceiveCount+parseMessageAttribute "ApproximateFirstReceiveTimestamp" = return ApproximateFirstReceiveTimestamp+parseMessageAttribute x = F.failure $ XmlException ( "Invalid Attribute Name. " ++ show x)++printMessageAttribute :: MessageAttribute -> T.Text+printMessageAttribute MessageAll = "All"+printMessageAttribute SenderId = "SenderId"+printMessageAttribute SentTimestamp = "SentTimestamp"+printMessageAttribute ApproximateReceiveCount = "ApproximateReceiveCount"+printMessageAttribute ApproximateFirstReceiveTimestamp = "ApproximateFirstReceiveTimestamp"++printPermission :: SqsPermission -> T.Text+printPermission PermissionAll = "*"+printPermission SendMessage = "SendMessage"+printPermission ReceiveMessage = "ReceiveMessage"+printPermission DeleteMessage = "DeleteMessage"+printPermission ChangeMessageVisibility = "ChangeMessageVisibility"+printPermission GetQueueAttributes = "GetQueueAttributes"++newtype ReceiptHandle = ReceiptHandle T.Text deriving(Show,Eq)+newtype MessageId = MessageId T.Text deriving(Show,Eq)++printReceiptHandle :: ReceiptHandle -> T.Text+printReceiptHandle (ReceiptHandle handle) = handle
+ Aws/Sqs/Query.hs view
@@ -0,0 +1,69 @@+{-# LANGUAGE OverloadedStrings,RecordWildCards #-}++module Aws.Sqs.Query where++import Aws.Credentials+import Aws.Http+import Aws.Query+import Aws.Sqs.Info+import Aws.Sqs.Model+import Aws.Signature+import Data.List+import Data.Monoid+import Data.Ord+import Data.Time+import System.Locale+import qualified Blaze.ByteString.Builder as Blaze+import qualified Blaze.ByteString.Builder.Char8 as Blaze8+import qualified Data.ByteString.Char8 as BC+import qualified Data.Text.Encoding as TE+import qualified Network.HTTP.Types as HTTP++data SqsQuery = SqsQuery{+ sqsQueueName :: Maybe QueueName,+ sqsQuery :: HTTP.Query+}++sqsSignQuery :: SqsQuery -> SqsInfo -> SignatureData -> SignedQuery+sqsSignQuery SqsQuery{..} SqsInfo{..} SignatureData{..}+ = SignedQuery {+ sqMethod = method+ , sqProtocol = sqsProtocol+ , sqHost = endpointHost sqsEndpoint+ , sqPort = sqsPort+ , sqPath = path+ , sqQuery = signedQuery+ , sqDate = Just signatureTime+ , sqAuthorization = Nothing + , sqBody = Nothing+ , sqStringToSign = stringToSign+ , sqContentType = Nothing+ , sqContentMd5 = Nothing+ , sqAmzHeaders = []+ }+ where+ method = PostQuery+ path = case sqsQueueName of+ Just x -> TE.encodeUtf8 $ printQueueName x+ Nothing -> "/"+ expandedQuery = sortBy (comparing fst) + ( sqsQuery ++ [ ("AWSAccessKeyId", Just(accessKeyID signatureCredentials)), + ("Expires", Just(BC.pack expiresString)), + ("SignatureMethod", Just("HmacSHA256")), ("SignatureVersion",Just("2")), ("Version",Just("2009-02-01"))++ ])+ + expires = AbsoluteExpires $ sqsDefaultExpiry `addUTCTime` signatureTime++ expiresString = formatTime defaultTimeLocale "%FT%TZ" (fromAbsoluteTimeInfo expires)++ sig = signature signatureCredentials HmacSHA256 stringToSign+ stringToSign = Blaze.toByteString . mconcat . intersperse (Blaze8.fromChar '\n') . concat $+ [[Blaze.copyByteString $ httpMethod method]+ , [Blaze.copyByteString $ endpointHost sqsEndpoint]+ , [Blaze.copyByteString path]+ , [Blaze.copyByteString $ HTTP.renderQuery False expandedQuery ]]++ signedQuery = expandedQuery ++ (HTTP.simpleQueryToQuery $ makeAuthQuery)++ makeAuthQuery = [("Signature", sig)]
+ Aws/Sqs/Response.hs view
@@ -0,0 +1,66 @@+{-# LANGUAGE FlexibleInstances, OverloadedStrings, ScopedTypeVariables, RecordWildCards #-}+module Aws.Sqs.Response where++import Aws.Response+import Aws.Sqs.Error+import Aws.Sqs.Metadata+import Aws.Xml+import Control.Monad.IO.Class+import Data.Attempt (Attempt(..))+import Data.Enumerator ((=$))+import Data.IORef+import Data.Maybe+import Text.XML.Enumerator.Cursor (($/))+import qualified Data.ByteString as B+import qualified Data.Enumerator as En+import qualified Data.Text.Encoding as T+import qualified Network.HTTP.Types as HTTP+import qualified Text.XML.Enumerator.Cursor as Cu+import qualified Text.XML.Enumerator.Parse as XML+import qualified Text.XML.Enumerator.Resolved as XML++sqsResponseIteratee ::+ (HTTP.Status -> HTTP.ResponseHeaders -> En.Iteratee B.ByteString IO a)+ -> IORef SqsMetadata+ -> HTTP.Status -> HTTP.ResponseHeaders -> En.Iteratee B.ByteString IO a+sqsResponseIteratee inner metadata status headers = do+ let headerString = fmap T.decodeUtf8 . flip lookup headers+ let amzId2 = headerString "x-amz-id-2"+ let requestId = headerString "x-amz-request-id"+ + let m = SqsMetadata { sqsMAmzId2 = amzId2, sqsMRequestId = requestId }+ liftIO $ tellMetadataRef metadata m+ + if status >= HTTP.status400+ then sqsErrorResponseIteratee status headers+ else inner status headers++sqsXmlResponseIteratee :: + (Cu.Cursor -> Response SqsMetadata a)+ -> IORef SqsMetadata+ -> HTTP.Status -> HTTP.ResponseHeaders -> En.Iteratee B.ByteString IO a+sqsXmlResponseIteratee parse metadataRef = sqsResponseIteratee (xmlCursorIteratee parse metadataRef) metadataRef++sqsErrorResponseIteratee :: HTTP.Status -> HTTP.ResponseHeaders -> En.Iteratee B.ByteString IO a+sqsErrorResponseIteratee status _headers + = do doc <- XML.parseBytes XML.decodeEntities =$ XML.fromEvents+ let cursor = Cu.fromDocument doc+ case parseError cursor of+ Success err -> En.throwError err+ Failure otherErr -> En.throwError otherErr+ where+ parseError :: Cu.Cursor -> Attempt SqsError+ parseError root = do cursor <- force "Missing Error" $ root $/ Cu.laxElement "Error" + code <- force "Missing error Code" $ cursor $/ elContent "Code"+ message <- force "Missing error Message" $ cursor $/ elContent "Message"+ errorType <- force "Missing error Type" $ cursor $/ elContent "Type"+ let detail = listToMaybe $ cursor $/ elContent "Detail"+ + return SqsError {+ sqsStatusCode = status+ , sqsErrorCode = code+ , sqsErrorMessage = message+ , sqsErrorType = errorType+ , sqsErrorDetail = detail+ , sqsErrorMetadata = Nothing+ }
Aws/Transaction.hs view
@@ -6,5 +6,5 @@ import Aws.Signature import Data.Monoid -class (SignQuery r, ResponseIteratee a, Monoid (ResponseMetadata a))+class (SignQuery r, ResponseIteratee r a, Monoid (ResponseMetadata a)) => Transaction r a | r -> a, a -> r
Aws/Util.hs view
@@ -6,12 +6,13 @@ import Control.Arrow import Control.Exception import Data.ByteString.Char8 ({- IsString -})+import Data.Char import Data.Time+import Data.Word import System.Locale import qualified Data.ByteString as B+import qualified Data.ByteString.UTF8 as BU import qualified Data.Enumerator as En-import qualified Data.Text as T-import qualified Data.Text.Encoding as T tryError :: (Exception e, Monad m) => En.Iteratee a m b -> En.Iteratee a m (Either e b) tryError m = En.catchError (fmap Right m) h@@ -21,9 +22,9 @@ 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 . T.encodeUtf8 . T.pack . show) [(1 :: Int) ..]+ where prefixList = map (dot prefix . BU.fromString . show) [(1 :: Int) ..] combine pf = map $ first (pf `dot`)- dot x y = B.concat [x, ".", y]+ dot x y = B.concat [x, BU.fromString ".", y] awsBool :: Bool -> B.ByteString awsBool True = "true"@@ -36,19 +37,24 @@ awsFalse = awsBool False fmtTime :: String -> UTCTime -> B.ByteString-fmtTime s t = T.encodeUtf8 . T.pack $ formatTime defaultTimeLocale s t--rfc822Time :: String-rfc822Time = "%a, %_d %b %Y %H:%M:%S GMT"+fmtTime s t = BU.fromString $ formatTime defaultTimeLocale s t fmtRfc822Time :: UTCTime -> B.ByteString-fmtRfc822Time = fmtTime rfc822Time--amzTime :: String-amzTime = "%Y-%m-%dT%H:%M:%S"+fmtRfc822Time = fmtTime "%a, %_d %b %Y %H:%M:%S GMT" fmtAmzTime :: UTCTime -> B.ByteString-fmtAmzTime = fmtTime amzTime+fmtAmzTime = fmtTime "%Y-%m-%dT%H:%M:%S" fmtTimeEpochSeconds :: UTCTime -> B.ByteString fmtTimeEpochSeconds = fmtTime "%s"++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
aws.cabal view
@@ -6,7 +6,7 @@ -- The package version. See the Haskell package versioning policy -- (http://www.haskell.org/haskellwiki/Package_versioning_policy) for -- standards guiding when and how versions should be incremented.-Version: 0.0.5+Version: 0.0.6 -- A short (one-line) description of the package. Synopsis: Amazon Web Services (AWS) for Haskell@@ -57,9 +57,12 @@ Aws.Response, Aws.S3, Aws.S3.Commands,+ Aws.S3.Commands.DeleteObject, Aws.S3.Commands.GetBucket,+ Aws.S3.Commands.GetObject, Aws.S3.Commands.GetService, Aws.S3.Commands.PutBucket,+ Aws.S3.Commands.PutObject, Aws.S3.Error, Aws.S3.Info, Aws.S3.Metadata,@@ -85,6 +88,25 @@ Aws.SimpleDb.Model, Aws.SimpleDb.Query, Aws.SimpleDb.Response,+ Aws.Sqs,+ Aws.Sqs.Commands,+ Aws.Sqs.Commands.AddPermission,+ Aws.Sqs.Commands.DeleteMessage,+ Aws.Sqs.Commands.DeleteQueue,+ Aws.Sqs.Commands.ListQueues,+ Aws.Sqs.Commands.GetQueueAttributes,+ Aws.Sqs.Commands.ChangeMessageVisibility,+ Aws.Sqs.Commands.CreateQueue,+ Aws.Sqs.Commands.ReceiveMessage,+ Aws.Sqs.Commands.RemovePermission,+ Aws.Sqs.Commands.SendMessage,+ Aws.Sqs.Commands.SetQueueAttributes,+ Aws.Sqs.Error,+ Aws.Sqs.Info,+ Aws.Sqs.Metadata,+ Aws.Sqs.Model,+ Aws.Sqs.Query,+ Aws.Sqs.Response, Aws.Transaction, Aws.Util, Aws.Xml@@ -105,16 +127,18 @@ enumerator ==0.4.*, failure >=0.1.0.1 && <0.2, filepath >=1.1 && <1.3,- http-enumerator >=0.6.5.5 && < 0.7,+ http-enumerator >=0.6.7 && < 0.7, http-types >=0.6 && <0.7, mtl ==2.*, old-locale ==1.*, shortcircuit ==0.1.*,- text >=0.11 && <0.12,+ text >= 0.11, time >=1.1.4 && <1.3,- tls >=0.7.1 && <0.8,+ tls >= 0.7.1, transformers >=0.2.2.0 && <0.3,- xml-enumerator >=0.3.4 && <0.4+ transformers-compose ==0.1.*,+ utf8-string ==0.3.*,+ xml-enumerator >= 0.3.4 GHC-Options: -Wall @@ -123,15 +147,4 @@ -- Extra tools (e.g. alex, hsc2hs, ...) needed to build the source. -- Build-tools: ----- Source repository-source-repository head- type: git- location: git://github.com/aristidb/aws.git- branch: master--source-repository this- type: git- location: git://github.com/aristidb/aws.git- tag: 0.0.4+