git.iko.soy/stackage
on 869c80a help sign in
stackage/patching/patches/aws-0.8.6.patch
596 lines 30 kB history raw
1diff -ru orig/Aws/Aws.hs new/Aws/Aws.hs
2--- orig/Aws/Aws.hs 2014-04-04 10:18:25.108401067 +0300
3+++ new/Aws/Aws.hs 2014-04-04 10:18:24.000000000 +0300
4@@ -33,7 +33,6 @@
5 import Control.Monad.IO.Class
6 import Control.Monad.Trans
7 import Control.Monad.Trans.Resource
8-import Data.Attempt (Attempt(Success, Failure))
9 import qualified Data.ByteString as B
10 import qualified Data.CaseInsensitive as CI
11 import qualified Data.Conduit as C
12@@ -185,11 +184,8 @@
13 unsafeAws cfg scfg manager request = do
14 metadataRef <- liftIO $ newIORef mempty
16- let catchAll :: ResourceT IO a -> ResourceT IO (Attempt a)
17- catchAll = E.handle (return . failure') . fmap Success
19- failure' :: E.SomeException -> Attempt a
20- failure' = Failure
21+ let catchAll :: ResourceT IO a -> ResourceT IO (Either E.SomeException a)
22+ catchAll = E.handle (return . Left) . fmap Right
24 resp <- catchAll $
25 unsafeAwsRef cfg scfg manager metadataRef request
26@@ -268,8 +264,8 @@
27 where go request = do resp <- lift $ aws cfg scfg manager request
28 C.yield resp
29 case responseResult resp of
30- Failure _ -> return ()
31- Success x ->
32+ Left _ -> return ()
33+ Right x ->
34 case nextIteratedRequest request x of
35 Nothing -> return ()
36 Just nextRequest -> go nextRequest
37diff -ru orig/Aws/Core.hs new/Aws/Core.hs
38--- orig/Aws/Core.hs 2014-04-04 10:18:25.108401067 +0300
39+++ new/Aws/Core.hs 2014-04-04 10:18:24.000000000 +0300
40@@ -89,13 +89,12 @@
41 import Control.Applicative
42 import Control.Arrow
43 import qualified Control.Exception as E
44-import qualified Control.Failure as F
45 import Control.Monad
46 import Control.Monad.IO.Class
47+import Control.Monad.Trans.Resource (ResourceT, MonadThrow (throwM))
48 import qualified Crypto.Classes as Crypto
49 import qualified Crypto.HMAC as HMAC
50 import Crypto.Hash.CryptoAPI (MD5, SHA1, SHA256, hash')
51-import Data.Attempt (Attempt(..), FromAttempt(..))
52 import Data.ByteString (ByteString)
53 import qualified Data.ByteString as B
54 import qualified Data.ByteString.Base16 as Base16
55@@ -104,7 +103,7 @@
56 import qualified Data.ByteString.Lazy as L
57 import qualified Data.ByteString.UTF8 as BU
58 import Data.Char
59-import Data.Conduit (ResourceT, ($$+-))
60+import Data.Conduit (($$+-))
61 import qualified Data.Conduit as C
62 import qualified Data.Conduit.List as CL
63 import Data.Default (def)
64@@ -137,12 +136,12 @@
65 --
66 -- Response forms a Writer-like monad.
67 data Response m a = Response { responseMetadata :: m
68- , responseResult :: Attempt a }
69+ , responseResult :: Either E.SomeException a }
70 deriving (Show, Functor)
72 -- | Read a response result (if it's a success response, fail otherwise).
73-readResponse :: FromAttempt f => Response m a -> f a
74-readResponse = fromAttempt . responseResult
75+readResponse :: MonadThrow n => Response m a -> n a
76+readResponse = either throwM return . responseResult
78 -- | Read a response result (if it's a success response, fail otherwise). In MonadIO.
79 readResponseIO :: MonadIO io => Response m a -> io a
80@@ -159,13 +158,13 @@
81 --multiResponse :: Monoid m => Response m a -> Response [m] a ->
83 instance Monoid m => Monad (Response m) where
84- return x = Response mempty (Success x)
85- Response m1 (Failure e) >>= _ = Response m1 (Failure e)
86- Response m1 (Success x) >>= f = let Response m2 y = f x
87+ return x = Response mempty (Right x)
88+ Response m1 (Left e) >>= _ = Response m1 (Left e)
89+ Response m1 (Right x) >>= f = let Response m2 y = f x
90 in Response (m1 `mappend` m2) y -- currently using First-semantics, Last SHOULD work too
92-instance (Monoid m, E.Exception e) => F.Failure e (Response m) where
93- failure e = Response mempty (F.failure e)
94+instance Monoid m => MonadThrow (Response m) where
95+ throwM e = Response mempty (throwM e)
97 -- | Add metadata to an 'IORef' (using 'mappend').
98 tellMetadataRef :: Monoid m => IORef m -> m -> IO ()
99@@ -696,24 +695,24 @@
100 elCont name = laxElement name &/ content &| T.unpack
102 -- | Extract the first element from a parser result list, and throw an 'XmlException' if the list is empty.
103-force :: F.Failure XmlException m => String -> [a] -> m a
104+force :: MonadThrow m => String -> [a] -> m a
105 force = Cu.force . XmlException
107 -- | Extract the first element from a monadic parser result list, and throw an 'XmlException' if the list is empty.
108-forceM :: F.Failure XmlException m => String -> [m a] -> m a
109+forceM :: MonadThrow m => String -> [m a] -> m a
110 forceM = Cu.forceM . XmlException
112 -- | Read an integer from a 'T.Text', throwing an 'XmlException' on failure.
113-textReadInt :: (F.Failure XmlException m, Num a) => T.Text -> m a
114+textReadInt :: (MonadThrow m, Num a) => T.Text -> m a
115 textReadInt s = case reads $ T.unpack s of
116 [(n,"")] -> return $ fromInteger n
117- _ -> F.failure $ XmlException "Invalid Integer"
118+ _ -> throwM $ XmlException "Invalid Integer"
120 -- | Read an integer from a 'String', throwing an 'XmlException' on failure.
121-readInt :: (F.Failure XmlException m, Num a) => String -> m a
122+readInt :: (MonadThrow m, Num a) => String -> m a
123 readInt s = case reads s of
124 [(n,"")] -> return $ fromInteger n
125- _ -> F.failure $ XmlException "Invalid Integer"
126+ _ -> throwM $ XmlException "Invalid Integer"
128 -- | Create a complete 'HTTPResponseConsumer' from a simple function that takes a 'Cu.Cursor' to XML in the response
129 -- body.
130@@ -731,5 +730,5 @@
131 let Response metadata x = parse cursor
132 liftIO $ tellMetadataRef metadataRef metadata
133 case x of
134- Failure err -> liftIO $ C.monadThrow err
135- Success v -> return v
136+ Left err -> liftIO $ throwM err
137+ Right v -> return v
138diff -ru orig/Aws/DynamoDb/Core.hs new/Aws/DynamoDb/Core.hs
139--- orig/Aws/DynamoDb/Core.hs 2014-04-04 10:18:25.108401067 +0300
140+++ new/Aws/DynamoDb/Core.hs 2014-04-04 10:18:24.000000000 +0300
141@@ -2,6 +2,7 @@
143 import Aws.Core
144 import qualified Control.Exception as C
145+import Control.Monad.Trans.Resource (throwM)
146 import Crypto.Hash.CryptoAPI (SHA256, hash)
147 import qualified Data.Aeson as A
148 import qualified Data.ByteString as B
149@@ -125,5 +126,5 @@
150 (HTTP.Status{HTTP.statusCode=200}) -> do
151 case A.fromJSON val of
152 A.Success a -> return a
153- A.Error err -> monadThrow $ DyError (HTTP.responseStatus resp) "" err
154- _ -> monadThrow $ DyError (HTTP.responseStatus resp) "" (show val)
155+ A.Error err -> throwM $ DyError (HTTP.responseStatus resp) "" err
156+ _ -> throwM $ DyError (HTTP.responseStatus resp) "" (show val)
157diff -ru orig/Aws/Ec2/InstanceMetadata.hs new/Aws/Ec2/InstanceMetadata.hs
158--- orig/Aws/Ec2/InstanceMetadata.hs 2014-04-04 10:18:25.112401067 +0300
159+++ new/Aws/Ec2/InstanceMetadata.hs 2014-04-04 10:18:24.000000000 +0300
160@@ -2,7 +2,7 @@
162 import Control.Applicative
163 import Control.Exception
164-import Control.Failure
165+import Control.Monad.Trans.Resource (throwM)
166 import qualified Data.ByteString.Lazy as L
167 import qualified Data.ByteString.Lazy.Char8 as B8
168 import Data.ByteString.Lazy.UTF8 as BU
169@@ -25,7 +25,7 @@
170 getInstanceMetadataFirst :: HTTP.Manager -> String -> IO L.ByteString
171 getInstanceMetadataFirst mgr p = do listing <- getInstanceMetadataListing mgr p
172 case listing of
173- [] -> failure (MetadataNotFound p)
174+ [] -> throwM (MetadataNotFound p)
175 (x:_) -> getInstanceMetadata mgr p x
177 getInstanceMetadataOrFirst :: HTTP.Manager -> String -> Maybe String -> IO L.ByteString
178diff -ru orig/Aws/Iam/Core.hs new/Aws/Iam/Core.hs
179--- orig/Aws/Iam/Core.hs 2014-04-04 10:18:25.112401067 +0300
180+++ new/Aws/Iam/Core.hs 2014-04-04 10:18:24.000000000 +0300
181@@ -19,8 +19,8 @@
182 import qualified Blaze.ByteString.Builder as Blaze
183 import qualified Blaze.ByteString.Builder.Char8 as Blaze8
184 import Control.Exception (Exception)
185-import qualified Control.Failure as F
186 import Control.Monad
187+import Control.Monad.Trans.Resource (MonadThrow, throwM)
188 import Data.ByteString (ByteString)
189 import Data.IORef
190 import Data.List (intersperse, sort)
191@@ -152,13 +152,13 @@
192 fromError cursor = do
193 errCode <- force "Missing Error Code" $ cursor $// elContent "Code"
194 errMsg <- force "Missing Error Message" $ cursor $// elContent "Message"
195- F.failure $ IamError (HTTP.responseStatus resp) errCode errMsg
196+ throwM $ IamError (HTTP.responseStatus resp) errCode errMsg
198 -- | Parses IAM @DateTime@ data type.
199-parseDateTime :: (F.Failure XmlException m) => String -> m UTCTime
200+parseDateTime :: MonadThrow m => String -> m UTCTime
201 parseDateTime x
202 = case parseTime defaultTimeLocale iso8601UtcDate x of
203- Nothing -> F.failure $ XmlException $ "Invalid DateTime: " ++ x
204+ Nothing -> throwM $ XmlException $ "Invalid DateTime: " ++ x
205 Just dt -> return dt
207 -- | The IAM @User@ data type.
208@@ -180,7 +180,7 @@
209 deriving (Eq, Ord, Show, Typeable)
211 -- | Parses the IAM @User@ data type.
212-parseUser :: (F.Failure XmlException m) => Cu.Cursor -> m User
213+parseUser :: MonadThrow m => Cu.Cursor -> m User
214 parseUser cursor = do
215 userArn <- attr "Arn"
216 userCreateDate <- attr "CreateDate" >>= parseDateTime . Text.unpack
217diff -ru orig/Aws/Iam/Internal.hs new/Aws/Iam/Internal.hs
218--- orig/Aws/Iam/Internal.hs 2014-04-04 10:18:25.112401067 +0300
219+++ new/Aws/Iam/Internal.hs 2014-04-04 10:18:24.000000000 +0300
220@@ -15,8 +15,8 @@
221 import Aws.Iam.Core
222 import Control.Applicative
223 import Control.Arrow (second)
224-import qualified Control.Failure as F
225 import Control.Monad
226+import Control.Monad.Trans.Resource (MonadThrow)
227 import Data.ByteString (ByteString)
228 import Data.Maybe
229 import Data.Monoid ((<>))
230@@ -62,7 +62,7 @@
231 -- | Reads and returns the @IsTruncated@ and @Marker@ attributes present in
232 -- all IAM data pagination responses.
233 markedIterResponse
234- :: F.Failure XmlException m
235+ :: MonadThrow m
236 => Cu.Cursor
237 -> m (Bool, Maybe Text)
238 markedIterResponse cursor = do
239diff -ru orig/Aws/S3/Commands/CopyObject.hs new/Aws/S3/Commands/CopyObject.hs
240--- orig/Aws/S3/Commands/CopyObject.hs 2014-04-04 10:18:25.112401067 +0300
241+++ new/Aws/S3/Commands/CopyObject.hs 2014-04-04 10:18:24.000000000 +0300
242@@ -5,7 +5,7 @@
243 import Aws.S3.Core
244 import Control.Applicative
245 import Control.Arrow (second)
246-import Control.Failure
247+import Control.Monad.Trans.Resource (throwM)
248 import qualified Data.CaseInsensitive as CI
249 import Data.Maybe
250 import qualified Data.Text as T
251@@ -93,7 +93,7 @@
252 return $ CopyObjectResponse vid lastMod etag
253 where parse el = do
254 let parseHttpDate' x = case parseTime defaultTimeLocale iso8601UtcDate x of
255- Nothing -> failure $ XmlException ("Invalid Last-Modified " ++ x)
256+ Nothing -> throwM $ XmlException ("Invalid Last-Modified " ++ x)
257 Just y -> return y
258 lastMod <- forceM "Missing Last-Modified" $ el $/ elContent "LastModified" &| (parseHttpDate' . T.unpack)
259 etag <- force "Missing ETag" $ el $/ elContent "ETag"
260diff -ru orig/Aws/S3/Core.hs new/Aws/S3/Core.hs
261--- orig/Aws/S3/Core.hs 2014-04-04 10:18:25.112401067 +0300
262+++ new/Aws/S3/Core.hs 2014-04-04 10:18:24.000000000 +0300
263@@ -5,8 +5,8 @@
264 import Control.Arrow ((***))
265 import Control.Monad
266 import Control.Monad.IO.Class
267+import Control.Monad.Trans.Resource (MonadThrow, throwM)
268 import Crypto.Hash.CryptoAPI (MD5)
269-import Data.Attempt (Attempt(..))
270 import Data.Conduit (($$+-))
271 import Data.Function
272 import Data.IORef
273@@ -20,12 +20,10 @@
274 import qualified Blaze.ByteString.Builder as Blaze
275 import qualified Blaze.ByteString.Builder.Char8 as Blaze8
276 import qualified Control.Exception as C
277-import qualified Control.Failure as F
278 import qualified Data.ByteString as B
279 import qualified Data.ByteString.Char8 as B8
280 import qualified Data.ByteString.Base64 as Base64
281 import qualified Data.CaseInsensitive as CI
282-import qualified Data.Conduit as C
283 import qualified Data.Serialize as Serialize
284 import qualified Data.Text as T
285 import qualified Data.Text.Encoding as T
286@@ -248,10 +246,10 @@
287 = do doc <- HTTP.responseBody resp $$+- XML.sinkDoc XML.def
288 let cursor = Cu.fromDocument doc
289 liftIO $ case parseError cursor of
290- Success err -> C.monadThrow err
291- Failure otherErr -> C.monadThrow otherErr
292+ Right err -> throwM err
293+ Left otherErr -> throwM otherErr
294 where
295- parseError :: Cu.Cursor -> Attempt S3Error
296+ parseError :: Cu.Cursor -> Either C.SomeException S3Error
297 parseError root = do code <- force "Missing error Code" $ root $/ elContent "Code"
298 message <- force "Missing error Message" $ root $/ elContent "Message"
299 let resource = listToMaybe $ root $/ elContent "Resource"
300@@ -279,7 +277,7 @@
301 }
302 deriving (Show)
304-parseUserInfo :: F.Failure XmlException m => Cu.Cursor -> m UserInfo
305+parseUserInfo :: MonadThrow m => Cu.Cursor -> m UserInfo
306 parseUserInfo el = do id_ <- force "Missing user ID" $ el $/ elContent "ID"
307 displayName <- force "Missing user DisplayName" $ el $/ elContent "DisplayName"
308 return UserInfo { userId = id_, userDisplayName = displayName }
309@@ -308,10 +306,10 @@
310 | ReducedRedundancy
311 deriving (Show)
313-parseStorageClass :: F.Failure XmlException m => T.Text -> m StorageClass
314+parseStorageClass :: MonadThrow m => T.Text -> m StorageClass
315 parseStorageClass "STANDARD" = return Standard
316 parseStorageClass "REDUCED_REDUNDANCY" = return ReducedRedundancy
317-parseStorageClass s = F.failure . XmlException $ "Invalid Storage Class: " ++ T.unpack s
318+parseStorageClass s = throwM . XmlException $ "Invalid Storage Class: " ++ T.unpack s
320 writeStorageClass :: StorageClass -> T.Text
321 writeStorageClass Standard = "STANDARD"
322@@ -321,9 +319,9 @@
323 = AES256
324 deriving (Show)
326-parseServerSideEncryption :: F.Failure XmlException m => T.Text -> m ServerSideEncryption
327+parseServerSideEncryption :: MonadThrow m => T.Text -> m ServerSideEncryption
328 parseServerSideEncryption "AES256" = return AES256
329-parseServerSideEncryption s = F.failure . XmlException $ "Invalid Server Side Encryption: " ++ T.unpack s
330+parseServerSideEncryption s = throwM . XmlException $ "Invalid Server Side Encryption: " ++ T.unpack s
332 writeServerSideEncryption :: ServerSideEncryption -> T.Text
333 writeServerSideEncryption AES256 = "AES256"
334@@ -358,11 +356,11 @@
335 }
336 deriving (Show)
338-parseObjectInfo :: F.Failure XmlException m => Cu.Cursor -> m ObjectInfo
339+parseObjectInfo :: MonadThrow m => Cu.Cursor -> m ObjectInfo
340 parseObjectInfo el
341 = do key <- force "Missing object Key" $ el $/ elContent "Key"
342 let time s = case parseTime defaultTimeLocale "%Y-%m-%dT%H:%M:%S%QZ" $ T.unpack s of
343- Nothing -> F.failure $ XmlException "Invalid time"
344+ Nothing -> throwM $ XmlException "Invalid time"
345 Just v -> return v
346 lastModified <- forceM "Missing object LastModified" $ el $/ elContent "LastModified" &| time
347 eTag <- force "Missing object ETag" $ el $/ elContent "ETag"
348@@ -392,7 +390,7 @@
349 }
350 deriving (Show)
352-parseObjectMetadata :: F.Failure HeaderException m => HTTP.ResponseHeaders -> m ObjectMetadata
353+parseObjectMetadata :: MonadThrow m => HTTP.ResponseHeaders -> m ObjectMetadata
354 parseObjectMetadata h = ObjectMetadata
355 `liftM` deleteMarker
356 `ap` etag
357@@ -406,15 +404,15 @@
358 Nothing -> return False
359 Just "true" -> return True
360 Just "false" -> return False
361- Just x -> F.failure $ HeaderException ("Invalid x-amz-delete-marker " ++ x)
362+ Just x -> throwM $ HeaderException ("Invalid x-amz-delete-marker " ++ x)
363 etag = case T.decodeUtf8 `fmap` lookup "ETag" h of
364 Just x -> return x
365- Nothing -> F.failure $ HeaderException "ETag missing"
366+ Nothing -> throwM $ HeaderException "ETag missing"
367 lastModified = case B8.unpack `fmap` lookup "Last-Modified" h of
368 Just ts -> case parseHttpDate ts of
369 Just t -> return t
370- Nothing -> F.failure $ HeaderException ("Invalid Last-Modified: " ++ ts)
371- Nothing -> F.failure $ HeaderException "Last-Modified missing"
372+ Nothing -> throwM $ HeaderException ("Invalid Last-Modified: " ++ ts)
373+ Nothing -> throwM $ HeaderException "Last-Modified missing"
374 versionId = T.decodeUtf8 `fmap` lookup "x-amz-version-id" h
375 -- expiration = return undefined
376 userMetadata = flip mapMaybe ht $
377diff -ru orig/Aws/Ses/Core.hs new/Aws/Ses/Core.hs
378--- orig/Aws/Ses/Core.hs 2014-04-04 10:18:25.112401067 +0300
379+++ new/Aws/Ses/Core.hs 2014-04-04 10:18:24.000000000 +0300
380@@ -22,8 +22,8 @@
381 import qualified Blaze.ByteString.Builder as Blaze
382 import qualified Blaze.ByteString.Builder.Char8 as Blaze8
383 import qualified Control.Exception as C
384-import qualified Control.Failure as F
385 import Control.Monad (mplus)
386+import Control.Monad.Trans.Resource (throwM)
387 import qualified Data.ByteString as B
388 import qualified Data.ByteString.Base64 as B64
389 import Data.ByteString.Char8 ({-IsString-})
390@@ -128,7 +128,7 @@
391 fromError cursor = do
392 errCode <- force "Missing Error Code" $ cursor $// elContent "Code"
393 errMessage <- force "Missing Error Message" $ cursor $// elContent "Message"
394- F.failure $ SesError (HTTP.responseStatus resp) errCode errMessage
395+ throwM $ SesError (HTTP.responseStatus resp) errCode errMessage
397 class SesAsQuery a where
398 -- | Write a data type as a list of query parameters.
399diff -ru orig/Aws/SimpleDb/Core.hs new/Aws/SimpleDb/Core.hs
400--- orig/Aws/SimpleDb/Core.hs 2014-04-04 10:18:25.116401067 +0300
401+++ new/Aws/SimpleDb/Core.hs 2014-04-04 10:18:24.000000000 +0300
402@@ -4,8 +4,8 @@
403 import qualified Blaze.ByteString.Builder as Blaze
404 import qualified Blaze.ByteString.Builder.Char8 as Blaze8
405 import qualified Control.Exception as C
406-import qualified Control.Failure as F
407 import Control.Monad
408+import Control.Monad.Trans.Resource (MonadThrow, throwM)
409 import qualified Data.ByteString as B
410 import qualified Data.ByteString.Base64 as Base64
411 import Data.IORef
412@@ -149,16 +149,16 @@
413 (err:_) -> fromError err
414 fromError cursor = do errCode <- force "Missing Error Code" $ cursor $// elCont "Code"
415 errMessage <- force "Missing Error Message" $ cursor $// elCont "Message"
416- F.failure $ SdbError (HTTP.responseStatus resp) errCode errMessage
417+ throwM $ SdbError (HTTP.responseStatus resp) errCode errMessage
419 class SdbFromResponse a where
420 sdbFromResponse :: Cu.Cursor -> Response SdbMetadata a
422-sdbCheckResponseType :: F.Failure XmlException m => a -> T.Text -> Cu.Cursor -> m a
423+sdbCheckResponseType :: MonadThrow m => a -> T.Text -> Cu.Cursor -> m a
424 sdbCheckResponseType a n c = do _ <- force ("Expected response type " ++ T.unpack n) (Cu.laxElement n c)
425 return a
427-decodeBase64 :: F.Failure XmlException m => Cu.Cursor -> m T.Text
428+decodeBase64 :: MonadThrow m => Cu.Cursor -> m T.Text
429 decodeBase64 cursor =
430 let encoded = T.concat $ cursor $/ Cu.content
431 encoding = listToMaybe $ cursor $| Cu.laxAttribute "encoding" &| T.toCaseFold
432@@ -166,15 +166,15 @@
433 case encoding of
434 Nothing -> return encoded
435 Just "base64" -> case Base64.decode . T.encodeUtf8 $ encoded of
436- Left msg -> F.failure $ XmlException ("Invalid Base64 data: " ++ msg)
437+ Left msg -> throwM $ XmlException ("Invalid Base64 data: " ++ msg)
438 Right x -> return $ T.decodeUtf8 x
439- Just actual -> F.failure $ XmlException ("Unrecognized encoding " ++ T.unpack actual)
440+ Just actual -> throwM $ XmlException ("Unrecognized encoding " ++ T.unpack actual)
442 data Attribute a
443 = ForAttribute { attributeName :: T.Text, attributeData :: a }
444 deriving (Show)
446-readAttribute :: F.Failure XmlException m => Cu.Cursor -> m (Attribute T.Text)
447+readAttribute :: MonadThrow m => Cu.Cursor -> m (Attribute T.Text)
448 readAttribute cursor = do
449 name <- forceM "Missing Name" $ cursor $/ Cu.laxElement "Name" &| decodeBase64
450 value <- forceM "Missing Value" $ cursor $/ Cu.laxElement "Value" &| decodeBase64
451@@ -225,7 +225,7 @@
452 = Item { itemName :: T.Text, itemData :: a }
453 deriving (Show)
455-readItem :: F.Failure XmlException m => Cu.Cursor -> m (Item [Attribute T.Text])
456+readItem :: MonadThrow m => Cu.Cursor -> m (Item [Attribute T.Text])
457 readItem cursor = do
458 name <- force "Missing Name" <=< sequence $ cursor $/ Cu.laxElement "Name" &| decodeBase64
459 attributes <- sequence $ cursor $/ Cu.laxElement "Attribute" &| readAttribute
460diff -ru orig/Aws/Sqs/Commands/Message.hs new/Aws/Sqs/Commands/Message.hs
461--- orig/Aws/Sqs/Commands/Message.hs 2014-04-04 10:18:25.116401067 +0300
462+++ new/Aws/Sqs/Commands/Message.hs 2014-04-04 10:18:24.000000000 +0300
463@@ -4,9 +4,9 @@
464 import Aws.Core
465 import Aws.Sqs.Core
466 import Control.Applicative
467+import Control.Monad.Trans.Resource (MonadThrow)
468 import Data.Maybe
469 import Text.XML.Cursor (($/), ($//), (&/), (&|))
470-import qualified Control.Failure as F
471 import qualified Data.ByteString.Char8 as B
472 import qualified Data.Text as T
473 import qualified Data.Text.Encoding as TE
474@@ -98,7 +98,7 @@
475 }
476 deriving (Show)
478-readMessageAttribute :: F.Failure XmlException m => Cu.Cursor -> m (MessageAttribute,T.Text)
479+readMessageAttribute :: MonadThrow m => Cu.Cursor -> m (MessageAttribute,T.Text)
480 readMessageAttribute cursor = do
481 name <- force "Missing Name" $ cursor $/ Cu.laxElement "Name" &/ Cu.content
482 value <- force "Missing Value" $ cursor $/ Cu.laxElement "Value" &/ Cu.content
483diff -ru orig/Aws/Sqs/Core.hs new/Aws/Sqs/Core.hs
484--- orig/Aws/Sqs/Core.hs 2014-04-04 10:18:25.116401067 +0300
485+++ new/Aws/Sqs/Core.hs 2014-04-04 10:18:24.000000000 +0300
486@@ -5,14 +5,12 @@
487 import qualified Blaze.ByteString.Builder as Blaze
488 import qualified Blaze.ByteString.Builder.Char8 as Blaze8
489 import qualified Control.Exception as C
490-import qualified Control.Failure as F
491 import Control.Monad
492 import Control.Monad.IO.Class
493-import Data.Attempt (Attempt(..))
494+import Control.Monad.Trans.Resource (MonadThrow, throwM)
495 import qualified Data.ByteString as B
496 import qualified Data.ByteString.Char8 as BC
497 import Data.Conduit (($$+-))
498-import qualified Data.Conduit as C
499 import Data.IORef
500 import Data.List
501 import Data.Maybe
502@@ -234,10 +232,10 @@
503 = do doc <- HTTP.responseBody resp $$+- XML.sinkDoc XML.def
504 let cursor = Cu.fromDocument doc
505 liftIO $ case parseError cursor of
506- Success err -> C.monadThrow err
507- Failure otherErr -> C.monadThrow otherErr
508+ Right err -> throwM err
509+ Left otherErr -> throwM otherErr
510 where
511- parseError :: Cu.Cursor -> Attempt SqsError
512+ parseError :: Cu.Cursor -> Either C.SomeException SqsError
513 parseError root = do cursor <- force "Missing Error" $ root $/ Cu.laxElement "Error"
514 code <- force "Missing error Code" $ cursor $/ elContent "Code"
515 message <- force "Missing error Message" $ cursor $/ elContent "Message"
516@@ -291,7 +289,7 @@
517 | PermissionGetQueueAttributes
518 deriving (Show, Enum, Eq)
520-parseQueueAttribute :: F.Failure XmlException m => T.Text -> m QueueAttribute
521+parseQueueAttribute :: MonadThrow m => T.Text -> m QueueAttribute
522 parseQueueAttribute "ApproximateNumberOfMessages" = return ApproximateNumberOfMessages
523 parseQueueAttribute "ApproximateNumberOfMessagesNotVisible" = return ApproximateNumberOfMessagesNotVisible
524 parseQueueAttribute "VisibilityTimeout" = return VisibilityTimeout
525@@ -301,7 +299,7 @@
526 parseQueueAttribute "MaximumMessageSize" = return MaximumMessageSize
527 parseQueueAttribute "MessageRetentionPeriod" = return MessageRetentionPeriod
528 parseQueueAttribute "QueueArn" = return QueueArn
529-parseQueueAttribute x = F.failure $ XmlException ( "Invalid Attribute Name. " ++ show x)
530+parseQueueAttribute x = throwM $ XmlException ( "Invalid Attribute Name. " ++ show x)
532 printQueueAttribute :: QueueAttribute -> T.Text
533 printQueueAttribute QueueAll = "All"
534@@ -315,12 +313,12 @@
535 printQueueAttribute MessageRetentionPeriod = "MessageRetentionPeriod"
536 printQueueAttribute QueueArn = "QueueArn"
538-parseMessageAttribute :: F.Failure XmlException m => T.Text -> m MessageAttribute
539+parseMessageAttribute :: MonadThrow m => T.Text -> m MessageAttribute
540 parseMessageAttribute "SenderId" = return SenderId
541 parseMessageAttribute "SentTimestamp" = return SentTimestamp
542 parseMessageAttribute "ApproximateReceiveCount" = return ApproximateReceiveCount
543 parseMessageAttribute "ApproximateFirstReceiveTimestamp" = return ApproximateFirstReceiveTimestamp
544-parseMessageAttribute x = F.failure $ XmlException ( "Invalid Attribute Name. " ++ show x)
545+parseMessageAttribute x = throwM $ XmlException ( "Invalid Attribute Name. " ++ show x)
547 printMessageAttribute :: MessageAttribute -> T.Text
548 printMessageAttribute MessageAll = "All"
549diff -ru orig/aws.cabal new/aws.cabal
550--- orig/aws.cabal 2014-04-04 10:18:25.120401065 +0300
551+++ new/aws.cabal 2014-04-04 10:18:24.000000000 +0300
552@@ -98,8 +98,6 @@
553 Aws.DynamoDb.Core
555 Build-depends:
556- attempt >= 0.3.1.1 && < 0.5,
557- attoparsec-conduit >= 1.0 && < 1.1,
558 aeson >= 0.6 && < 0.8,
559 base == 4.*,
560 base16-bytestring == 0.1.*,
561@@ -108,29 +106,30 @@
562 bytestring >= 0.9 && < 0.11,
563 case-insensitive >= 0.2 && < 1.3,
564 cereal >= 0.3 && < 0.5,
565- conduit >= 1.0 && < 1.1,
566+ conduit >= 1.1 && < 1.2,
567+ conduit-extra >= 1.1 && < 1.2,
568 containers >= 0.4,
569 crypto-api >= 0.9,
570 cryptohash >= 0.8 && < 0.12,
571 cryptohash-cryptoapi == 0.1.*,
572 data-default == 0.5.*,
573 directory >= 1.0 && < 1.3,
574- failure >= 0.2.0.1 && < 0.3,
575 filepath >= 1.1 && < 1.4,
576- http-conduit >= 1.9 && < 2.1,
577+ http-conduit >= 2.1 && < 2.2,
578 http-types >= 0.7 && < 0.9,
579 lifted-base >= 0.1 && < 0.3,
580 monad-control >= 0.3,
581 mtl == 2.*,
582 old-locale == 1.*,
583- resourcet >= 0.3.3 && <0.5,
584+ resourcet >= 1.1 && < 1.2,
585 text >= 0.11,
586 time >= 1.1.4 && < 1.5,
587 transformers >= 0.2.2.0 && < 0.4,
588 unordered-containers >= 0.2,
589 utf8-string == 0.3.*,
590 vector >= 0.10,
591- xml-conduit >= 1.1 && <1.2
592+ xml-conduit >= 1.2 && <1.3
593+ , ghc-prim
595 GHC-Options: -Wall