diff --git a/snap-server.cabal b/snap-server.cabal --- a/snap-server.cabal +++ b/snap-server.cabal @@ -1,5 +1,5 @@ name: snap-server -version: 0.9.2.4 +version: 0.9.3 synopsis: A fast, iteratee-based, epoll-enabled web server for the Snap Framework description: Snap is a simple and fast web development framework and server written in @@ -91,14 +91,14 @@ blaze-builder >= 0.2.1.4 && < 0.4, blaze-builder-enumerator >= 0.2.0 && < 0.3, bytestring >= 0.9.1 && < 0.11, - case-insensitive >= 0.3 && < 0.5, + case-insensitive >= 1.0 && < 1.1, containers >= 0.3 && < 0.6, enumerator >= 0.4.15 && < 0.5, MonadCatchIO-transformers >= 0.2.1 && < 0.4, mtl >= 2 && < 3, network >= 2.3 && < 2.5, old-locale, - snap-core >= 0.9.2 && < 0.10, + snap-core >= 0.10 && < 0.11, text >= 0.11 && < 0.12, time >= 1.0 && < 1.5, unix-compat >= 0.2 && < 0.5 diff --git a/test/snap-server-testsuite.cabal b/test/snap-server-testsuite.cabal --- a/test/snap-server-testsuite.cabal +++ b/test/snap-server-testsuite.cabal @@ -26,27 +26,28 @@ blaze-builder >= 0.2.1.4 && <0.4, blaze-builder-enumerator >= 0.2.0 && <0.3, bytestring, + conduit >= 0.5 && <0.6, containers, directory, directory-tree, enumerator >= 0.4.15 && <0.5, filepath, - http-enumerator >= 0.7.3 && <0.8, + http-conduit >= 1.8 && <1.9, HUnit >= 1.2 && <2, mtl >= 2 && <3, network >= 2.3 && <2.5, old-locale, parallel >= 2 && <4, process, - snap-core >= 0.9.2 && <0.10, + snap-core >= 0.10 && <0.11, template-haskell, test-framework >= 0.6 && <0.7, test-framework-hunit >= 0.2.7 && <0.3, test-framework-quickcheck2 >= 0.2.12.1 && <0.3, text >= 0.11 && <0.12, time, - tls >= 0.8.2 && <0.9.3, - tls-extra >= 0.4 && <0.4.5, + tls >= 1.0 && <1.1, + tls-extra >= 0.5 && <0.6, transformers extensions: @@ -103,7 +104,7 @@ parallel >= 3.2 && <4, MonadCatchIO-transformers >= 0.2.1 && <0.4, network >= 2.3 && <2.5, - snap-core >= 0.9.2 && <0.10, + snap-core >= 0.10 && <0.11, template-haskell, time, transformers, @@ -169,7 +170,7 @@ network >= 2.3 && <2.5, old-locale, parallel >= 3.2 && <4, - snap-core >= 0.9.2 && <0.10, + snap-core >= 0.10 && <0.11, template-haskell, test-framework >= 0.6 && <0.7, test-framework-hunit >= 0.2.7 && <0.3, @@ -206,6 +207,4 @@ build-depends: base >= 4 && < 5, network >= 2.3 && < 2.5, - http-enumerator >= 0.7.1.6 && < 0.8, - tls >= 0.8.2 && < 0.9.3, criterion >= 0.6 && < 0.7 diff --git a/test/suite/Snap/Internal/Http/Server/Tests.hs b/test/suite/Snap/Internal/Http/Server/Tests.hs --- a/test/suite/Snap/Internal/Http/Server/Tests.hs +++ b/test/suite/Snap/Internal/Http/Server/Tests.hs @@ -1,9 +1,9 @@ -{-# LANGUAGE CPP #-} -{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE BangPatterns #-} +{-# LANGUAGE CPP #-} +{-# LANGUAGE DeriveDataTypeable #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE PackageImports #-} {-# LANGUAGE ScopedTypeVariables #-} -{-# LANGUAGE PackageImports #-} -{-# LANGUAGE DeriveDataTypeable #-} -{-# LANGUAGE BangPatterns #-} module Snap.Internal.Http.Server.Tests ( tests ) where @@ -11,51 +11,47 @@ import Blaze.ByteString.Builder import Blaze.ByteString.Builder.Enumerator import Control.Concurrent -import Control.Exception ( catch - , try - , throwIO - , bracket - , finally - , SomeException - , Exception ) +import Control.Exception (Exception, SomeException, + bracket, catch, finally, + throwIO, try) import Control.Monad import Control.Monad.Trans -import qualified Data.ByteString.Char8 as S -import qualified Data.ByteString.Lazy as L -import qualified Data.ByteString.Lazy.Char8 as LC -import Data.ByteString (ByteString) -import Data.ByteString.Internal (c2w) -import qualified Data.CaseInsensitive as CI +import Data.ByteString (ByteString) +import qualified Data.ByteString.Char8 as S +import Data.ByteString.Internal (c2w) +import qualified Data.ByteString.Lazy as L +import qualified Data.ByteString.Lazy.Char8 as LC +import qualified Data.CaseInsensitive as CI import Data.Char -import qualified Data.Enumerator as E -import qualified Data.Enumerator.List as EL +import qualified Data.Enumerator as E +import qualified Data.Enumerator.List as EL import Data.Int import Data.IORef -import Data.List (foldl', sort) -import Data.Maybe (fromJust, isJust) +import Data.List (foldl', sort) +import Data.Maybe (fromJust, isJust) import Data.Time.Calendar import Data.Time.Clock import Data.Typeable -import qualified Network.HTTP.Enumerator as HTTP -import qualified Network.Socket.ByteString as N -import Prelude hiding (catch, take) +import qualified Network.HTTP.Conduit as HTTP +import qualified Network.Socket.ByteString as N +import Prelude hiding (catch, take) import qualified Prelude import System.Timeout import Test.Framework import Test.Framework.Providers.HUnit -import Test.HUnit hiding (Test, path) +import Test.HUnit hiding (Test, path) -import qualified Snap.Http.Server as Svr +import qualified Snap.Http.Server as Svr import Snap.Core import Snap.Internal.Debug -import Snap.Internal.Http.Types import Snap.Internal.Http.Server -import qualified Snap.Iteratee as I -import Snap.Iteratee hiding (map) import Snap.Internal.Http.Server.Backend +import Snap.Internal.Http.Types +import Snap.Iteratee hiding (map) +import qualified Snap.Iteratee as I import Snap.Test.Common -import qualified Snap.Types.Headers as H +import qualified Snap.Types.Headers as H data TestException = TestException deriving (Show, Typeable) diff --git a/test/suite/Test/Blackbox.hs b/test/suite/Test/Blackbox.hs --- a/test/suite/Test/Blackbox.hs +++ b/test/suite/Test/Blackbox.hs @@ -1,7 +1,7 @@ -{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE BangPatterns #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE PackageImports #-} {-# LANGUAGE ScopedTypeVariables #-} -{-# LANGUAGE PackageImports #-} -{-# LANGUAGE BangPatterns #-} module Test.Blackbox ( tests @@ -11,36 +11,38 @@ -------------------------------------------------------------------------------- import Blaze.ByteString.Builder import Control.Concurrent -import Control.Exception (SomeException, catch, throwIO) +import Control.Exception (SomeException, catch, + throwIO) import Control.Monad import Control.Monad.Trans -import qualified Data.ByteString.Base16 as B16 -import qualified Data.ByteString.Char8 as S -import Data.ByteString.Char8 (ByteString) -import qualified Data.ByteString.Lazy.Char8 as L -import Data.CaseInsensitive (CI) +import qualified Data.ByteString.Base16 as B16 +import Data.ByteString.Char8 (ByteString) +import qualified Data.ByteString.Char8 as S +import qualified Data.ByteString.Lazy.Char8 as L +import Data.CaseInsensitive (CI) +import Data.Conduit (ResourceT) import Data.Int import Data.List import Data.Monoid -import qualified Network.HTTP.Enumerator as HTTP -import qualified Network.Socket.ByteString as N -import Network.TLS (TLSCertificateUsage(..)) -import Prelude hiding (catch, take) +import qualified Network.HTTP.Conduit as HTTP +import qualified Network.Socket.ByteString as N +import Network.TLS (CertificateUsage (..)) +import Prelude hiding (catch, take) import System.Timeout import Test.Framework import Test.Framework.Options import Test.Framework.Providers.HUnit import Test.Framework.Providers.QuickCheck2 -import Test.HUnit hiding (Test, path) +import Test.HUnit hiding (Test, path) import Test.QuickCheck -import qualified Test.QuickCheck.Property as QC -import qualified Test.QuickCheck.Monadic as QC -import Test.QuickCheck.Monadic hiding (run, assert) +import Test.QuickCheck.Monadic hiding (assert, run) +import qualified Test.QuickCheck.Monadic as QC +import qualified Test.QuickCheck.Property as QC ------------------------------------------------------------------------------ -import Snap.Internal.Debug -import Snap.Iteratee hiding (map, head) -import qualified Snap.Iteratee as I import Snap.Http.Server +import Snap.Internal.Debug +import Snap.Iteratee hiding (head, map) +import qualified Snap.Iteratee as I import Snap.Test.Common import Test.Common.Rot13 import Test.Common.TestHandler @@ -379,42 +381,38 @@ ------------------------------------------------------------------------------ -parseURL :: String -> IO (HTTP.Request IO) -parseURL url = do - req <- HTTP.parseUrl url - return $ req { HTTP.checkCerts = const $ const $ - return CertificateUsageAccept } - - ------------------------------------------------------------------------------- -fetchReq :: HTTP.Request IO -> IO (L.ByteString) +fetchReq :: HTTP.Request (ResourceT IO) -> IO (L.ByteString) fetchReq req = go `catch` (\(e::SomeException) -> do debug $ "simpleHttp threw exception: " ++ show e throwIO e) where go = do - rsp <- HTTP.withManager $ HTTP.httpLbs req + rsp <- HTTP.withManagerSettings settings $ HTTP.httpLbs req return $ HTTP.responseBody rsp + settings = HTTP.def { HTTP.managerCheckCerts = \_ _ _ -> + return CertificateUsageAccept } ------------------------------------------------------------------------------ -fetchResponse :: String -> IO (HTTP.Response) +fetchResponse :: String -> IO (HTTP.Response L.ByteString) fetchResponse url = do - req <- parseURL url `catch` (\(e::SomeException) -> do - debug $ "parseURL threw exception: " ++ show e + req <- HTTP.parseUrl url `catch` (\(e::SomeException) -> do + debug $ "parseUrl threw exception: " ++ show e throwIO e) go req `catch` (\(e::SomeException) -> do debug $ "simpleHttp threw exception: " ++ show e throwIO e) where - go req = HTTP.withManager $ HTTP.httpLbs req + go req = HTTP.withManagerSettings settings $ HTTP.httpLbs req + settings = HTTP.def { HTTP.managerCheckCerts = \_ _ _ -> + return CertificateUsageAccept } ------------------------------------------------------------------------------ fetch :: String -> IO (L.ByteString) fetch url = do - req <- parseURL url `catch` (\(e::SomeException) -> do - debug $ "parseURL threw exception: " ++ show e + req <- HTTP.parseUrl url `catch` (\(e::SomeException) -> do + debug $ "HTTP.parseUrl threw exception: " ++ show e throwIO e) fetchReq req @@ -425,8 +423,8 @@ -> [(CI ByteString, ByteString)] -> IO (L.ByteString) post url body hdrs = do - req <- parseURL url `catch` (\(e::SomeException) -> do - debug $ "parseURL threw exception: " ++ show e + req <- HTTP.parseUrl url `catch` (\(e::SomeException) -> do + debug $ "HTTP.parseUrl threw exception: " ++ show e throwIO e) fetchReq $ req { HTTP.requestBody = HTTP.RequestBodyLBS body , HTTP.method = "POST"