Merge pull request #350 from phadej/cherry-picks

Cherry-picks from TomMD's PRs.

Author: phadej

CHANGELOG.md

@@ -2,8 +2,24 @@
 
 ## Changes for 0.21
 
+- Refactor `Request` type.
+  [#349](https://github.com/phadej/github/pull/349)
 - Allow `http-client-0.6`
+  [#344](https://github.com/phadej/github/pull/344)
 - Change to use `cryptohash-sha1` (`cryptohash` was used before)
+- Add Create milestone endponts
+  [#337](https://github.com/phadej/github/pull/337)
+- Make fileBlobUrl and fileRawUrl are optional
+  [#339](https://github.com/phadej/github/issues/339)
+  [#340](https://github.com/phadej/github/pull/340)
+- Add organizationsR to request user organizations
+  [#345](https://github.com/phadej/github/pull/345)
+- Add updateMilestoneR, deleteMilestoneR
+  [#338](https://github.com/phadej/github/pull/338)
+- Allow multiple assignees in NewIssue and EditIssue
+  [#336](https://github.com/phadej/github/pull/336)
+- Add `pullRequestPatchR` and `pullRequestDiffR`
+  [#325](https://github.com/phadej/github/pull/325)
 
 ## Changes for 0.20
 

spec/GitHub/PullRequestsSpec.hs

@@ -14,6 +14,7 @@ import           Data.FileEmbed     (embedFile)
 import           Data.Foldable      (for_)
 import           Data.String        (fromString)
 import qualified Data.Vector        as V
+import qualified Data.ByteString.Lazy.Char8 as LBS8
 import           System.Environment (lookupEnv)
 import           Test.Hspec
                  (Spec, describe, it, pendingWith, shouldBe, shouldSatisfy)
@@ -37,6 +38,12 @@ spec = do
                 GitHub.pullRequestsForR owner repo opts GitHub.FetchAll
             cs `shouldSatisfy` isRight
 
+    describe "pullRequestPatchR" $
+        it "works" $ withAuth $ \auth -> do
+            Right patch <- GitHub.executeRequest auth $
+                GitHub.pullRequestPatchR "phadej" "github" (GitHub.IssueNumber 349)
+            head (LBS8.lines patch) `shouldBe` "From c0e4ad33811be82e1f72ee76116345c681703103 Mon Sep 17 00:00:00 2001"
+
     describe "decoding pull request payloads" $ do
         it "decodes a pull request 'opened' payload" $ do
             V.length (GitHub.simplePullRequestRequestedReviewers simplePullRequestOpened)
@@ -62,7 +69,6 @@ spec = do
     repos =
       [ ("thoughtbot", "paperclip")
       , ("phadej", "github")
-      , ("haskell", "cabal")
       ]
     opts = GitHub.stateClosed
 

src/GitHub.hs

@@ -193,6 +193,8 @@ module GitHub (
     -- | See <https://developer.github.com/v3/pulls/>
     pullRequestsForR,
     pullRequestR,
+    pullRequestPatchR,
+    pullRequestDiffR,
     createPullRequestR,
     updatePullRequestR,
     pullRequestCommitsR,
@@ -206,11 +208,11 @@ module GitHub (
     -- Missing endpoints:
     --
     -- * List comments in a repository
-    -- * Create a comment
     -- * Edit a comment
     -- * Delete a comment
     pullRequestCommentsR,
     pullRequestCommentR,
+    createPullCommentR,
 
     -- ** Pull request reviews
     -- | See <https://developer.github.com/v3/pulls/reviews/>

src/GitHub/Data/Comments.hs

@@ -64,3 +64,22 @@ instance Binary EditComment
 
 instance ToJSON EditComment where
     toJSON (EditComment b) = object [ "body" .= b ]
+
+data NewPullComment = NewPullComment
+    { newPullCommentCommit   :: !Text
+    , newPullCommentPath     :: !Text
+    , newPullCommentPosition :: !Int
+    , newPullCommentBody     :: !Text
+    }
+  deriving (Show, Data, Typeable, Eq, Ord, Generic)
+
+instance NFData NewPullComment where rnf = genericRnf
+instance Binary NewPullComment
+
+instance ToJSON NewPullComment where
+    toJSON (NewPullComment c path pos b) =
+        object [ "body" .= b
+               , "commit_id" .= c
+               , "path" .= path
+               , "position" .= pos
+               ]

src/GitHub/Data/PullRequests.hs

@@ -32,7 +32,7 @@ data SimplePullRequest = SimplePullRequest
     , simplePullRequestUser               :: !SimpleUser
     , simplePullRequestPatchUrl           :: !URL
     , simplePullRequestState              :: !IssueState
-    , simplePullRequestNumber             :: !Int
+    , simplePullRequestNumber             :: !IssueNumber
     , simplePullRequestHtmlUrl            :: !URL
     , simplePullRequestUpdatedAt          :: !UTCTime
     , simplePullRequestBody               :: !(Maybe Text)
@@ -57,7 +57,7 @@ data PullRequest = PullRequest
     , pullRequestUser                 :: !SimpleUser
     , pullRequestPatchUrl             :: !URL
     , pullRequestState                :: !IssueState
-    , pullRequestNumber               :: !Int
+    , pullRequestNumber               :: !IssueNumber
     , pullRequestHtmlUrl              :: !URL
     , pullRequestUpdatedAt            :: !UTCTime
     , pullRequestBody                 :: !(Maybe Text)

src/GitHub/Endpoints/PullRequests.hs

@@ -12,6 +12,12 @@ module GitHub.Endpoints.PullRequests (
     pullRequest',
     pullRequest,
     pullRequestR,
+    pullRequestDiff',
+    pullRequestDiff,
+    pullRequestDiffR,
+    pullRequestPatch',
+    pullRequestPatch,
+    pullRequestPatchR,
     createPullRequest,
     createPullRequestR,
     updatePullRequest,
@@ -33,6 +39,7 @@ import GitHub.Data
 import GitHub.Internal.Prelude
 import GitHub.Request
 import Prelude ()
+import Data.ByteString.Lazy (ByteString)
 
 -- | All open pull requests for the repo, by owner and repo name.
 --
@@ -60,25 +67,60 @@ pullRequestsForR user repo opts = pagedQuery
     ["repos", toPathPart user, toPathPart repo, "pulls"]
     (prModToQueryString opts)
 
+-- | Obtain the diff of a pull request
+-- See <https://developer.github.com/v3/pulls/#get-a-single-pull-request>
+pullRequestDiff' :: Maybe Auth -> Name Owner -> Name Repo -> IssueNumber -> IO (Either Error ByteString)
+pullRequestDiff' auth user repo prid =
+    executeRequestMaybe auth $ pullRequestDiffR user repo prid
+
+-- | Obtain the diff of a pull request
+-- See <https://developer.github.com/v3/pulls/#get-a-single-pull-request>
+pullRequestDiff :: Name Owner -> Name Repo -> IssueNumber -> IO (Either Error ByteString)
+pullRequestDiff = pullRequestDiff' Nothing
+
+-- | Query a single pull request to obtain the diff
+-- See <https://developer.github.com/v3/pulls/#get-a-single-pull-request>
+pullRequestDiffR :: Name Owner -> Name Repo -> IssueNumber -> GenRequest 'MtDiff rw ByteString
+pullRequestDiffR user repo prid =
+    Query ["repos", toPathPart user, toPathPart repo, "pulls", toPathPart prid] []
+
+-- | Obtain the patch of a pull request
+--
+-- See <https://developer.github.com/v3/pulls/#get-a-single-pull-request>
+pullRequestPatch' :: Maybe Auth -> Name Owner -> Name Repo -> IssueNumber -> IO (Either Error ByteString)
+pullRequestPatch' auth user repo prid =
+    executeRequestMaybe auth $ pullRequestPatchR user repo prid
+
+-- | Obtain the patch of a pull request
+-- See <https://developer.github.com/v3/pulls/#get-a-single-pull-request>
+pullRequestPatch :: Name Owner -> Name Repo -> IssueNumber -> IO (Either Error ByteString)
+pullRequestPatch = pullRequestPatch' Nothing
+
+-- | Query a single pull request to obtain the patch
+-- See <https://developer.github.com/v3/pulls/#get-a-single-pull-request>
+pullRequestPatchR :: Name Owner -> Name Repo -> IssueNumber -> GenRequest 'MtPatch rw ByteString
+pullRequestPatchR user repo prid =
+    Query ["repos", toPathPart user, toPathPart repo, "pulls", toPathPart prid] []
+
 -- | A detailed pull request, which has much more information. This takes the
 -- repo owner and name along with the number assigned to the pull request.
 -- With authentification.
 --
 -- > pullRequest' (Just ("github-username", "github-password")) "thoughtbot" "paperclip" 562
-pullRequest' :: Maybe Auth -> Name Owner -> Name Repo -> Id PullRequest -> IO (Either Error PullRequest)
+pullRequest' :: Maybe Auth -> Name Owner -> Name Repo -> IssueNumber -> IO (Either Error PullRequest)
 pullRequest' auth user repo prid =
     executeRequestMaybe auth $ pullRequestR user repo prid
 
 -- | A detailed pull request, which has much more information. This takes the
 -- repo owner and name along with the number assigned to the pull request.
 --
 -- > pullRequest "thoughtbot" "paperclip" 562
-pullRequest :: Name Owner -> Name Repo -> Id PullRequest -> IO (Either Error PullRequest)
+pullRequest :: Name Owner -> Name Repo -> IssueNumber -> IO (Either Error PullRequest)
 pullRequest = pullRequest' Nothing
 
 -- | Query a single pull request.
 -- See <https://developer.github.com/v3/pulls/#get-a-single-pull-request>
-pullRequestR :: Name Owner -> Name Repo -> Id PullRequest -> Request k PullRequest
+pullRequestR :: Name Owner -> Name Repo -> IssueNumber -> Request k PullRequest
 pullRequestR user repo prid =
     query ["repos", toPathPart user, toPathPart repo, "pulls", toPathPart prid] []
 
@@ -100,15 +142,15 @@ createPullRequestR user repo cpr =
     command Post ["repos", toPathPart user, toPathPart repo, "pulls"] (encode cpr)
 
 -- | Update a pull request
-updatePullRequest :: Auth -> Name Owner -> Name Repo -> Id PullRequest -> EditPullRequest -> IO (Either Error PullRequest)
+updatePullRequest :: Auth -> Name Owner -> Name Repo -> IssueNumber -> EditPullRequest -> IO (Either Error PullRequest)
 updatePullRequest auth user repo prid epr =
     executeRequest auth $ updatePullRequestR user repo prid epr
 
 -- | Update a pull request.
 -- See <https://developer.github.com/v3/pulls/#update-a-pull-request>
 updatePullRequestR :: Name Owner
                    -> Name Repo
-                   -> Id PullRequest
+                   -> IssueNumber
                    -> EditPullRequest
                    -> Request 'RW PullRequest
 updatePullRequestR user repo prid epr =
@@ -119,20 +161,20 @@ updatePullRequestR user repo prid epr =
 -- With authentification.
 --
 -- > pullRequestCommits' (Just ("github-username", "github-password")) "thoughtbot" "paperclip" 688
-pullRequestCommits' :: Maybe Auth -> Name Owner -> Name Repo -> Id PullRequest -> IO (Either Error (Vector Commit))
+pullRequestCommits' :: Maybe Auth -> Name Owner -> Name Repo -> IssueNumber -> IO (Either Error (Vector Commit))
 pullRequestCommits' auth user repo prid =
     executeRequestMaybe auth $ pullRequestCommitsR user repo prid FetchAll
 
 -- | All the commits on a pull request, given the repo owner, repo name, and
 -- the number of the pull request.
 --
 -- > pullRequestCommits "thoughtbot" "paperclip" 688
-pullRequestCommitsIO :: Name Owner -> Name Repo -> Id PullRequest -> IO (Either Error (Vector Commit))
+pullRequestCommitsIO :: Name Owner -> Name Repo -> IssueNumber -> IO (Either Error (Vector Commit))
 pullRequestCommitsIO = pullRequestCommits' Nothing
 
 -- | List commits on a pull request.
 -- See <https://developer.github.com/v3/pulls/#list-commits-on-a-pull-request>
-pullRequestCommitsR :: Name Owner -> Name Repo -> Id PullRequest -> FetchCount -> Request k (Vector Commit)
+pullRequestCommitsR :: Name Owner -> Name Repo -> IssueNumber -> FetchCount -> Request k (Vector Commit)
 pullRequestCommitsR user repo prid =
     pagedQuery ["repos", toPathPart user, toPathPart repo, "pulls", toPathPart prid, "commits"] []
 
@@ -141,20 +183,20 @@ pullRequestCommitsR user repo prid =
 -- With authentification.
 --
 -- > pullRequestFiles' (Just ("github-username", "github-password")) "thoughtbot" "paperclip" 688
-pullRequestFiles' :: Maybe Auth -> Name Owner -> Name Repo -> Id PullRequest -> IO (Either Error (Vector File))
+pullRequestFiles' :: Maybe Auth -> Name Owner -> Name Repo -> IssueNumber -> IO (Either Error (Vector File))
 pullRequestFiles' auth user repo prid =
     executeRequestMaybe auth $ pullRequestFilesR user repo prid FetchAll
 
 -- | The individual files that a pull request patches. Takes the repo owner and
 -- name, plus the number assigned to the pull request.
 --
 -- > pullRequestFiles "thoughtbot" "paperclip" 688
-pullRequestFiles :: Name Owner -> Name Repo -> Id PullRequest -> IO (Either Error (Vector File))
+pullRequestFiles :: Name Owner -> Name Repo -> IssueNumber -> IO (Either Error (Vector File))
 pullRequestFiles = pullRequestFiles' Nothing
 
 -- | List pull requests files.
 -- See <https://developer.github.com/v3/pulls/#list-pull-requests-files>
-pullRequestFilesR :: Name Owner -> Name Repo -> Id PullRequest -> FetchCount -> Request k (Vector File)
+pullRequestFilesR :: Name Owner -> Name Repo -> IssueNumber -> FetchCount -> Request k (Vector File)
 pullRequestFilesR user repo prid =
     pagedQuery ["repos", toPathPart user, toPathPart repo, "pulls", toPathPart prid, "files"] []
 

src/GitHub/Endpoints/PullRequests/Comments.hs

@@ -10,6 +10,8 @@ module GitHub.Endpoints.PullRequests.Comments (
     pullRequestCommentsR,
     pullRequestComment,
     pullRequestCommentR,
+    createPullComment,
+    createPullCommentR,
     module GitHub.Data,
     ) where
 
@@ -43,3 +45,21 @@ pullRequestComment user repo cid =
 pullRequestCommentR :: Name Owner -> Name Repo -> Id Comment -> Request k Comment
 pullRequestCommentR user repo cid =
     query ["repos", toPathPart user, toPathPart repo, "pulls", "comments", toPathPart cid] []
+
+-- | Create a new comment.
+--
+-- > createPullComment (User (user, password)) user repo issue commit path position
+-- >  "some words"
+createPullComment :: Auth -> Name Owner -> Name Repo -> IssueNumber -> Text -> Text -> Int -> Text
+            -> IO (Either Error Comment)
+createPullComment auth user repo iss commit path position body =
+    executeRequest auth $ createPullCommentR user repo iss commit path position body
+
+-- | Create a comment.
+--
+-- See <https://developer.github.com/v3/pulls/comments/#create-a-comment>
+createPullCommentR :: Name Owner -> Name Repo -> IssueNumber -> Text -> Text -> Int -> Text -> Request 'RW Comment
+createPullCommentR user repo iss commit path position body =
+    command Post parts (encode $ NewPullComment commit path position body)
+  where
+    parts = ["repos", toPathPart user, toPathPart repo, "pulls", toPathPart iss, "comments"]

src/GitHub/Endpoints/Repos.hs

@@ -38,6 +38,7 @@ module GitHub.Endpoints.Repos (
     createRepoR,
     createOrganizationRepo',
     createOrganizationRepoR,
+    forkExistingRepo',
     forkExistingRepoR,
 
     -- ** Edit
@@ -167,6 +168,11 @@ createRepoR :: NewRepo -> Request 'RW Repo
 createRepoR nrepo =
     command Post ["user", "repos"] (encode nrepo)
 
+-- | Fork an existing repository.
+forkExistingRepo' :: Auth -> Name Owner -> Name Repo -> Maybe (Name Owner) -> IO (Either Error Repo)
+forkExistingRepo' auth owner repo morg =
+    executeRequest auth $ forkExistingRepoR owner repo morg
+
 -- | Fork an existing repository.
 -- See <https://developer.github.com/v3/repos/forks/#create-a-fork>
 -- TODO: The third paramater (an optional Organisation) is not used yet.