libjenkins 0.8.3 → 0.8.4

raw patch · 5 files changed

+65/−239 lines, 5 filesdep ~http-clientPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependency ranges changed: http-client

API changes (from Hackage documentation)

Files

• CHANGELOG.markdown +5/−0
• libjenkins.cabal +3/−3
• src/Jenkins/Rest/Internal.hs +23/−14
• src/Network/HTTP/Client/Lens.hs +27/−213
• test/Jenkins/Rest/InternalSpec.hs +7/−9

@@ -1,3 +1,8 @@+0.8.4+=====++  * Supported http-client >= 0.5+ 0.8.3 ===== 

@@ -1,5 +1,5 @@ name:                libjenkins-version:             0.8.3+version:             0.8.4 synopsis:            Jenkins API interface description:         Jenkins API interface. It supports REST and Discovery APIs license:             BSD2@@ -27,7 +27,7 @@ source-repository this   type:     git   location: https://github.com/supki/libjenkins-  tag:      0.8.3+  tag:      0.8.4  library   default-language:@@ -41,7 +41,7 @@     , containers     , free          >= 4.10     , http-conduit  >= 2.1.8-    , http-client   >= 0.4.19+    , http-client   >= 0.5.5     , http-types    >= 0.8     , monad-control >= 0.3     , profunctors   >= 4.2

@@ -39,14 +39,17 @@ import           Control.Monad.Trans.Free.Church (FT, iterTM) import           Control.Monad.Trans.Resource (MonadResource) import           Control.Monad.Writer (MonadWriter(..))-import           Data.ByteString.Lazy (ByteString)-import qualified Data.ByteString as Strict+import           Data.ByteString (ByteString)+import qualified Data.ByteString.Lazy as Lazy (ByteString)+import qualified Data.ByteString.Lazy as ByteString.Lazy import           Data.Conduit (ResumableSource) import           Data.Text (Text) import qualified Data.Text.Encoding as Text import           Data.Typeable (Typeable) import           Network.HTTP.Conduit (Request, HttpException) import qualified Network.HTTP.Conduit as Http+import qualified Network.HTTP.Client as Http (brReadSome)+import qualified Network.HTTP.Client.Internal as Http (throwHttp) import           Network.HTTP.Types (Status(..))  import           Jenkins.Rest.Method.Internal (Method, Type(..), render, slash)@@ -93,9 +96,9 @@   data JF :: (* -> *) -> * -> * where-  Get    :: Method 'Complete f -> (ByteString -> a) -> JF m a-  Stream :: MonadResource m => Method 'Complete f -> (ResumableSource m Strict.ByteString -> a) -> JF m a-  Post   :: (forall f. Method 'Complete f) -> ByteString -> (ByteString -> a) -> JF m a+  Get    :: Method 'Complete f -> (Lazy.ByteString -> a) -> JF m a+  Stream :: MonadResource m => Method 'Complete f -> (ResumableSource m ByteString -> a) -> JF m a+  Post   :: (forall f. Method 'Complete f) -> Lazy.ByteString -> (Lazy.ByteString -> a) -> JF m a   Conc   :: JenkinsT m a -> JenkinsT m b -> (a -> b -> c) -> JF m c   Or     :: JenkinsT m a -> (JenkinsException -> JenkinsT m a) -> JF m a   With   :: (Request -> Request) -> JenkinsT m b -> (b -> a) -> JF m a@@ -126,7 +129,7 @@   :: (MonadIO m, MonadBaseControl IO m)   => String -> Text -> Text -> JenkinsT m a -> m a runInternal h user token jenk = do-  url <- liftIO (wrapException (Http.parseUrl h))+  url <- liftIO (wrapException (Http.parseUrlThrow h))   man <- liftIO (Http.newManager Http.tlsManagerSettings)   runInterpT (iterInterpT man jenk)              (Http.applyBasicAuth (Text.encodeUtf8 user) (Text.encodeUtf8 token) url)@@ -182,13 +185,15 @@     res <- runInterpT (iterInterpT man jenk) (f req)     runInterpT (next res) req -oneshotReq :: MonadIO m => Request -> Http.Manager -> m ByteString-oneshotReq req = liftIO . wrapException . liftM Http.responseBody . Http.httpLbs req+oneshotReq :: MonadIO m => Request -> Http.Manager -> m Lazy.ByteString+oneshotReq req =+  liftIO . wrapException . fmap Http.responseBody . Http.httpLbs req  streamReq   :: (MonadBaseControl IO m, MonadResource m)-  => Request -> Http.Manager -> m (ResumableSource m Strict.ByteString)-streamReq req = wrapException . liftM Http.responseBody . Http.http req+  => Request -> Http.Manager -> m (ResumableSource m ByteString)+streamReq req =+  wrapException . fmap Http.responseBody . Http.http req  intoM   :: forall m a. (MonadIO m, MonadBaseControl IO m)@@ -203,17 +208,21 @@   , Http.path   = Http.path r `slash` render m   } -preparePost :: Method 'Complete f -> ByteString -> Request -> Request+preparePost :: Method 'Complete f -> Lazy.ByteString -> Request -> Request preparePost m body r = r-  { Http.checkStatus   = statusCheck+  { Http.checkResponse = statusCheck   , Http.redirectCount = 0   , Http.requestBody   = Http.RequestBodyLBS body   , Http.method        = "POST"   , Http.path          = Http.path r `slash` render m   }  where-  statusCheck s@(Status st _) hs cookie_jar =-    if 200 <= st && st < 400 then Nothing else Just . toException $ Http.StatusCodeException s hs cookie_jar+  statusCheck _req res =+    unless (200 <= st && st < 400) $ do+      chunk <- Http.brReadSome (Http.responseBody res) 1024+      Http.throwHttp (Http.StatusCodeException (() <$ res) (ByteString.Lazy.toStrict chunk))+   where+    Status st _ = Http.responseStatus res  wrapException :: (MonadBaseControl IO m, MonadIO m) => m a -> m a wrapException m = m `catch` (liftIO . throwIO .  JenkinsHttpException)

@@ -16,39 +16,16 @@   , rawBody   , decompress   , redirectCount-  , checkStatus+  , checkResponse   , responseTimeout   , cookieJar-  , getConnectionWrapper-    -- * 'HttpException' prisms-  , AsHttpException(..)-  , _StatusCodeException-  , _InvalidUrlException-  , _TooManyRedirects-  , _UnparseableRedirect-  , _TooManyRetries-  , _HttpParserException-  , _HandshakeFailed-  , _OverlongHeaders-  , _ResponseTimeout-  , _FailedConnectionException-  , _ExpectedBlankAfter100Continue-  , _InvalidStatusLine-  , _InvalidHeader-  , _InternalIOException-  , _ProxyConnectException-  , _NoResponseDataReceived-  , _TlsException-  , _TlsNotSupported-  , _ResponseBodyTooShort-  , _InvalidChunkHeaders-  , _IncompleteHeaders+  , requestVersion+  , onRequestBodyException+  , requestManagerOverride   ) where -import           Control.Exception (SomeException, IOException)+import           Control.Exception (SomeException) import           Data.ByteString (ByteString)-import qualified Data.ByteString.Lazy as Lazy-import           Data.Word (Word64) import qualified Network.HTTP.Client as H import qualified Network.HTTP.Client.Internal as H import qualified Network.HTTP.Types as H@@ -87,16 +64,16 @@ queryString f req = f (H.queryString req) <&> \qs' -> req { H.queryString = qs' } {-# INLINE queryString #-} --- | 'H.requestBody' lens-requestBody :: Lens' H.Request H.RequestBody-requestBody f req = f (H.requestBody req) <&> \rb' -> req { H.requestBody = rb' }-{-# INLINE requestBody #-}- -- | 'H.requestHeaders' lens requestHeaders :: Lens' H.Request H.RequestHeaders requestHeaders f req = f (H.requestHeaders req) <&> \rh' -> req { H.requestHeaders = rh' } {-# INLINE requestHeaders #-} +-- | 'H.requestBody' lens+requestBody :: Lens' H.Request H.RequestBody+requestBody f req = f (H.requestBody req) <&> \rb' -> req { H.requestBody = rb' }+{-# INLINE requestBody #-}+ -- | 'H.proxy' proxy :: Lens' H.Request (Maybe H.Proxy) proxy f req = f (H.proxy req) <&> \mp' -> req { H.proxy = mp' }@@ -122,13 +99,13 @@ redirectCount f req = f (H.redirectCount req) <&> \rc' -> req { H.redirectCount = rc' } {-# INLINE redirectCount #-} --- | 'H.checkStatus' lens-checkStatus :: Lens' H.Request (H.Status -> H.ResponseHeaders -> H.CookieJar -> Maybe SomeException)-checkStatus f req = f (H.checkStatus req) <&> \cs' -> req { H.checkStatus = cs' }-{-# INLINE checkStatus #-}+-- | 'H.checkResponse' lens+checkResponse :: Lens' H.Request (H.Request -> H.Response H.BodyReader -> IO ())+checkResponse f req = f (H.checkResponse req) <&> \cr' -> req { H.checkResponse = cr' }+{-# INLINE checkResponse #-}  -- | 'H.responseTimeout' lens-responseTimeout :: Lens' H.Request (Maybe Int)+responseTimeout :: Lens' H.Request H.ResponseTimeout responseTimeout f req = f (H.responseTimeout req) <&> \rt' -> req { H.responseTimeout = rt' } {-# INLINE responseTimeout #-} @@ -137,180 +114,17 @@ cookieJar f req = f (H.cookieJar req) <&> \mcj' -> req { H.cookieJar = mcj' } {-# INLINE cookieJar #-} --- | 'H.getConnectionWrapper'-getConnectionWrapper-  :: Lens' H.Request-      ( Maybe Int-      -> H.HttpException-      -> IO (H.ConnRelease, H.Connection, H.ManagedConn)-      -> IO (Maybe Int, (H.ConnRelease, H.Connection, H.ManagedConn))-      )-getConnectionWrapper f req =-  f (H.getConnectionWrapper req) <&> \wat' -> req { H.getConnectionWrapper = wat' }-{-# INLINE getConnectionWrapper #-}----- | @http-conduit@ exceptions-class AsHttpException t where-  -- | @http-conduit@ exceptions overloading-  _HttpException :: Prism' t H.HttpException--instance AsHttpException H.HttpException where-  _HttpException = id-  {-# INLINE _HttpException #-}--instance AsHttpException SomeException where-  _HttpException = exception-  {-# INLINE _HttpException #-}---- | 'H.StatusCodeException' exception-_StatusCodeException :: AsHttpException t => Prism' t (H.Status, H.ResponseHeaders, H.CookieJar)-_StatusCodeException = _HttpException . prism' (uncurry3 H.StatusCodeException) go where-  go (H.StatusCodeException s rh cj) = Just (s, rh, cj)-  go _ = Nothing-{-# INLINE _StatusCodeException #-}---- | 'H.InvalidUrlException' exception-_InvalidUrlException :: AsHttpException t => Prism' t (String, String)-_InvalidUrlException = _HttpException . prism' (uncurry H.InvalidUrlException) go where-  go (H.InvalidUrlException s s') = Just (s, s')-  go _ = Nothing-{-# INLINE _InvalidUrlException #-}---- | 'H.TooManyRedirects' exception-_TooManyRedirects :: AsHttpException t => Prism' t [H.Response Lazy.ByteString]-_TooManyRedirects = _HttpException . prism' H.TooManyRedirects go where-  go (H.TooManyRedirects rs) = Just rs-  go _ = Nothing-{-# INLINE _TooManyRedirects #-}---- | 'H.UnparseableRedirect' exception-_UnparseableRedirect :: AsHttpException t => Prism' t (H.Response Lazy.ByteString)-_UnparseableRedirect = _HttpException . prism' H.UnparseableRedirect go where-  go (H.UnparseableRedirect r) = Just r-  go _ = Nothing-{-# INLINE _UnparseableRedirect #-}---- | 'H.TooManyRetries' exception-_TooManyRetries :: AsHttpException t => Prism' t ()-_TooManyRetries = _HttpException . prism' (const H.TooManyRetries) go where-  go H.TooManyRetries = Just ()-  go _ = Nothing-{-# INLINE _TooManyRetries #-}---- | 'H.HttpParserException' exception-_HttpParserException :: AsHttpException t => Prism' t String-_HttpParserException = _HttpException . prism' H.HttpParserException go where-  go (H.HttpParserException s) = Just s-  go _ = Nothing-{-# INLINE _HttpParserException #-}---- | 'H.HandshakeFailed' exception-_HandshakeFailed :: AsHttpException t => Prism' t ()-_HandshakeFailed = _HttpException . prism' (const H.HandshakeFailed) go where-  go H.HandshakeFailed = Just ()-  go _ = Nothing-{-# INLINE _HandshakeFailed #-}---- | 'H.OverlongHeaders' exception-_OverlongHeaders :: AsHttpException t => Prism' t ()-_OverlongHeaders = _HttpException . prism' (const H.OverlongHeaders) go where-  go H.OverlongHeaders = Just ()-  go _ = Nothing-{-# INLINE _OverlongHeaders #-}---- | 'H.ResponseTimeout' exception-_ResponseTimeout :: AsHttpException t => Prism' t ()-_ResponseTimeout = _HttpException . prism' (const H.ResponseTimeout) go where-  go H.ResponseTimeout = Just ()-  go _ = Nothing-{-# INLINE _ResponseTimeout #-}---- | 'H.FailedConnectionException' exception-_FailedConnectionException :: AsHttpException t => Prism' t (String, Int)-_FailedConnectionException = _HttpException . prism' (uncurry H.FailedConnectionException) go where-  go (H.FailedConnectionException s i) = Just (s, i)-  go _ = Nothing-{-# INLINE _FailedConnectionException #-}---- | 'H.ExpectedBlankAfter100Continue' exception-_ExpectedBlankAfter100Continue :: AsHttpException t => Prism' t ()-_ExpectedBlankAfter100Continue =-  _HttpException . prism' (const H.ExpectedBlankAfter100Continue) go where-    go H.ExpectedBlankAfter100Continue = Just ()-    go _ = Nothing-{-# INLINE _ExpectedBlankAfter100Continue #-}---- | 'H.InvalidStatusLine' exception-_InvalidStatusLine :: AsHttpException t => Prism' t ByteString-_InvalidStatusLine = _HttpException . prism' H.InvalidStatusLine go where-  go (H.InvalidStatusLine b) = Just b-  go _ = Nothing-{-# INLINE _InvalidStatusLine #-}---- | 'H.InvalidHeader' exception-_InvalidHeader :: AsHttpException t => Prism' t ByteString-_InvalidHeader = _HttpException . prism' H.InvalidHeader go where-  go (H.InvalidHeader b) = Just b-  go _ = Nothing-{-# INLINE _InvalidHeader #-}---- | 'H.InternalIOException' exception-_InternalIOException :: AsHttpException t => Prism' t IOException-_InternalIOException = _HttpException . prism' H.InternalIOException go where-  go (H.InternalIOException ioe) = Just ioe-  go _ = Nothing-{-# INLINE _InternalIOException #-}---- | 'H.ProxyConnectException' exception-_ProxyConnectException :: AsHttpException t => Prism' t (ByteString, Int, Either ByteString H.HttpException)-_ProxyConnectException = _HttpException . prism' (uncurry3 H.ProxyConnectException) go where-  go (H.ProxyConnectException b i ebhe) = Just (b, i, ebhe)-  go _ = Nothing-{-# INLINE _ProxyConnectException #-}---- | 'H.NoResponseDataReceived' exception-_NoResponseDataReceived :: AsHttpException t => Prism' t ()-_NoResponseDataReceived = _HttpException . prism' (const H.NoResponseDataReceived) go where-  go H.NoResponseDataReceived = Just ()-  go _ = Nothing-{-# INLINE _NoResponseDataReceived #-}---- | 'H.TlsException' exception-_TlsException :: AsHttpException t => Prism' t SomeException-_TlsException = _HttpException . prism' H.TlsException go where-  go (H.TlsException se) = Just se-  go _ = Nothing-{-# INLINE _TlsException #-}---- | 'H.TlsNotSupported' exception-_TlsNotSupported :: AsHttpException t => Prism' t ()-_TlsNotSupported = _HttpException . prism' (const H.TlsNotSupported) go where-  go H.TlsNotSupported = Just ()-  go _ = Nothing-{-# INLINE _TlsNotSupported #-}---- | 'H.ResponseBodyTooShort' exception-_ResponseBodyTooShort :: AsHttpException t => Prism' t (Word64, Word64)-_ResponseBodyTooShort = _HttpException . prism' (uncurry H.ResponseBodyTooShort) go where-  go (H.ResponseBodyTooShort w w') = Just (w, w')-  go _ = Nothing-{-# INLINE _ResponseBodyTooShort #-}---- | 'H.InvalidChunkHeaders' exception-_InvalidChunkHeaders :: AsHttpException t => Prism' t ()-_InvalidChunkHeaders = _HttpException . prism' (const H.InvalidChunkHeaders) go where-  go H.InvalidChunkHeaders = Just ()-  go _ = Nothing-{-# INLINE _InvalidChunkHeaders #-}+-- | 'H.requestVersion' lens+requestVersion :: Lens' H.Request H.HttpVersion+requestVersion f req = f (H.requestVersion req) <&> \rv' -> req { H.requestVersion = rv' }+{-# INLINE requestVersion #-} --- | 'H.IncompleteHeaders' exception-_IncompleteHeaders :: AsHttpException t => Prism' t ()-_IncompleteHeaders = _HttpException . prism' (const H.IncompleteHeaders) go where-  go H.IncompleteHeaders = Just ()-  go _ = Nothing-{-# INLINE _IncompleteHeaders #-}+-- | 'H.onRequestBodyException' lens+onRequestBodyException :: Lens' H.Request (SomeException -> IO ())+onRequestBodyException f req = f (H.onRequestBodyException req) <&> \cb -> req { H.onRequestBodyException = cb }+{-# INLINE onRequestBodyException #-} -uncurry3 :: (a -> b -> c -> d) -> (a, b, c) -> d-uncurry3 f (a, b, c) = f a b c-{-# INLINE uncurry3 #-}+-- | 'H.requestManagerOverride' lens+requestManagerOverride :: Lens' H.Request (Maybe H.Manager)+requestManagerOverride f req = f (H.requestManagerOverride req) <&> \m' -> req { H.requestManagerOverride = m' }+{-# INLINE requestManagerOverride #-}

@@ -2,10 +2,9 @@ module Jenkins.Rest.InternalSpec (spec) where  import           Control.Lens-import           Control.Exception (throwIO)-import           Control.Exception.Lens (throwingM, _IOException)-import           Network.HTTP.Client (HttpException)-import           Network.HTTP.Types (Status(..))+import           Control.Exception (SomeException, throwIO)+import           Control.Exception.Lens (_IOException)+import           Network.HTTP.Client (HttpException(..), HttpExceptionContent(..)) import           Test.Hspec.Lens import           System.IO.Error import           System.IO.Error.Lens (errorType, _NoSuchThing)@@ -13,7 +12,6 @@ import           Jenkins.Rest (Jenkins, liftIO) import qualified Jenkins.Rest as Jenkins import           Jenkins.Rest.Internal-import           Network.HTTP.Client.Lens (_StatusCodeException, _InvalidUrlException, _TooManyRetries)  _JenkinsException :: Iso' JenkinsException HttpException _JenkinsException = iso (\(JenkinsHttpException e) -> e) JenkinsHttpException@@ -21,7 +19,7 @@ spec :: Spec spec = do   let raiseHttp, raiseIO :: Jenkins a-      raiseHttp = liftIO (throwingM _TooManyRetries ())+      raiseHttp = liftIO (throwIO (HttpExceptionRequest "http://example.com" OverlongHeaders))       raiseIO   = liftIO (throwIO (mkIOError doesNotExistErrorType "foo" Nothing Nothing))       master    = Jenkins.Master {           Jenkins.url = "http://example.com/jenkins"@@ -32,11 +30,11 @@   describe "runJenkins" $ do     it "wraps uncatched 'HttpException' exceptions from the queries in 'Error'" $ do       r <- Jenkins.run master (Jenkins.get Jenkins.plain "hi")-      r `shouldPreview` Status 404 "" `through` _Left._JenkinsException._StatusCodeException._1+      r `shouldHave` _Left._JenkinsException      it "wraps uncatched 'HttpException' exceptions from the URL parsing in 'Error'" $ do       r <- Jenkins.run (master { Jenkins.url = "foo" }) (Jenkins.get Jenkins.plain "hi")-      r `shouldPreview` ("foo", "Invalid URL") `through` _Left._JenkinsException._InvalidUrlException+      r `shouldHave` _Left._JenkinsException      it "can catch 'HttpException' exceptions related from the queries" $ do       r <- Jenkins.run master@@ -44,7 +42,7 @@       r `shouldPreview` (7 :: Integer) `through` _Right      it "does not catch (and wrap) 'HttpException's not from the queries" $-      Jenkins.run master raiseHttp `shouldThrow` _TooManyRetries+      Jenkins.run master raiseHttp `shouldThrow` (id :: Prism' SomeException SomeException)      it "does not catch (and wrap) 'IOException's" $       Jenkins.run master raiseIO `shouldThrow` _IOException.errorType._NoSuchThing