aws 0.8.6 → 0.9
raw patch · 15 files changed
+117/−133 lines, 15 filesdep +byteabledep +conduit-extradep +ghc-primdep −attemptdep −attoparsec-conduitdep −crypto-apidep ~basedep ~conduitdep ~cryptohash
Dependencies added: byteable, conduit-extra, ghc-prim
Dependencies removed: attempt, attoparsec-conduit, crypto-api, cryptohash-cryptoapi, failure
Dependency ranges changed: base, conduit, cryptohash, http-conduit, resourcet, xml-conduit
Files
- Aws/Aws.hs +4/−8
- Aws/Core.hs +38/−43
- Aws/DynamoDb/Core.hs +6/−9
- Aws/Ec2/InstanceMetadata.hs +2/−2
- Aws/Iam/Core.hs +5/−5
- Aws/Iam/Internal.hs +2/−2
- Aws/S3/Commands/CopyObject.hs +2/−2
- Aws/S3/Commands/DeleteObjects.hs +2/−2
- Aws/S3/Commands/PutObject.hs +2/−3
- Aws/S3/Core.hs +20/−22
- Aws/Ses/Core.hs +2/−2
- Aws/SimpleDb/Core.hs +8/−8
- Aws/Sqs/Commands/Message.hs +2/−2
- Aws/Sqs/Core.hs +8/−10
- aws.cabal +14/−13
Aws/Aws.hs view
@@ -33,7 +33,6 @@ import Control.Monad.IO.Class import Control.Monad.Trans import Control.Monad.Trans.Resource-import Data.Attempt (Attempt(Success, Failure)) import qualified Data.ByteString as B import qualified Data.CaseInsensitive as CI import qualified Data.Conduit as C@@ -185,11 +184,8 @@ unsafeAws cfg scfg manager request = do metadataRef <- liftIO $ newIORef mempty - let catchAll :: ResourceT IO a -> ResourceT IO (Attempt a)- catchAll = E.handle (return . failure') . fmap Success-- failure' :: E.SomeException -> Attempt a- failure' = Failure+ 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@@ -268,8 +264,8 @@ where go request = do resp <- lift $ aws cfg scfg manager request C.yield resp case responseResult resp of- Failure _ -> return ()- Success x ->+ Left _ -> return ()+ Right x -> case nextIteratedRequest request x of Nothing -> return () Just nextRequest -> go nextRequest
Aws/Core.hs view
@@ -89,13 +89,11 @@ import Control.Applicative import Control.Arrow import qualified Control.Exception as E-import qualified Control.Failure as F import Control.Monad import Control.Monad.IO.Class-import qualified Crypto.Classes as Crypto-import qualified Crypto.HMAC as HMAC-import Crypto.Hash.CryptoAPI (MD5, SHA1, SHA256, hash')-import Data.Attempt (Attempt(..), FromAttempt(..))+import Control.Monad.Trans.Resource (ResourceT, MonadThrow (throwM))+import Crypto.Hash+import Data.Byteable import Data.ByteString (ByteString) import qualified Data.ByteString as B import qualified Data.ByteString.Base16 as Base16@@ -104,7 +102,7 @@ import qualified Data.ByteString.Lazy as L import qualified Data.ByteString.UTF8 as BU import Data.Char-import Data.Conduit (ResourceT, ($$+-))+import Data.Conduit (($$+-)) import qualified Data.Conduit as C import qualified Data.Conduit.List as CL import Data.Default (def)@@ -112,7 +110,6 @@ import Data.List import Data.Maybe import Data.Monoid-import qualified Data.Serialize as Serialize import qualified Data.Text as T import qualified Data.Text.Encoding as T import qualified Data.Text.IO as T@@ -137,12 +134,12 @@ -- -- Response forms a Writer-like monad. data Response m a = Response { responseMetadata :: m- , responseResult :: Attempt a }+ , responseResult :: Either E.SomeException a } deriving (Show, Functor) -- | Read a response result (if it's a success response, fail otherwise).-readResponse :: FromAttempt f => Response m a -> f a-readResponse = fromAttempt . responseResult+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@@ -159,13 +156,13 @@ --multiResponse :: Monoid m => Response m a -> Response [m] a -> instance Monoid m => Monad (Response m) where- return x = Response mempty (Success x)- Response m1 (Failure e) >>= _ = Response m1 (Failure e)- Response m1 (Success x) >>= f = let Response m2 y = f x+ return x = Response mempty (Right x)+ 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, E.Exception e) => F.Failure e (Response m) where- failure e = Response mempty (F.failure e)+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 ()@@ -355,7 +352,7 @@ -- | Request body content type. , sqContentType :: Maybe B.ByteString -- | Request body content MD5.- , sqContentMd5 :: Maybe MD5+ , sqContentMd5 :: Maybe (Digest MD5) -- | Additional Amazon "amz" headers. , sqAmzHeaders :: HTTP.RequestHeaders -- | Additional non-"amz" headers.@@ -390,7 +387,7 @@ , HTTP.queryString = 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 $ Serialize.encode md5)) sqContentMd5+ , fmap (\md5 -> ("Content-MD5", Base64.encode $ toBytes md5)) sqContentMd5 , fmap (\auth -> ("Authorization", auth)) mauth] ++ sqAmzHeaders ++ sqOtherHeaders@@ -497,12 +494,10 @@ signature cr ah input = Base64.encode sig where sig = case ah of- HmacSHA1 -> computeSig (undefined :: SHA1)- HmacSHA256 -> computeSig (undefined :: SHA256)- computeSig :: Crypto.Hash c d => d -> B.ByteString- computeSig t = Serialize.encode (HMAC.hmac' key input `asTypeOf` t)- key :: HMAC.MacKey c d- key = HMAC.MacKey (secretAccessKey cr)+ HmacSHA1 -> computeSig SHA1+ HmacSHA256 -> computeSig SHA256+ computeSig :: HashAlgorithm a => a -> ByteString+ computeSig t = toBytes (hmacAlg t (secretAccessKey cr) input) -- | 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@@ -517,12 +512,12 @@ authorizationV4 sd ah region service headers canonicalRequest = do let ref = v4SigningKeys $ signatureCredentials sd date = fmtTime "%Y%m%d" $ signatureTime sd- hmac k i = case ah of- HmacSHA1 -> Serialize.encode (HMAC.hmac' (HMAC.MacKey k) i :: SHA1)- HmacSHA256 -> Serialize.encode (HMAC.hmac' (HMAC.MacKey k) i :: SHA256)- hash i = case ah of- HmacSHA1 -> Serialize.encode (hash' i :: SHA1)- HmacSHA256 -> Serialize.encode (hash' i :: SHA256)+ mkHmac k i = case ah of+ HmacSHA1 -> toBytes (hmac k i :: HMAC SHA1)+ HmacSHA256 -> toBytes (hmac k i :: HMAC SHA256)+ mkHash i = case ah of+ HmacSHA1 -> toBytes (hash i :: Digest SHA1)+ HmacSHA256 -> toBytes (hash i :: Digest SHA256) alg = case ah of HmacSHA1 -> "AWS4-HMAC-SHA1" HmacSHA256 -> "AWS4-HMAC-SHA256"@@ -539,16 +534,16 @@ Just k -> return k Nothing -> atomicModifyIORef ref $ \keylist -> let secretKey = secretAccessKey $ signatureCredentials sd- kDate = hmac ("AWS4" <> secretKey) date- kRegion = hmac kDate region- kService = hmac kRegion service- kSigning = hmac kService "aws4_request"+ kDate = mkHmac ("AWS4" <> secretKey) date+ kRegion = mkHmac kDate region+ kService = mkHmac kRegion service+ kSigning = mkHmac kService "aws4_request" lstK = (region,service) keylist' = (lstK,(date,kSigning)) : filter ((lstK/=).fst) keylist in (keylist', kSigning) -- now do the signature- let canonicalRequestHash = Base16.encode $ hash canonicalRequest+ let canonicalRequestHash = Base16.encode $ mkHash canonicalRequest stringToSign = B.concat [ alg , "\n" , fmtTime "%Y%m%dT%H%M%SZ" $ signatureTime sd@@ -561,7 +556,7 @@ , "/aws4_request\n" , canonicalRequestHash ]- sig = Base16.encode $ hmac key stringToSign+ sig = Base16.encode $ mkHmac key stringToSign -- finally, return the header return $ B.concat [ alg@@ -696,24 +691,24 @@ 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 :: F.Failure XmlException m => String -> [a] -> m a+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 :: F.Failure XmlException m => String -> [m a] -> m a+forceM :: MonadThrow m => String -> [m a] -> m a forceM = Cu.forceM . XmlException -- | Read an integer from a 'T.Text', throwing an 'XmlException' on failure.-textReadInt :: (F.Failure XmlException m, Num a) => T.Text -> m a+textReadInt :: (MonadThrow m, Num a) => T.Text -> m a textReadInt s = case reads $ T.unpack s of [(n,"")] -> return $ fromInteger n- _ -> F.failure $ XmlException "Invalid Integer"+ _ -> throwM $ XmlException "Invalid Integer" -- | Read an integer from a 'String', throwing an 'XmlException' on failure.-readInt :: (F.Failure XmlException m, Num a) => String -> m a+readInt :: (MonadThrow m, Num a) => String -> m a readInt s = case reads s of [(n,"")] -> return $ fromInteger n- _ -> F.failure $ XmlException "Invalid Integer"+ _ -> throwM $ XmlException "Invalid Integer" -- | Create a complete 'HTTPResponseConsumer' from a simple function that takes a 'Cu.Cursor' to XML in the response -- body.@@ -731,5 +726,5 @@ let Response metadata x = parse cursor liftIO $ tellMetadataRef metadataRef metadata case x of- Failure err -> liftIO $ C.monadThrow err- Success v -> return v+ Left err -> liftIO $ throwM err+ Right v -> return v
Aws/DynamoDb/Core.hs view
@@ -2,16 +2,16 @@ import Aws.Core import qualified Control.Exception as C-import Crypto.Hash.CryptoAPI (SHA256, hash)+import Control.Monad.Trans.Resource (throwM)+import Crypto.Hash+import Data.Byteable import qualified Data.Aeson as A import qualified Data.ByteString as B import qualified Data.ByteString.Base16 as Base16-import qualified Data.ByteString.Lazy as BL import Data.Conduit import qualified Data.Conduit.Attoparsec as Atto import Data.Monoid import Data.Typeable-import qualified Data.Serialize as Serialize import qualified Network.HTTP.Conduit as HTTP import qualified Network.HTTP.Types as HTTP @@ -88,11 +88,8 @@ where sigTime = fmtTime "%Y%m%dT%H%M%SZ" $ signatureTime sd - hash256 :: BL.ByteString -> SHA256- hash256 = hash- bodyLBS = A.encode body- bodyHash = Base16.encode $ Serialize.encode $ hash256 bodyLBS+ bodyHash = Base16.encode $ toBytes (hashlazy bodyLBS :: Digest SHA256) canonicalRequest = B.concat [ "POST\n" , "/\n"@@ -125,5 +122,5 @@ (HTTP.Status{HTTP.statusCode=200}) -> do case A.fromJSON val of A.Success a -> return a- A.Error err -> monadThrow $ DyError (HTTP.responseStatus resp) "" err- _ -> monadThrow $ DyError (HTTP.responseStatus resp) "" (show val)+ A.Error err -> throwM $ DyError (HTTP.responseStatus resp) "" err+ _ -> throwM $ DyError (HTTP.responseStatus resp) "" (show val)
Aws/Ec2/InstanceMetadata.hs view
@@ -2,7 +2,7 @@ import Control.Applicative import Control.Exception-import Control.Failure+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@@ -25,7 +25,7 @@ getInstanceMetadataFirst :: HTTP.Manager -> String -> IO L.ByteString getInstanceMetadataFirst mgr p = do listing <- getInstanceMetadataListing mgr p case listing of- [] -> failure (MetadataNotFound p)+ [] -> throwM (MetadataNotFound p) (x:_) -> getInstanceMetadata mgr p x getInstanceMetadataOrFirst :: HTTP.Manager -> String -> Maybe String -> IO L.ByteString
Aws/Iam/Core.hs view
@@ -19,8 +19,8 @@ import qualified Blaze.ByteString.Builder as Blaze import qualified Blaze.ByteString.Builder.Char8 as Blaze8 import Control.Exception (Exception)-import qualified Control.Failure as F import Control.Monad+import Control.Monad.Trans.Resource (MonadThrow, throwM) import Data.ByteString (ByteString) import Data.IORef import Data.List (intersperse, sort)@@ -152,13 +152,13 @@ fromError cursor = do errCode <- force "Missing Error Code" $ cursor $// elContent "Code" errMsg <- force "Missing Error Message" $ cursor $// elContent "Message"- F.failure $ IamError (HTTP.responseStatus resp) errCode errMsg+ throwM $ IamError (HTTP.responseStatus resp) errCode errMsg -- | Parses IAM @DateTime@ data type.-parseDateTime :: (F.Failure XmlException m) => String -> m UTCTime+parseDateTime :: MonadThrow m => String -> m UTCTime parseDateTime x = case parseTime defaultTimeLocale iso8601UtcDate x of- Nothing -> F.failure $ XmlException $ "Invalid DateTime: " ++ x+ Nothing -> throwM $ XmlException $ "Invalid DateTime: " ++ x Just dt -> return dt -- | The IAM @User@ data type.@@ -180,7 +180,7 @@ deriving (Eq, Ord, Show, Typeable) -- | Parses the IAM @User@ data type.-parseUser :: (F.Failure XmlException m) => Cu.Cursor -> m User+parseUser :: MonadThrow m => Cu.Cursor -> m User parseUser cursor = do userArn <- attr "Arn" userCreateDate <- attr "CreateDate" >>= parseDateTime . Text.unpack
Aws/Iam/Internal.hs view
@@ -15,8 +15,8 @@ import Aws.Iam.Core import Control.Applicative import Control.Arrow (second)-import qualified Control.Failure as F import Control.Monad+import Control.Monad.Trans.Resource (MonadThrow) import Data.ByteString (ByteString) import Data.Maybe import Data.Monoid ((<>))@@ -62,7 +62,7 @@ -- | Reads and returns the @IsTruncated@ and @Marker@ attributes present in -- all IAM data pagination responses. markedIterResponse- :: F.Failure XmlException m+ :: MonadThrow m => Cu.Cursor -> m (Bool, Maybe Text) markedIterResponse cursor = do
Aws/S3/Commands/CopyObject.hs view
@@ -5,7 +5,7 @@ import Aws.S3.Core import Control.Applicative import Control.Arrow (second)-import Control.Failure+import Control.Monad.Trans.Resource (throwM) import qualified Data.CaseInsensitive as CI import Data.Maybe import qualified Data.Text as T@@ -93,7 +93,7 @@ return $ CopyObjectResponse vid lastMod etag where parse el = do let parseHttpDate' x = case parseTime defaultTimeLocale iso8601UtcDate x of- Nothing -> failure $ XmlException ("Invalid Last-Modified " ++ x)+ Nothing -> throwM $ XmlException ("Invalid Last-Modified " ++ x) Just y -> return y lastMod <- forceM "Missing Last-Modified" $ el $/ elContent "LastModified" &| (parseHttpDate' . T.unpack) etag <- force "Missing ETag" $ el $/ elContent "ETag"
Aws/S3/Commands/DeleteObjects.hs view
@@ -11,7 +11,7 @@ import qualified Text.XML as XML import qualified Text.XML.Cursor as Cu import Text.XML.Cursor (($/), (&|))-import qualified Crypto.Classes as C (hash)+import Crypto.Hash import qualified Data.ByteString.Char8 as B import Data.ByteString.Char8 ({- IsString -}) import Control.Applicative ((<$>))@@ -70,7 +70,7 @@ , s3QSubresources = HTTP.toQuery [("delete" :: B.ByteString, Nothing :: Maybe B.ByteString)] , s3QQuery = [] , s3QContentType = Nothing- , s3QContentMd5 = Just $ C.hash dosBody+ , s3QContentMd5 = Just $ hashlazy dosBody , s3QObject = Nothing , s3QAmzHeaders = maybeToList $ (("x-amz-mfa", ) . T.encodeUtf8) <$> dosMultiFactorAuthentication , s3QOtherHeaders = []
Aws/S3/Commands/PutObject.hs view
@@ -6,12 +6,11 @@ import Aws.S3.Core import Control.Applicative import Control.Arrow (second)-import Crypto.Hash.CryptoAPI (MD5)+import Crypto.Hash import Data.ByteString.Char8 ({- IsString -}) import Data.Maybe import qualified Data.ByteString.Char8 as B import qualified Data.CaseInsensitive as CI-import qualified Data.Conduit as C import qualified Data.Text as T import qualified Data.Text.Encoding as T import qualified Network.HTTP.Conduit as HTTP@@ -23,7 +22,7 @@ poCacheControl :: Maybe T.Text, poContentDisposition :: Maybe T.Text, poContentEncoding :: Maybe T.Text,- poContentMD5 :: Maybe MD5,+ poContentMD5 :: Maybe (Digest MD5), poExpires :: Maybe Int, poAcl :: Maybe CannedAcl, poStorageClass :: Maybe StorageClass,
Aws/S3/Core.hs view
@@ -5,8 +5,9 @@ import Control.Arrow ((***)) import Control.Monad import Control.Monad.IO.Class-import Crypto.Hash.CryptoAPI (MD5)-import Data.Attempt (Attempt(..))+import Control.Monad.Trans.Resource (MonadThrow, throwM)+import Crypto.Hash+import Data.Byteable import Data.Conduit (($$+-)) import Data.Function import Data.IORef@@ -20,13 +21,10 @@ import qualified Blaze.ByteString.Builder as Blaze import qualified Blaze.ByteString.Builder.Char8 as Blaze8 import qualified Control.Exception as C-import qualified Control.Failure as F import qualified Data.ByteString as B import qualified Data.ByteString.Char8 as B8 import qualified Data.ByteString.Base64 as Base64 import qualified Data.CaseInsensitive as CI-import qualified Data.Conduit as C-import qualified Data.Serialize as Serialize import qualified Data.Text as T import qualified Data.Text.Encoding as T import qualified Network.HTTP.Conduit as HTTP@@ -140,7 +138,7 @@ , s3QSubresources :: HTTP.Query , s3QQuery :: HTTP.Query , s3QContentType :: Maybe B.ByteString- , s3QContentMd5 :: Maybe MD5+ , s3QContentMd5 :: Maybe (Digest MD5) , s3QAmzHeaders :: HTTP.RequestHeaders , s3QOtherHeaders :: HTTP.RequestHeaders #if MIN_VERSION_http_conduit(2, 0, 0)@@ -199,7 +197,7 @@ sig = signature signatureCredentials HmacSHA1 stringToSign stringToSign = Blaze.toByteString . mconcat . intersperse (Blaze8.fromChar '\n') . concat $ [[Blaze.copyByteString $ httpMethod s3QMethod]- , [maybe mempty (Blaze.copyByteString . Base64.encode . Serialize.encode) s3QContentMd5]+ , [maybe mempty (Blaze.copyByteString . Base64.encode . toBytes) s3QContentMd5] , [maybe mempty Blaze.copyByteString s3QContentType] , [Blaze.copyByteString $ case ti of AbsoluteTimestamp time -> fmtRfc822Time time@@ -248,10 +246,10 @@ = do doc <- HTTP.responseBody resp $$+- XML.sinkDoc XML.def let cursor = Cu.fromDocument doc liftIO $ case parseError cursor of- Success err -> C.monadThrow err- Failure otherErr -> C.monadThrow otherErr+ Right err -> throwM err+ Left otherErr -> throwM otherErr where- parseError :: Cu.Cursor -> Attempt S3Error+ parseError :: Cu.Cursor -> Either C.SomeException S3Error parseError root = do code <- force "Missing error Code" $ root $/ elContent "Code" message <- force "Missing error Message" $ root $/ elContent "Message" let resource = listToMaybe $ root $/ elContent "Resource"@@ -279,7 +277,7 @@ } deriving (Show) -parseUserInfo :: F.Failure XmlException m => Cu.Cursor -> m UserInfo+parseUserInfo :: MonadThrow m => Cu.Cursor -> m UserInfo parseUserInfo el = do id_ <- force "Missing user ID" $ el $/ elContent "ID" displayName <- force "Missing user DisplayName" $ el $/ elContent "DisplayName" return UserInfo { userId = id_, userDisplayName = displayName }@@ -308,10 +306,10 @@ | ReducedRedundancy deriving (Show) -parseStorageClass :: F.Failure XmlException m => T.Text -> m StorageClass+parseStorageClass :: MonadThrow 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+parseStorageClass s = throwM . XmlException $ "Invalid Storage Class: " ++ T.unpack s writeStorageClass :: StorageClass -> T.Text writeStorageClass Standard = "STANDARD"@@ -321,9 +319,9 @@ = AES256 deriving (Show) -parseServerSideEncryption :: F.Failure XmlException m => T.Text -> m ServerSideEncryption+parseServerSideEncryption :: MonadThrow m => T.Text -> m ServerSideEncryption parseServerSideEncryption "AES256" = return AES256-parseServerSideEncryption s = F.failure . XmlException $ "Invalid Server Side Encryption: " ++ T.unpack s+parseServerSideEncryption s = throwM . XmlException $ "Invalid Server Side Encryption: " ++ T.unpack s writeServerSideEncryption :: ServerSideEncryption -> T.Text writeServerSideEncryption AES256 = "AES256"@@ -358,11 +356,11 @@ } deriving (Show) -parseObjectInfo :: F.Failure XmlException m => Cu.Cursor -> m ObjectInfo+parseObjectInfo :: MonadThrow m => Cu.Cursor -> m ObjectInfo parseObjectInfo el = do key <- force "Missing object Key" $ el $/ elContent "Key" let time s = case parseTime defaultTimeLocale "%Y-%m-%dT%H:%M:%S%QZ" $ T.unpack s of- Nothing -> F.failure $ XmlException "Invalid time"+ Nothing -> throwM $ XmlException "Invalid time" Just v -> return v lastModified <- forceM "Missing object LastModified" $ el $/ elContent "LastModified" &| time eTag <- force "Missing object ETag" $ el $/ elContent "ETag"@@ -392,7 +390,7 @@ } deriving (Show) -parseObjectMetadata :: F.Failure HeaderException m => HTTP.ResponseHeaders -> m ObjectMetadata+parseObjectMetadata :: MonadThrow m => HTTP.ResponseHeaders -> m ObjectMetadata parseObjectMetadata h = ObjectMetadata `liftM` deleteMarker `ap` etag@@ -406,15 +404,15 @@ Nothing -> return False Just "true" -> return True Just "false" -> return False- Just x -> F.failure $ HeaderException ("Invalid x-amz-delete-marker " ++ x)+ Just x -> throwM $ HeaderException ("Invalid x-amz-delete-marker " ++ x) etag = case T.decodeUtf8 `fmap` lookup "ETag" h of Just x -> return x- Nothing -> F.failure $ HeaderException "ETag missing"+ Nothing -> throwM $ HeaderException "ETag missing" lastModified = case B8.unpack `fmap` lookup "Last-Modified" h of Just ts -> case parseHttpDate ts of Just t -> return t- Nothing -> F.failure $ HeaderException ("Invalid Last-Modified: " ++ ts)- Nothing -> F.failure $ HeaderException "Last-Modified missing"+ Nothing -> throwM $ HeaderException ("Invalid Last-Modified: " ++ ts)+ Nothing -> throwM $ HeaderException "Last-Modified missing" versionId = T.decodeUtf8 `fmap` lookup "x-amz-version-id" h -- expiration = return undefined userMetadata = flip mapMaybe ht $
Aws/Ses/Core.hs view
@@ -22,8 +22,8 @@ import qualified Blaze.ByteString.Builder as Blaze import qualified Blaze.ByteString.Builder.Char8 as Blaze8 import qualified Control.Exception as C-import qualified Control.Failure as F import Control.Monad (mplus)+import Control.Monad.Trans.Resource (throwM) import qualified Data.ByteString as B import qualified Data.ByteString.Base64 as B64 import Data.ByteString.Char8 ({-IsString-})@@ -128,7 +128,7 @@ fromError cursor = do errCode <- force "Missing Error Code" $ cursor $// elContent "Code" errMessage <- force "Missing Error Message" $ cursor $// elContent "Message"- F.failure $ SesError (HTTP.responseStatus resp) errCode errMessage+ throwM $ SesError (HTTP.responseStatus resp) errCode errMessage class SesAsQuery a where -- | Write a data type as a list of query parameters.
Aws/SimpleDb/Core.hs view
@@ -4,8 +4,8 @@ import qualified Blaze.ByteString.Builder as Blaze import qualified Blaze.ByteString.Builder.Char8 as Blaze8 import qualified Control.Exception as C-import qualified Control.Failure as F import Control.Monad+import Control.Monad.Trans.Resource (MonadThrow, throwM) import qualified Data.ByteString as B import qualified Data.ByteString.Base64 as Base64 import Data.IORef@@ -149,16 +149,16 @@ (err:_) -> fromError err fromError cursor = do errCode <- force "Missing Error Code" $ cursor $// elCont "Code" errMessage <- force "Missing Error Message" $ cursor $// elCont "Message"- F.failure $ SdbError (HTTP.responseStatus resp) errCode errMessage+ throwM $ SdbError (HTTP.responseStatus resp) errCode errMessage class SdbFromResponse a where sdbFromResponse :: Cu.Cursor -> Response SdbMetadata a -sdbCheckResponseType :: F.Failure XmlException m => a -> T.Text -> Cu.Cursor -> m a+sdbCheckResponseType :: MonadThrow m => a -> T.Text -> Cu.Cursor -> m a sdbCheckResponseType a n c = do _ <- force ("Expected response type " ++ T.unpack n) (Cu.laxElement n c) return a -decodeBase64 :: F.Failure XmlException m => Cu.Cursor -> m T.Text+decodeBase64 :: MonadThrow m => Cu.Cursor -> m T.Text decodeBase64 cursor = let encoded = T.concat $ cursor $/ Cu.content encoding = listToMaybe $ cursor $| Cu.laxAttribute "encoding" &| T.toCaseFold@@ -166,15 +166,15 @@ case encoding of Nothing -> return encoded Just "base64" -> case Base64.decode . T.encodeUtf8 $ encoded of- Left msg -> F.failure $ XmlException ("Invalid Base64 data: " ++ msg)+ Left msg -> throwM $ XmlException ("Invalid Base64 data: " ++ msg) Right x -> return $ T.decodeUtf8 x- Just actual -> F.failure $ XmlException ("Unrecognized encoding " ++ T.unpack actual)+ Just actual -> throwM $ XmlException ("Unrecognized encoding " ++ T.unpack actual) data Attribute a = ForAttribute { attributeName :: T.Text, attributeData :: a } deriving (Show) -readAttribute :: F.Failure XmlException m => Cu.Cursor -> m (Attribute T.Text)+readAttribute :: MonadThrow m => Cu.Cursor -> m (Attribute T.Text) readAttribute cursor = do name <- forceM "Missing Name" $ cursor $/ Cu.laxElement "Name" &| decodeBase64 value <- forceM "Missing Value" $ cursor $/ Cu.laxElement "Value" &| decodeBase64@@ -225,7 +225,7 @@ = Item { itemName :: T.Text, itemData :: a } deriving (Show) -readItem :: F.Failure XmlException m => Cu.Cursor -> m (Item [Attribute T.Text])+readItem :: MonadThrow m => Cu.Cursor -> m (Item [Attribute T.Text]) readItem cursor = do name <- force "Missing Name" <=< sequence $ cursor $/ Cu.laxElement "Name" &| decodeBase64 attributes <- sequence $ cursor $/ Cu.laxElement "Attribute" &| readAttribute
Aws/Sqs/Commands/Message.hs view
@@ -4,9 +4,9 @@ import Aws.Core import Aws.Sqs.Core import Control.Applicative+import Control.Monad.Trans.Resource (MonadThrow) import Data.Maybe import Text.XML.Cursor (($/), ($//), (&/), (&|))-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@@ -98,7 +98,7 @@ } deriving (Show) -readMessageAttribute :: F.Failure XmlException m => Cu.Cursor -> m (MessageAttribute,T.Text)+readMessageAttribute :: MonadThrow m => Cu.Cursor -> 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
Aws/Sqs/Core.hs view
@@ -5,14 +5,12 @@ import qualified Blaze.ByteString.Builder as Blaze import qualified Blaze.ByteString.Builder.Char8 as Blaze8 import qualified Control.Exception as C-import qualified Control.Failure as F import Control.Monad import Control.Monad.IO.Class-import Data.Attempt (Attempt(..))+import Control.Monad.Trans.Resource (MonadThrow, throwM) import qualified Data.ByteString as B import qualified Data.ByteString.Char8 as BC import Data.Conduit (($$+-))-import qualified Data.Conduit as C import Data.IORef import Data.List import Data.Maybe@@ -234,10 +232,10 @@ = do doc <- HTTP.responseBody resp $$+- XML.sinkDoc XML.def let cursor = Cu.fromDocument doc liftIO $ case parseError cursor of- Success err -> C.monadThrow err- Failure otherErr -> C.monadThrow otherErr+ Right err -> throwM err+ Left otherErr -> throwM otherErr where- parseError :: Cu.Cursor -> Attempt SqsError+ parseError :: Cu.Cursor -> Either C.SomeException 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"@@ -291,7 +289,7 @@ | PermissionGetQueueAttributes deriving (Show, Enum, Eq) -parseQueueAttribute :: F.Failure XmlException m => T.Text -> m QueueAttribute+parseQueueAttribute :: MonadThrow m => T.Text -> m QueueAttribute parseQueueAttribute "ApproximateNumberOfMessages" = return ApproximateNumberOfMessages parseQueueAttribute "ApproximateNumberOfMessagesNotVisible" = return ApproximateNumberOfMessagesNotVisible parseQueueAttribute "VisibilityTimeout" = return VisibilityTimeout@@ -301,7 +299,7 @@ parseQueueAttribute "MaximumMessageSize" = return MaximumMessageSize parseQueueAttribute "MessageRetentionPeriod" = return MessageRetentionPeriod parseQueueAttribute "QueueArn" = return QueueArn-parseQueueAttribute x = F.failure $ XmlException ( "Invalid Attribute Name. " ++ show x)+parseQueueAttribute x = throwM $ XmlException ( "Invalid Attribute Name. " ++ show x) printQueueAttribute :: QueueAttribute -> T.Text printQueueAttribute QueueAll = "All"@@ -315,12 +313,12 @@ printQueueAttribute MessageRetentionPeriod = "MessageRetentionPeriod" printQueueAttribute QueueArn = "QueueArn" -parseMessageAttribute :: F.Failure XmlException m => T.Text -> m MessageAttribute+parseMessageAttribute :: MonadThrow 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)+parseMessageAttribute x = throwM $ XmlException ( "Invalid Attribute Name. " ++ show x) printMessageAttribute :: MessageAttribute -> T.Text printMessageAttribute MessageAll = "All"
aws.cabal view
@@ -1,5 +1,5 @@ Name: aws-Version: 0.8.6+Version: 0.9 Synopsis: Amazon Web Services (AWS) for Haskell Description: Bindings for Amazon Web Services (AWS), with the aim of supporting all AWS services. To see a high level overview of the library, see the README at <https://github.com/aristidb/aws/blob/master/README.org>. Homepage: http://github.com/aristidb/aws@@ -20,7 +20,7 @@ Source-repository this type: git location: https://github.com/aristidb/aws.git- tag: 0.8.6+ tag: 0.9 Source-repository head type: git@@ -98,40 +98,40 @@ Aws.DynamoDb.Core Build-depends:- attempt >= 0.3.1.1 && < 0.5,- attoparsec-conduit >= 1.0 && < 1.1, aeson >= 0.6 && < 0.8, base == 4.*, base16-bytestring == 0.1.*, base64-bytestring == 1.0.*, blaze-builder >= 0.2.1.4 && < 0.4,+ byteable == 0.1.*, bytestring >= 0.9 && < 0.11, case-insensitive >= 0.2 && < 1.3, cereal >= 0.3 && < 0.5,- conduit >= 1.0 && < 1.1,+ conduit >= 1.1 && < 1.2,+ conduit-extra >= 1.1 && < 1.2, containers >= 0.4,- crypto-api >= 0.9,- cryptohash >= 0.8 && < 0.12,- cryptohash-cryptoapi == 0.1.*,+ cryptohash >= 0.11 && < 0.12, data-default == 0.5.*, directory >= 1.0 && < 1.3,- failure >= 0.2.0.1 && < 0.3, filepath >= 1.1 && < 1.4,- http-conduit >= 1.9 && < 2.1,+ http-conduit >= 2.1 && < 2.2, http-types >= 0.7 && < 0.9, lifted-base >= 0.1 && < 0.3, monad-control >= 0.3, mtl == 2.*, old-locale == 1.*,- resourcet >= 0.3.3 && <0.5,+ resourcet >= 1.1 && < 1.2, text >= 0.11, time >= 1.1.4 && < 1.5, transformers >= 0.2.2.0 && < 0.4, unordered-containers >= 0.2, utf8-string == 0.3.*, vector >= 0.10,- xml-conduit >= 1.1 && <1.2+ xml-conduit >= 1.2 && <1.3 + if !impl(ghc >= 7.6)+ Build-depends: ghc-prim+ GHC-Options: -Wall Default-Language: Haskell2010@@ -162,7 +162,8 @@ base == 4.*, aws, http-conduit,- conduit+ conduit,+ conduit-extra Default-Language: Haskell2010