diff --git a/src/BitbucketApi.hs b/src/BitbucketApi.hs index dd7fb01..09e50a3 100644 --- a/src/BitbucketApi.hs +++ b/src/BitbucketApi.hs @@ -25,6 +25,7 @@ import Bitbucket.PullRequest as BP (BranchDetails (..), PullRequestBranch (..), PullRequests (..)) import Bitbucket.PullRequest as BPP (PullRequestPost (..)) +import Control.Exception (catch, SomeException) import Control.Lens ((^.)) import Control.Lens.Operators ((.~)) import CredentialUtils (Credentials (..), credFilePath, @@ -151,13 +152,16 @@ refreshAccessToken = do getBitbucket :: Token -> String -> IO (Response BL.ByteString) getBitbucket token url = do - response <- getWith (bearerAuthHeader token) url + response <- (getWith (bearerAuthHeader token) url) `catch` handleHttpException url let code = response ^. (responseStatus . statusCode) case code of 401 -> do newToken <- refreshAccessToken - getWith (bearerAuthHeader newToken) url + (getWith (bearerAuthHeader newToken) url) `catch` handleHttpException url _ -> return response + where + handleHttpException :: String -> SomeException -> IO a + handleHttpException reqUrl e = P.error $ "HTTP request failed.\nURL: " ++ reqUrl ++ "\nError: " ++ P.show e getIssue :: Token -> String -> IO I.Issue getIssue token itemId = responseToIssue <$> runItemQuery token path @@ -178,7 +182,7 @@ listIssues token _ = do Just url -> do issues <- getIssuesFromUrl token url return $ responseToIssue <$> issues - Nothing -> P.error "Could not identify remote URL." + Nothing -> P.error "Could not identify remote URL. Please ensure you are in a Git repository with a Bitbucket remote." getIssuesFromUrl :: Token -> String -> IO [Issue] getIssuesFromUrl _ "" = return [] @@ -200,7 +204,7 @@ listPullRequests token = do Just url -> do items <- getPullRequestsFromUrl token url return $ responseToPullRequest <$> items - Nothing -> P.error "Could not identify remote URL." + Nothing -> P.error "Could not identify remote URL. Please ensure you are in a Git repository with a Bitbucket remote." createPullRequest :: Token -> PR.PullRequest -> IO PR.PullRequest createPullRequest token item = responseToPullRequest <$> runCreate token "/pullrequests" param @@ -220,19 +224,26 @@ runItemQuery token suffix = do maybeUrl <- buildUrl suffix Nothing case maybeUrl of Just url -> do - maybeItem <- decodeResponse <$> getBitbucket token url + response <- getBitbucket token url + let code = response ^. (responseStatus . statusCode) + maybeItem <- return $ decodeResponse response case maybeItem of Just item -> return item - Nothing -> P.error "Failed to parse response." - Nothing -> P.error "Could not identify remote URL." + Nothing -> P.error $ "Failed to parse response from Bitbucket API.\nURL: " ++ url ++ "\nHTTP Status: " ++ P.show code + Nothing -> P.error "Could not identify remote URL. Please ensure you are in a Git repository with a Bitbucket remote." runCreate :: (ToJSON a, FromJSON b) => Token -> String -> a -> IO b runCreate token suffix param = do -- print $ toJSON param maybeUrl <- buildUrl suffix Nothing case maybeUrl of - Just url -> decodeResponseOrError <$> postBitbucket token url (toJSON param) - Nothing -> P.error "Could not identify remote URL." + Just url -> do + response <- postBitbucket token url (toJSON param) + let code = response ^. (responseStatus . statusCode) + case decodeResponse response of + Just item -> return item + Nothing -> P.error $ "Failed to parse response from Bitbucket API.\nURL: " ++ url ++ "\nHTTP Status: " ++ P.show code + Nothing -> P.error "Could not identify remote URL. Please ensure you are in a Git repository with a Bitbucket remote." readIssueTemplate :: IO String readIssueTemplate = return "" @@ -241,4 +252,7 @@ readPRTemplate :: IO String readPRTemplate = return "" postBitbucket :: Postable a => Token -> String -> a -> IO (Response BL.ByteString) -postBitbucket token = postWith $ bearerAuthHeader token +postBitbucket token url body = (postWith (bearerAuthHeader token) url body) `catch` handleHttpException url + where + handleHttpException :: String -> SomeException -> IO a + handleHttpException reqUrl e = P.error $ "HTTP request failed.\nURL: " ++ reqUrl ++ "\nError: " ++ P.show e diff --git a/src/GitHubApi.hs b/src/GitHubApi.hs index 2338c77..e59fc7e 100644 --- a/src/GitHubApi.hs +++ b/src/GitHubApi.hs @@ -17,6 +17,7 @@ module GitHubApi , runCreate ) where +import Control.Exception (SomeException, catch) import Control.Lens.Operators ((.~), (^.)) import Data.Aeson (FromJSON (parseJSON), ToJSON (toJSON), genericParseJSON) @@ -39,7 +40,8 @@ import JsonUtils (decodeResponse, import Network.HTTP.Types.URI (renderQuery) import Network.Wreq (Options, Response, defaults, getWith, header, linkURL, postWith, - responseLink) + responseLink, responseStatus, + statusCode) import Network.Wreq.Types (Postable) import Prelude as P import System.Directory (doesPathExist) @@ -101,10 +103,16 @@ gitHubHeader :: Token -> Options gitHubHeader token = defaults & header "Authorization" .~ [U8.fromString $ "token " ++ token] getGitHub :: Token -> String -> IO (Response BL.ByteString) -getGitHub token = getWith $ gitHubHeader token +getGitHub token url = (getWith (gitHubHeader token) url) `catch` handleHttpException url + where + handleHttpException :: String -> SomeException -> IO a + handleHttpException reqUrl e = P.error $ "HTTP request failed.\nURL: " ++ reqUrl ++ "\nError: " ++ P.show e postGitHub :: Postable a => Token -> String -> a -> IO (Response BL.ByteString) -postGitHub token = postWith $ gitHubHeader token +postGitHub token url postBody = (postWith (gitHubHeader token) url postBody) `catch` handleHttpException url + where + handleHttpException :: String -> SomeException -> IO a + handleHttpException reqUrl e = P.error $ "HTTP request failed.\nURL: " ++ reqUrl ++ "\nError: " ++ P.show e responseToIssue :: IG.IssueGet -> I.Issue responseToIssue i = @@ -145,18 +153,20 @@ runItemQuery token suffix = do maybeUrl <- buildUrl suffix Nothing case maybeUrl of Just url -> do - maybeItem <- decodeResponse <$> getGitHub token url + response <- getGitHub token url + let code = response ^. (responseStatus . statusCode) + maybeItem <- return $ decodeResponse response case maybeItem of Just item -> return item - Nothing -> P.error "Failed to parse response." - Nothing -> P.error "Could not identify remote URL." + Nothing -> P.error $ "Failed to parse response from GitHub API.\nURL: " ++ url ++ "\nHTTP Status: " ++ P.show code + Nothing -> P.error "Could not identify remote URL. Please ensure you are in a Git repository with a GitHub remote." runListQuery :: FromJSON a => Token -> String -> (a -> b) -> (a -> Bool) -> Bool -> IO [b] runListQuery token suffix converter filtFunc showAll = do maybeUrl <- buildUrl suffix params case maybeUrl of Just url -> fmap converter . filter filtFunc <$> getItemsFromUrl token url - Nothing -> P.error "Could not identify remote URL." + Nothing -> P.error "Could not identify remote URL. Please ensure you are in a Git repository with a GitHub remote." where params = if showAll then (Just . toParamList) [("filter", "all"), ("state", "all")] else Nothing @@ -173,11 +183,13 @@ runCreate token suffix param = do maybeUrl <- buildUrl suffix Nothing case maybeUrl of Just url -> do - maybeItem <- decodeResponse <$> postGitHub token url (toJSON param) + response <- postGitHub token url (toJSON param) + let code = response ^. (responseStatus . statusCode) + maybeItem <- return $ decodeResponse response case maybeItem of Just item -> return item - Nothing -> P.error "Failed to parse response." - Nothing -> P.error "Could not identify remote URL." + Nothing -> P.error $ "Failed to parse response from GitHub API.\nURL: " ++ url ++ "\nHTTP Status: " ++ P.show code + Nothing -> P.error "Could not identify remote URL. Please ensure you are in a Git repository with a GitHub remote." readIssueTemplate :: IO String readIssueTemplate = readFileFromRepoRoot ".github/ISSUE_TEMPLATE.md" diff --git a/src/JsonUtils.hs b/src/JsonUtils.hs index a293125..7dd4589 100644 --- a/src/JsonUtils.hs +++ b/src/JsonUtils.hs @@ -8,8 +8,9 @@ module JsonUtils import Control.Lens.Operators ((^.)) import Data.Aeson (FromJSON, decode) import qualified Data.ByteString.Lazy as BL +import qualified Data.ByteString.Lazy.Char8 as BL8 import Data.Maybe (fromMaybe) -import Network.Wreq (Response, responseBody) +import Network.Wreq (Response, responseBody, responseStatus, statusCode) decodeResponse :: FromJSON a => Response BL.ByteString -> Maybe a decodeResponse resp = decode (resp ^. responseBody) @@ -19,4 +20,9 @@ decodeResponseAsList resp = fromMaybe [] items where items = decode (resp ^. responseBody) decodeResponseOrError :: FromJSON a => Response BL.ByteString -> a -decodeResponseOrError resp = fromMaybe (error "Failed to parse response") $ decodeResponse resp +decodeResponseOrError resp = fromMaybe (error errorMsg) $ decodeResponse resp + where + code = resp ^. (responseStatus . statusCode) + body = BL8.unpack $ resp ^. responseBody + bodyPreview = if length body > 200 then take 200 body ++ "..." else body + errorMsg = "Failed to parse response.\nHTTP Status: " ++ show code ++ "\nResponse body: " ++ bodyPreview