From 5d3b6d2d4f9f362153b929a5aba1d95e612a7bcc Mon Sep 17 00:00:00 2001 From: Michael Snoyman Date: Thu, 3 Apr 2014 08:33:32 +0300 Subject: [PATCH] Patches to close #202 #203 #206 --- Stackage/Config.hs | 21 - patching/patches/aws-0.8.5.patch | 633 +++++++++++++++++- patching/patches/cereal-conduit-0.7.2.patch | 53 ++ .../patches/diagrams-builder-0.5.0.6.patch | 12 + patching/patches/esqueleto-1.3.8.patch | 12 + .../patches/process-conduit-1.0.0.2.patch | 62 ++ patching/patches/stm-conduit-2.3.0.patch | 16 + patching/patches/temporary-1.2.0.1.patch | 12 + patching/patches/websockets-0.8.2.0.patch | 21 + 9 files changed, 815 insertions(+), 27 deletions(-) create mode 100644 patching/patches/cereal-conduit-0.7.2.patch create mode 100644 patching/patches/diagrams-builder-0.5.0.6.patch create mode 100644 patching/patches/esqueleto-1.3.8.patch create mode 100644 patching/patches/process-conduit-1.0.0.2.patch create mode 100644 patching/patches/stm-conduit-2.3.0.patch create mode 100644 patching/patches/temporary-1.2.0.1.patch create mode 100644 patching/patches/websockets-0.8.2.0.patch diff --git a/Stackage/Config.hs b/Stackage/Config.hs index 53f8d610..23746289 100644 --- a/Stackage/Config.hs +++ b/Stackage/Config.hs @@ -356,33 +356,12 @@ defaultStablePackages ghcVer requireHP = unPackageMap $ execWriter $ do -- https://github.com/fpco/stackage/issues/200 addRange "Michael Snoyman" "hspec" "< 1.9" - -- https://github.com/fpco/stackage/issues/202 - addRange "Michael Snoyman" "case-insensitive" "< 1.2" - addRange "Michael Snoyman" "xml-conduit" "< 1.2" - - -- https://github.com/fpco/stackage/issues/203 - addRange "Michael Snoyman" "exceptions" "< 0.4" - -- https://github.com/fpco/stackage/issues/204 addRange "Michael Snoyman" "intervals" "< 0.5" -- https://github.com/fpco/stackage/issues/205 addRange "Michael Snoyman" "hastache" "< 0.6" - -- https://github.com/fpco/stackage/issues/206 - addRange "Michael Snoyman" "conduit" "< 1.1" - addRange "Michael Snoyman" "conduit-extra" "< 1.1" - addRange "Michael Snoyman" "attoparsec-conduit" "< 1.1" - addRange "Michael Snoyman" "resourcet" "< 1.1" - addRange "Michael Snoyman" "blaze-builder-conduit" "< 1.1" - addRange "Michael Snoyman" "zlib-conduit" "< 1.1" - addRange "Michael Snoyman" "network-conduit" "< 1.1" - addRange "Michael Snoyman" "network-conduit-tls" "< 1.1" - addRange "Michael Snoyman" "http-conduit" "< 2.1" - addRange "Michael Snoyman" "http-client" "< 0.3" - addRange "Michael Snoyman" "http-client-conduit" "< 0.3" - addRange "Michael Snoyman" "http-client-multipart" "< 0.3" - -- https://github.com/ozataman/csv-conduit/issues/10 addRange "Michael Snoyman" "csv-conduit" "< 0.6.2 || > 0.6.2" diff --git a/patching/patches/aws-0.8.5.patch b/patching/patches/aws-0.8.5.patch index c81b96d1..1ea5a876 100644 --- a/patching/patches/aws-0.8.5.patch +++ b/patching/patches/aws-0.8.5.patch @@ -1,14 +1,635 @@ +diff -ru orig/Aws/Aws.hs new/Aws/Aws.hs +--- orig/Aws/Aws.hs 2014-04-03 08:17:21.058394778 +0300 ++++ new/Aws/Aws.hs 2014-04-03 08:17:20.000000000 +0300 +@@ -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 +diff -ru orig/Aws/Core.hs new/Aws/Core.hs +--- orig/Aws/Core.hs 2014-04-03 08:17:21.058394778 +0300 ++++ new/Aws/Core.hs 2014-04-03 08:17:20.000000000 +0300 +@@ -89,13 +89,12 @@ + 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 Control.Monad.Trans.Resource (ResourceT, MonadThrow (throwM)) + 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 Data.ByteString (ByteString) + import qualified Data.ByteString as B + import qualified Data.ByteString.Base16 as Base16 +@@ -104,7 +103,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) +@@ -137,12 +136,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 +158,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 () +@@ -696,24 +695,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 +730,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 +diff -ru orig/Aws/DynamoDb/Core.hs new/Aws/DynamoDb/Core.hs +--- orig/Aws/DynamoDb/Core.hs 2014-04-03 08:17:21.062394778 +0300 ++++ new/Aws/DynamoDb/Core.hs 2014-04-03 08:17:20.000000000 +0300 +@@ -2,6 +2,7 @@ + + import Aws.Core + import qualified Control.Exception as C ++import Control.Monad.Trans.Resource (throwM) + import Crypto.Hash.CryptoAPI (SHA256, hash) + import qualified Data.Aeson as A + import qualified Data.ByteString as B +@@ -125,5 +126,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) +diff -ru orig/Aws/Ec2/InstanceMetadata.hs new/Aws/Ec2/InstanceMetadata.hs +--- orig/Aws/Ec2/InstanceMetadata.hs 2014-04-03 08:17:21.062394778 +0300 ++++ new/Aws/Ec2/InstanceMetadata.hs 2014-04-03 08:17:20.000000000 +0300 +@@ -2,8 +2,7 @@ + + import Control.Applicative + import Control.Exception +-import Control.Failure +-import Control.Monad.Trans.Resource ++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 +@@ -16,19 +15,19 @@ + + instance Exception InstanceMetadataException + +-getInstanceMetadata :: HTTP.Manager -> String -> String -> ResIO L.ByteString ++getInstanceMetadata :: HTTP.Manager -> String -> String -> IO L.ByteString + getInstanceMetadata mgr p x = do req <- HTTP.parseUrl ("http://169.254.169.254/" ++ p ++ '/' : x) + HTTP.responseBody <$> HTTP.httpLbs req mgr + +-getInstanceMetadataListing :: HTTP.Manager -> String -> ResIO [String] ++getInstanceMetadataListing :: HTTP.Manager -> String -> IO [String] + getInstanceMetadataListing mgr p = map BU.toString . B8.split '\n' <$> getInstanceMetadata mgr p "" + +-getInstanceMetadataFirst :: HTTP.Manager -> String -> ResIO L.ByteString ++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 -> ResIO L.ByteString ++getInstanceMetadataOrFirst :: HTTP.Manager -> String -> Maybe String -> IO L.ByteString + getInstanceMetadataOrFirst mgr p (Just x) = getInstanceMetadata mgr p x + getInstanceMetadataOrFirst mgr p Nothing = getInstanceMetadataFirst mgr p +diff -ru orig/Aws/Iam/Core.hs new/Aws/Iam/Core.hs +--- orig/Aws/Iam/Core.hs 2014-04-03 08:17:21.062394778 +0300 ++++ new/Aws/Iam/Core.hs 2014-04-03 08:17:20.000000000 +0300 +@@ -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 +diff -ru orig/Aws/Iam/Internal.hs new/Aws/Iam/Internal.hs +--- orig/Aws/Iam/Internal.hs 2014-04-03 08:17:21.062394778 +0300 ++++ new/Aws/Iam/Internal.hs 2014-04-03 08:17:20.000000000 +0300 +@@ -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 +diff -ru orig/Aws/S3/Commands/CopyObject.hs new/Aws/S3/Commands/CopyObject.hs +--- orig/Aws/S3/Commands/CopyObject.hs 2014-04-03 08:17:21.062394778 +0300 ++++ new/Aws/S3/Commands/CopyObject.hs 2014-04-03 08:17:20.000000000 +0300 +@@ -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" +diff -ru orig/Aws/S3/Core.hs new/Aws/S3/Core.hs +--- orig/Aws/S3/Core.hs 2014-04-03 08:17:21.062394778 +0300 ++++ new/Aws/S3/Core.hs 2014-04-03 08:17:20.000000000 +0300 +@@ -5,8 +5,8 @@ + import Control.Arrow ((***)) + import Control.Monad + import Control.Monad.IO.Class ++import Control.Monad.Trans.Resource (MonadThrow, throwM) + import Crypto.Hash.CryptoAPI (MD5) +-import Data.Attempt (Attempt(..)) + import Data.Conduit (($$+-)) + import Data.Function + import Data.IORef +@@ -20,12 +20,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 +@@ -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 $ +diff -ru orig/Aws/Ses/Core.hs new/Aws/Ses/Core.hs +--- orig/Aws/Ses/Core.hs 2014-04-03 08:17:21.062394778 +0300 ++++ new/Aws/Ses/Core.hs 2014-04-03 08:17:20.000000000 +0300 +@@ -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. +diff -ru orig/Aws/SimpleDb/Core.hs new/Aws/SimpleDb/Core.hs +--- orig/Aws/SimpleDb/Core.hs 2014-04-03 08:17:21.066394778 +0300 ++++ new/Aws/SimpleDb/Core.hs 2014-04-03 08:17:20.000000000 +0300 +@@ -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 +diff -ru orig/Aws/Sqs/Commands/Message.hs new/Aws/Sqs/Commands/Message.hs +--- orig/Aws/Sqs/Commands/Message.hs 2014-04-03 08:17:21.066394778 +0300 ++++ new/Aws/Sqs/Commands/Message.hs 2014-04-03 08:17:20.000000000 +0300 +@@ -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 +diff -ru orig/Aws/Sqs/Core.hs new/Aws/Sqs/Core.hs +--- orig/Aws/Sqs/Core.hs 2014-04-03 08:17:21.066394778 +0300 ++++ new/Aws/Sqs/Core.hs 2014-04-03 08:17:20.000000000 +0300 +@@ -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" diff -ru orig/aws.cabal new/aws.cabal ---- orig/aws.cabal 2014-04-02 13:40:50.015820737 +0300 -+++ new/aws.cabal 2014-04-02 13:40:49.000000000 +0300 -@@ -130,7 +130,9 @@ +--- orig/aws.cabal 2014-04-03 08:17:21.070394778 +0300 ++++ new/aws.cabal 2014-04-03 08:17:20.000000000 +0300 +@@ -20,7 +20,7 @@ + Source-repository this + type: git + location: https://github.com/aristidb/aws.git +- tag: 0.8.5 ++ tag: 0.8.6 + + Source-repository head + type: git +@@ -98,8 +98,6 @@ + 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.*, +@@ -108,29 +106,29 @@ + 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.*, + 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.1 && <1.2, -+ http-client < 0.3, -+ ghc-prim ++ xml-conduit >= 1.2 && <1.3 GHC-Options: -Wall +diff -ru orig/README.org new/README.org +--- orig/README.org 2014-04-03 08:17:21.058394778 +0300 ++++ new/README.org 2014-04-03 08:17:20.000000000 +0300 +@@ -90,6 +90,10 @@ + + ** 0.8 series + ++- 0.8.6 ++ - move Instance metadata functions out of ResourceT to remove problem with exceptions-0.5 ++ (this makes a fresh install of aws on a clean system possible again) ++ + - 0.8.5 + - compatibility with case-insensitive 1.2 + - support for V4 signatures diff --git a/patching/patches/cereal-conduit-0.7.2.patch b/patching/patches/cereal-conduit-0.7.2.patch new file mode 100644 index 00000000..020ed133 --- /dev/null +++ b/patching/patches/cereal-conduit-0.7.2.patch @@ -0,0 +1,53 @@ +diff -ru orig/cereal-conduit.cabal new/cereal-conduit.cabal +--- orig/cereal-conduit.cabal 2014-04-03 08:22:14.122388542 +0300 ++++ new/cereal-conduit.cabal 2014-04-03 08:22:13.000000000 +0300 +@@ -19,7 +19,8 @@ + + library + build-depends: base >= 4 && < 5 +- , conduit >= 1.0.0 && < 1.1 ++ , conduit >= 1.0.0 && < 1.2 ++ , resourcet >= 0.4 && < 1.2 + , cereal >= 0.4.0.0 && < 0.5 + , bytestring + , transformers >= 0.2.0.0 +diff -ru orig/Data/Conduit/Cereal.hs new/Data/Conduit/Cereal.hs +--- orig/Data/Conduit/Cereal.hs 2014-04-03 08:22:14.122388542 +0300 ++++ new/Data/Conduit/Cereal.hs 2014-04-03 08:22:13.000000000 +0300 +@@ -19,6 +19,7 @@ + + import Control.Exception.Base + import Control.Monad.Trans.Class (MonadTrans, lift) ++import Control.Monad.Trans.Resource (MonadThrow, monadThrow) + import qualified Data.ByteString as BS + import qualified Data.ByteString.Lazy as LBS + import qualified Data.Conduit as C +@@ -34,7 +35,7 @@ + instance Exception GetException + + -- | Run a 'Get' repeatedly on the input stream, producing an output stream of whatever the 'Get' outputs. +-conduitGet :: C.MonadThrow m => Get o -> C.Conduit BS.ByteString m o ++conduitGet :: MonadThrow m => Get o -> C.Conduit BS.ByteString m o + conduitGet = mkConduitGet errorHandler + where errorHandler msg = pipeError $ GetException msg + +@@ -42,7 +43,7 @@ + -- + -- If 'Get' succeed it will return the data read and unconsumed part of the input stream. + -- If the 'Get' fails due to deserialization error or early termination of the input stream it raise an error. +-sinkGet :: C.MonadThrow m => Get r -> C.Consumer BS.ByteString m r ++sinkGet :: MonadThrow m => Get r -> C.Consumer BS.ByteString m r + sinkGet = mkSinkGet errorHandler terminationHandler + where errorHandler msg = pipeError $ GetException msg + terminationHandler f = case f BS.empty of +@@ -50,8 +51,8 @@ + Done r lo -> C.leftover lo >> return r + Partial _ -> pipeError $ GetException "Failed reading: Internal error: unexpected Partial." + +-pipeError :: (C.MonadThrow m, MonadTrans t, Exception e) => e -> t m a +-pipeError e = lift $ C.monadThrow e ++pipeError :: (MonadThrow m, MonadTrans t, Exception e) => e -> t m a ++pipeError e = lift $ monadThrow e + + -- | Convert a 'Put' into a 'Source'. Runs in constant memory. + sourcePut :: Monad m => Put -> C.Producer m BS.ByteString diff --git a/patching/patches/diagrams-builder-0.5.0.6.patch b/patching/patches/diagrams-builder-0.5.0.6.patch new file mode 100644 index 00000000..c29a564d --- /dev/null +++ b/patching/patches/diagrams-builder-0.5.0.6.patch @@ -0,0 +1,12 @@ +diff -ru orig/diagrams-builder.cabal new/diagrams-builder.cabal +--- orig/diagrams-builder.cabal 2014-04-03 08:17:21.630394766 +0300 ++++ new/diagrams-builder.cabal 2014-04-03 08:17:21.000000000 +0300 +@@ -59,7 +59,7 @@ + cmdargs >= 0.6 && < 0.11, + lens >= 3.9 && < 4.2, + hashable >= 1.1 && < 1.3, +- exceptions >= 0.3 && < 0.4 ++ exceptions >= 0.3 && < 0.6 + hs-source-dirs: src + default-language: Haskell2010 + other-extensions: StandaloneDeriving, diff --git a/patching/patches/esqueleto-1.3.8.patch b/patching/patches/esqueleto-1.3.8.patch new file mode 100644 index 00000000..0a3c3c1d --- /dev/null +++ b/patching/patches/esqueleto-1.3.8.patch @@ -0,0 +1,12 @@ +diff -ru orig/esqueleto.cabal new/esqueleto.cabal +--- orig/esqueleto.cabal 2014-04-03 08:31:02.238377300 +0300 ++++ new/esqueleto.cabal 2014-04-03 08:31:01.000000000 +0300 +@@ -91,7 +91,7 @@ + , containers + , HUnit + , QuickCheck +- , hspec >= 1.9 ++ , hspec >= 1.8 + , persistent-sqlite >= 1.2 && < 1.4 + , persistent-template >= 1.2 && < 1.4 + , monad-control diff --git a/patching/patches/process-conduit-1.0.0.2.patch b/patching/patches/process-conduit-1.0.0.2.patch new file mode 100644 index 00000000..79939e21 --- /dev/null +++ b/patching/patches/process-conduit-1.0.0.2.patch @@ -0,0 +1,62 @@ +diff -ru orig/Data/Conduit/Process.hs new/Data/Conduit/Process.hs +--- orig/Data/Conduit/Process.hs 2014-04-03 08:26:07.254383579 +0300 ++++ new/Data/Conduit/Process.hs 2014-04-03 08:26:06.000000000 +0300 +@@ -21,6 +21,7 @@ + import Control.Monad + import Control.Monad.Trans + import Control.Monad.Trans.Loop ++import Control.Monad.Trans.Resource (MonadResource, monadThrow) + import qualified Data.ByteString as S + import Data.Conduit + import qualified Data.Conduit.List as CL +diff -ru orig/process-conduit.cabal new/process-conduit.cabal +--- orig/process-conduit.cabal 2014-04-03 08:26:07.258383579 +0300 ++++ new/process-conduit.cabal 2014-04-03 08:26:06.000000000 +0300 +@@ -33,7 +33,8 @@ + , bytestring >= 0.9 + , text >= 0.11 + , process >= 1.0 +- , conduit == 1.0.* ++ , conduit >= 1.0 && < 1.2 ++ , resourcet >= 0.4 && < 1.2 + , shakespeare-text >= 1.0 + , shakespeare + +@@ -47,4 +48,6 @@ + , bytestring + , hspec >= 1.3 + , conduit ++ , conduit-extra ++ , resourcet + , process-conduit +diff -ru orig/System/Process/QQ.hs new/System/Process/QQ.hs +--- orig/System/Process/QQ.hs 2014-04-03 08:26:07.254383579 +0300 ++++ new/System/Process/QQ.hs 2014-04-03 08:26:06.000000000 +0300 +@@ -14,6 +14,7 @@ + import qualified Data.Text.Lazy as LT + import Language.Haskell.TH.Quote + import Text.Shakespeare.Text ++import Control.Monad.Trans.Resource (runResourceT) + + import Data.Conduit.Process + +@@ -28,7 +29,7 @@ + -- | Command result of (Lazy) ByteString. + cmd :: QuasiQuoter + cmd = def { quoteExp = \str -> [| +- BL.fromChunks <$> C.runResourceT (sourceCmd (LT.unpack $(quoteExp lt str)) C.$$ CL.consume) ++ BL.fromChunks <$> runResourceT (sourceCmd (LT.unpack $(quoteExp lt str)) C.$$ CL.consume) + |] } + + -- | Source of shell command +diff -ru orig/test.hs new/test.hs +--- orig/test.hs 2014-04-03 08:26:07.254383579 +0300 ++++ new/test.hs 2014-04-03 08:26:06.000000000 +0300 +@@ -7,6 +7,7 @@ + import Data.Conduit + import qualified Data.Conduit.Binary as CB + import Test.Hspec ++import Control.Monad.Trans.Resource (runResourceT) + + main :: IO () + main = hspec $ do diff --git a/patching/patches/stm-conduit-2.3.0.patch b/patching/patches/stm-conduit-2.3.0.patch new file mode 100644 index 00000000..c06f61af --- /dev/null +++ b/patching/patches/stm-conduit-2.3.0.patch @@ -0,0 +1,16 @@ +diff -ru orig/stm-conduit.cabal new/stm-conduit.cabal +--- orig/stm-conduit.cabal 2014-04-03 08:22:14.310388538 +0300 ++++ new/stm-conduit.cabal 2014-04-03 08:22:14.000000000 +0300 +@@ -29,9 +29,10 @@ + , stm-chans >= 2.0 && < 3.1 + , cereal >= 0.4.0.1 + , cereal-conduit >= 0.7.2 +- , conduit == 1.0.* ++ , conduit >= 1.0 && < 1.2 ++ , conduit-extra >= 1.0 && < 1.2 + , directory >= 1.1 +- , resourcet >= 0.3 && < 0.5 ++ , resourcet >= 0.3 && < 1.2 + , async >= 2.0.1 + , monad-control >= 0.3.2 + , monad-loops >= 0.4.2 diff --git a/patching/patches/temporary-1.2.0.1.patch b/patching/patches/temporary-1.2.0.1.patch new file mode 100644 index 00000000..16d68bfd --- /dev/null +++ b/patching/patches/temporary-1.2.0.1.patch @@ -0,0 +1,12 @@ +diff -ru orig/temporary.cabal new/temporary.cabal +--- orig/temporary.cabal 2014-04-03 08:17:21.902394760 +0300 ++++ new/temporary.cabal 2014-04-03 08:17:21.000000000 +0300 +@@ -23,7 +23,7 @@ + other-modules: Distribution.Compat.Exception + Distribution.Compat.TempFile + build-depends: base >= 3 && < 6, filepath >= 1.1 && < 1.4, directory >= 1.0 && < 1.3, +- transformers >= 0.2.0.0 && < 0.4, exceptions >= 0.1.1 && < 0.4 ++ transformers >= 0.2.0.0 && < 0.4, exceptions >= 0.1.1 && < 0.6 + + if !os(windows) + build-depends: unix >= 2.3 && < 2.8 diff --git a/patching/patches/websockets-0.8.2.0.patch b/patching/patches/websockets-0.8.2.0.patch new file mode 100644 index 00000000..6e209777 --- /dev/null +++ b/patching/patches/websockets-0.8.2.0.patch @@ -0,0 +1,21 @@ +diff -ru orig/websockets.cabal new/websockets.cabal +--- orig/websockets.cabal 2014-04-03 08:32:53.818374925 +0300 ++++ new/websockets.cabal 2014-04-03 08:32:53.000000000 +0300 +@@ -69,7 +69,7 @@ + binary >= 0.5 && < 0.8, + blaze-builder >= 0.3 && < 0.4, + bytestring >= 0.9 && < 0.11, +- case-insensitive >= 0.3 && < 1.2, ++ case-insensitive >= 0.3 && < 1.3, + containers >= 0.3 && < 0.6, + io-streams >= 1.1 && < 1.2, + mtl >= 2.0 && < 2.2, +@@ -105,7 +105,7 @@ + binary >= 0.5 && < 0.8, + blaze-builder >= 0.3 && < 0.4, + bytestring >= 0.9 && < 0.11, +- case-insensitive >= 0.3 && < 1.2, ++ case-insensitive >= 0.3 && < 1.3, + containers >= 0.3 && < 0.6, + io-streams >= 1.1 && < 1.2, + mtl >= 2.0 && < 2.2,