packages feed

mangopay 1.10 → 1.10.1

raw patch · 3 files changed

+49/−3 lines, 3 filesdep +connectiondep +tlsdep +x509-system

Dependencies added: connection, tls, x509-system

Files

mangopay.cabal view
@@ -1,5 +1,5 @@ name:           mangopay-version:        1.10+version:        1.10.1 cabal-version:  >= 1.8 build-type:     Simple author:         JP Moresmau <jpmoresmau@gmail.com>@@ -62,6 +62,11 @@      , wai                  >= 3.0        && < 3.1      , warp                 >= 3.0        && < 3.1 +       -- Needed for withWorkaroundManager+     , tls+     , connection+     , x509-system+   if flag(conduit11)     build-depends:          conduit              == 1.1.*@@ -115,6 +120,8 @@      resourcet, template-haskell, text, time, transformers,      transformers-base, unordered-containers, utf8-string,      vector, wai, warp, country-codes++     , tls, connection, x509-system       , HTF            >  0.9   if flag(conduit11)
src/Web/MangoPay/TestUtils.hs view
@@ -24,10 +24,12 @@ import Control.Concurrent.MVar (MVar, newMVar, putMVar, takeMVar) import Control.Exception (bracket) import Control.Monad (void, liftM)-import Control.Monad.IO.Class (liftIO)+import Control.Monad.IO.Class (MonadIO, liftIO)+import Control.Monad.Trans.Control (MonadBaseControl) import Control.Monad.Logger (LoggingT, runStdoutLoggingT, logDebugS, logWarnS) import Control.Monad.Trans.Resource (ResourceT, runResourceT) import Data.Conduit (($$+-))+import Data.Default (def) import Data.Maybe (isJust) import Data.Monoid ((<>)) import Data.Text (Text)@@ -49,8 +51,12 @@ import qualified Data.Text as T import qualified Data.Text.Encoding as TE import qualified Data.ByteString as BS+import qualified Network.Connection as Conn import qualified Network.HTTP.Types as HT+import qualified Network.TLS as TLS+import qualified Network.TLS.Extra as TLSX import qualified Network.Wai as W+import qualified System.X509 as X509   ----------------------------------------------------------------------@@ -254,7 +260,7 @@      -- this module.   -> IO a withMangoPayTestUtils act =-  H.withManager $ \mgr -> liftIO $ do+  withWorkaroundManager $ \mgr -> liftIO $ do     hook <- getHookEndPoint     res  <- newReceivedEvents     -- Initial state.@@ -266,6 +272,37 @@       (startHTTPServer hook res)       killThread       (const $ initializeTestState >>= \(creds, at) -> act creds at mgr)+++-- | Same as 'H.withManager', but without TLS 1.2 support.+--+-- As of 2014-11-22, there's a bug on the @tls@ package that+-- prevents connections to be made to the MangoPay servers.  For+-- some reason, disabling TLS 1.2 works around this problem.+-- Cf. <https://github.com/vincenthz/hs-tls/issues/87>.+--+-- This function isn't named @withTLS11Manager@ because it will+-- eventually be changed to be the same as 'H.withManager' as+-- soon as this bug is fixed.+withWorkaroundManager :: (MonadIO m, MonadBaseControl IO m) => (H.Manager -> ResourceT m a) -> m a+withWorkaroundManager act = liftIO ioActions >>= flip H.withManagerSettings act . mkSettings+  where+    ioActions =+      X509.getSystemCertificateStore+    mkParams certStore =+      (TLS.defaultParamsClient neverHere neverHere)+        { TLS.clientSupported = def+            { TLS.supportedVersions = noTLS12+            , TLS.supportedCiphers = TLSX.ciphersuite_all }+        , TLS.clientShared = def+            { TLS.sharedCAStore = certStore }+        }+      where+        noTLS12 = filter (/= TLS.TLS12) (TLS.supportedVersions def)+        neverHere :: a+        neverHere = error "withWorkaroundManager: never here, TLSSettings/ClientParams"+    mkSettings =+      flip H.mkManagerSettings Nothing . Conn.TLSSettings . mkParams   ----------------------------------------------------------------------
test/Web/MangoPay/DocumentsTest.hs view
@@ -29,6 +29,8 @@     tf<-BS.readFile "data/test.jpg"     -- document has to be in CREATED status     testMP $ createPage uid (fromJust $ dId d2) tf+    tf2<-BS.readFile "data/test.png"+    testMP $ createPage uid (fromJust $ dId d2) tf2     d3<-testMP $ modifyDocument uid d2{dStatus=Just VALIDATION_ASKED}     assertEqual (Just VALIDATION_ASKED) (dStatus d3)     assertEqual (dId d2) (dId d3)