diff --git a/Github/Data.hs b/Github/Data.hs --- a/Github/Data.hs +++ b/Github/Data.hs @@ -48,7 +48,7 @@ parseJSON (Object o) = GitTree <$> o .: "type" <*> o .: "sha" - <*> o .: "url" + <*> o .:? "url" <*> o .:? "size" <*> o .: "path" <*> o .: "mode" @@ -112,12 +112,12 @@ Comment <$> o .:? "position" <*> o .:? "line" <*> o .: "body" - <*> o .: "commit_id" + <*> o .:? "commit_id" <*> o .: "updated_at" <*> o .:? "html_url" <*> o .: "url" <*> o .: "created_at" - <*> o .: "path" + <*> o .:? "path" <*> o .: "user" <*> o .: "id" parseJSON _ = fail "Could not build a Comment" @@ -207,6 +207,7 @@ parseJSON (Object o) = Issue <$> o .:? "closed_at" <*> o .: "updated_at" + <*> o .: "events_url" <*> o .: "html_url" <*> o .:? "closed_by" <*> o .: "labels" @@ -302,6 +303,16 @@ parseJSON (String "mentioned") = pure Mentioned parseJSON (String "assigned") = pure Assigned parseJSON (String "unsubscribed") = pure Unsubscribed + parseJSON (String "unassigned") = pure ActorUnassigned + parseJSON (String "labeled") = pure Labeled + parseJSON (String "unlabeled") = pure Unlabeled + parseJSON (String "milestoned") = pure Milestoned + parseJSON (String "demilestoned") = pure Demilestoned + parseJSON (String "renamed") = pure Renamed + parseJSON (String "locked") = pure Locked + parseJSON (String "unlocked") = pure Unlocked + parseJSON (String "head_ref_deleted") = pure HeadRefDeleted + parseJSON (String "head_ref_restored") = pure HeadRefRestored parseJSON _ = fail "Could not build an EventType" instance FromJSON SimpleOrganization where @@ -353,6 +364,16 @@ <*> o .: "id" parseJSON _ = fail "Could not build a PullRequest" +instance ToJSON EditPullRequestState where + toJSON (EditPullRequestStateOpen) = String "open" + toJSON (EditPullRequestStateClosed) = String "closed" + +instance ToJSON EditPullRequest where + toJSON (EditPullRequest t b s) = + object $ filter notNull [ "title" .= t, "body" .= b, "state" .= s ] + where notNull (_, Null) = False + notNull (_, _) = True + instance FromJSON DetailedPullRequest where parseJSON (Object o) = DetailedPullRequest @@ -416,7 +437,56 @@ parseJSON (String "closed") = pure PullRequestClosed parseJSON (String "synchronize") = pure PullRequestSynchronized parseJSON (String "reopened") = pure PullRequestReopened + parseJSON (String "assigned") = pure PullRequestAssigned + parseJSON (String "unassigned") = pure PullRequestUnassigned + parseJSON (String "labeled") = pure PullRequestLabeled + parseJSON (String "unlabeled") = pure PullRequestUnlabeled parseJSON _ = fail "Could not build a PullRequestEventType" + +instance FromJSON RepoWebhookEvent where + parseJSON (String "*") = pure WebhookWildcardEvent + parseJSON (String "commit_comment") = pure WebhookCommitCommentEvent + parseJSON (String "create") = pure WebhookCreateEvent + parseJSON (String "delete") = pure WebhookDeleteEvent + parseJSON (String "deployment") = pure WebhookDeploymentEvent + parseJSON (String "deployment_status") = pure WebhookDeploymentStatusEvent + parseJSON (String "fork") = pure WebhookForkEvent + parseJSON (String "gollum") = pure WebhookGollumEvent + parseJSON (String "issue_comment") = pure WebhookIssueCommentEvent + parseJSON (String "issues") = pure WebhookIssuesEvent + parseJSON (String "member") = pure WebhookMemberEvent + parseJSON (String "page_build") = pure WebhookPageBuildEvent + parseJSON (String "public") = pure WebhookPublicEvent + parseJSON (String "pull_request_review_comment") = pure WebhookPullRequestReviewCommentEvent + parseJSON (String "pull_request") = pure WebhookPullRequestEvent + parseJSON (String "push") = pure WebhookPushEvent + parseJSON (String "release") = pure WebhookReleaseEvent + parseJSON (String "status") = pure WebhookStatusEvent + parseJSON (String "team_add") = pure WebhookTeamAddEvent + parseJSON (String "watch") = pure WebhookWatchEvent + parseJSON _ = fail "Could not build a Webhook event" + +instance ToJSON RepoWebhookEvent where + toJSON (WebhookWildcardEvent) = String "*" + toJSON (WebhookCommitCommentEvent) = String "commit_comment" + toJSON (WebhookCreateEvent) = String "create" + toJSON (WebhookDeleteEvent) = String "delete" + toJSON (WebhookDeploymentEvent) = String "deployment" + toJSON (WebhookDeploymentStatusEvent) = String "deployment_status" + toJSON (WebhookForkEvent) = String "fork" + toJSON (WebhookGollumEvent) = String "gollum" + toJSON (WebhookIssueCommentEvent) = String "issue_comment" + toJSON (WebhookIssuesEvent) = String "issues" + toJSON (WebhookMemberEvent) = String "member" + toJSON (WebhookPageBuildEvent) = String "page_build" + toJSON (WebhookPublicEvent) = String "public" + toJSON (WebhookPullRequestReviewCommentEvent) = String "pull_request_review_comment" + toJSON (WebhookPullRequestEvent) = String "pull_request" + toJSON (WebhookPushEvent) = String "push" + toJSON (WebhookReleaseEvent) = String "release" + toJSON (WebhookStatusEvent) = String "status" + toJSON (WebhookTeamAddEvent) = String "team_add" + toJSON (WebhookWatchEvent) = String "watch" instance FromJSON PingEvent where parseJSON (Object o) = diff --git a/Github/Data/Definitions.hs b/Github/Data/Definitions.hs --- a/Github/Data/Definitions.hs +++ b/Github/Data/Definitions.hs @@ -40,7 +40,8 @@ data GitTree = GitTree { gitTreeType :: String ,gitTreeSha :: String - ,gitTreeUrl :: String + -- Can be empty for submodule + ,gitTreeUrl :: Maybe String ,gitTreeSize :: Maybe Int ,gitTreePath :: String ,gitTreeMode :: String @@ -98,7 +99,7 @@ commentPosition :: Maybe Int ,commentLine :: Maybe Int ,commentBody :: String - ,commentCommitId :: String + ,commentCommitId :: Maybe String ,commentUpdatedAt :: UTCTime ,commentHtmlUrl :: Maybe String ,commentUrl :: String @@ -187,6 +188,7 @@ data Issue = Issue { issueClosedAt :: Maybe GithubDate ,issueUpdatedAt :: GithubDate + ,issueEventsUrl :: String ,issueHtmlUrl :: Maybe String ,issueClosedBy :: Maybe GithubOwner ,issueLabels :: [IssueLabel] @@ -266,6 +268,16 @@ | Assigned -- ^ The issue was assigned to the actor. | Closed -- ^ The issue was closed by the actor. When the commit_id is present, it identifies the commit that closed the issue using “closes / fixes #NN” syntax. | Reopened -- ^ The issue was reopened by the actor. + | ActorUnassigned -- ^ The issue was unassigned to the actor + | Labeled -- ^ A label was added to the issue. + | Unlabeled -- ^ A label was removed from the issue. + | Milestoned -- ^ The issue was added to a milestone. + | Demilestoned -- ^ The issue was removed from a milestone. + | Renamed -- ^ The issue title was changed. + | Locked -- ^ The issue was locked by the actor. + | Unlocked -- ^ The issue was unlocked by the actor. + | HeadRefDeleted -- ^ The pull request’s branch was deleted. + | HeadRefRestored -- ^ The pull request’s branch was restored. deriving (Show, Data, Typeable, Eq, Ord) data Event = Event { @@ -355,6 +367,12 @@ ,detailedPullRequestMergeable :: Maybe Bool } deriving (Show, Data, Typeable, Eq, Ord) +data EditPullRequest = EditPullRequest { + editPullRequestTitle :: Maybe String + ,editPullRequestBody :: Maybe String + ,editPullRequestState :: Maybe EditPullRequestState +} deriving (Show) + data PullRequestLinks = PullRequestLinks { pullRequestLinksReviewComments :: String ,pullRequestLinksComments :: String @@ -505,13 +523,36 @@ ,repoWebhookId :: Integer ,repoWebhookName :: String ,repoWebhookActive :: Bool - ,repoWebhookEvents :: [String] + ,repoWebhookEvents :: [RepoWebhookEvent] ,repoWebhookConfig :: M.Map String String ,repoWebhookLastResponse :: RepoWebhookResponse ,repoWebhookUpdatedAt :: GithubDate ,repoWebhookCreatedAt :: GithubDate } deriving (Show, Data, Typeable, Eq, Ord) +data RepoWebhookEvent = + WebhookWildcardEvent + | WebhookCommitCommentEvent + | WebhookCreateEvent + | WebhookDeleteEvent + | WebhookDeploymentEvent + | WebhookDeploymentStatusEvent + | WebhookForkEvent + | WebhookGollumEvent + | WebhookIssueCommentEvent + | WebhookIssuesEvent + | WebhookMemberEvent + | WebhookPageBuildEvent + | WebhookPublicEvent + | WebhookPullRequestReviewCommentEvent + | WebhookPullRequestEvent + | WebhookPushEvent + | WebhookReleaseEvent + | WebhookStatusEvent + | WebhookTeamAddEvent + | WebhookWatchEvent + deriving (Show, Data, Typeable, Eq, Ord) + data RepoWebhookResponse = RepoWebhookResponse { repoWebhookResponseCode :: Maybe Int ,repoWebhookResponseStatus :: String @@ -531,6 +572,10 @@ | PullRequestClosed | PullRequestSynchronized | PullRequestReopened + | PullRequestAssigned + | PullRequestUnassigned + | PullRequestLabeled + | PullRequestUnlabeled deriving (Show, Data, Typeable, Eq, Ord) data PingEvent = PingEvent { @@ -538,3 +583,8 @@ ,pingEventHook :: RepoWebhook ,pingEventHookId :: Int } deriving (Show, Data, Typeable, Eq, Ord) + +data EditPullRequestState = + EditPullRequestStateOpen + | EditPullRequestStateClosed + deriving Show diff --git a/Github/GitData/Trees.hs b/Github/GitData/Trees.hs --- a/Github/GitData/Trees.hs +++ b/Github/GitData/Trees.hs @@ -11,15 +11,27 @@ -- | A tree for a SHA1. -- +-- > tree (Just ("github-username", "github-password")) "thoughtbot" "paperclip" "fe114451f7d066d367a1646ca7ac10e689b46844" +tree' :: Maybe GithubAuth -> String -> String -> String -> IO (Either Error Tree) +tree' auth user reqRepoName sha = + githubGet' auth ["repos", user, reqRepoName, "git", "trees", sha] + +-- | A tree for a SHA1. +-- -- > tree "thoughtbot" "paperclip" "fe114451f7d066d367a1646ca7ac10e689b46844" tree :: String -> String -> String -> IO (Either Error Tree) -tree user reqRepoName sha = - githubGet ["repos", user, reqRepoName, "git", "trees", sha] +tree = tree' Nothing -- | A recursively-nested tree for a SHA1. -- +-- > nestedTree' (Just ("github-username", "github-password")) "thoughtbot" "paperclip" "fe114451f7d066d367a1646ca7ac10e689b46844" +nestedTree' :: Maybe GithubAuth -> String -> String -> String -> IO (Either Error Tree) +nestedTree' auth user reqRepoName sha = + githubGetWithQueryString' auth ["repos", user, reqRepoName, "git", "trees", sha] + "recursive=1" + +-- | A recursively-nested tree for a SHA1. +-- -- > nestedTree "thoughtbot" "paperclip" "fe114451f7d066d367a1646ca7ac10e689b46844" nestedTree :: String -> String -> String -> IO (Either Error Tree) -nestedTree user reqRepoName sha = - githubGetWithQueryString ["repos", user, reqRepoName, "git", "trees", sha] - "recursive=1" +nestedTree = nestedTree' Nothing diff --git a/Github/Private.hs b/Github/Private.hs --- a/Github/Private.hs +++ b/Github/Private.hs @@ -104,9 +104,11 @@ in Just (Data.List.takeWhile (/= '>') s') else Nothing --- doHttps :: Method -> String -> Maybe GithubAuth --- -> Maybe (RequestBody (ResourceT IO)) --- -> IO (Either E.SomeException (Response LBS.ByteString)) +doHttps :: BS.ByteString + -> [Char] + -> Maybe GithubAuth + -> Maybe RequestBody + -> IO (Either E.SomeException (Response LBS.ByteString)) doHttps reqMethod url auth body = do let reqBody = fromMaybe (RequestBodyBS $ BS.pack "") body reqHeaders = maybe [] getOAuth auth diff --git a/Github/PullRequests.hs b/Github/PullRequests.hs --- a/Github/PullRequests.hs +++ b/Github/PullRequests.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE OverloadedStrings #-} -- | The pull requests API as documented at -- . module Github.PullRequests ( @@ -9,11 +10,18 @@ ,pullRequest ,pullRequestCommits ,pullRequestFiles +,isPullRequestMerged +,mergePullRequest +,updatePullRequest ,module Github.Data ) where import Github.Data import Github.Private +import Network.HTTP.Types +import qualified Data.Map as M +import Network.HTTP.Conduit (RequestBody(RequestBodyLBS)) +import Data.Aeson -- | All pull requests for the repo, by owner and repo name. -- | With authentification @@ -75,3 +83,23 @@ -- > pullRequestFiles "thoughtbot" "paperclip" 688 pullRequestFiles :: String -> String -> Int -> IO (Either Error [File]) pullRequestFiles = pullRequestFiles' Nothing + +-- | Check if pull request has been merged +isPullRequestMerged :: GithubAuth -> String -> String -> Int -> IO(Either Error Status) +isPullRequestMerged auth reqRepoOwner reqRepoName reqPullRequestNumber = + doHttpsStatus "GET" (buildUrl ["repos", reqRepoOwner, reqRepoName, "pulls", (show reqPullRequestNumber), "merge"]) auth Nothing + +-- | Merge a pull request +mergePullRequest :: GithubAuth -> String -> String -> Int -> Maybe String -> IO(Either Error Status) +mergePullRequest auth reqRepoOwner reqRepoName reqPullRequestNumber commitMessage = + doHttpsStatus "PUT" (buildUrl ["repos", reqRepoOwner, reqRepoName, "pulls", (show reqPullRequestNumber), "merge"]) auth (Just . RequestBodyLBS . encode . toJSON $ (buildCommitMessageMap commitMessage)) + +-- | Update a pull request +updatePullRequest :: GithubAuth -> String -> String -> Int -> EditPullRequest -> IO (Either Error DetailedPullRequest) +updatePullRequest auth reqRepoOwner reqRepoName reqPullRequestNumber editPullRequest = + githubPatch auth ["repos", reqRepoOwner, reqRepoName, "pulls", show reqPullRequestNumber] editPullRequest + + +buildCommitMessageMap :: Maybe String -> M.Map String String +buildCommitMessageMap (Just commitMessage) = M.singleton "commit_message" commitMessage +buildCommitMessageMap _ = M.empty diff --git a/Github/Repos.hs b/Github/Repos.hs --- a/Github/Repos.hs +++ b/Github/Repos.hs @@ -215,9 +215,9 @@ -- -- > contentsFor' (Just (GithubBasicAuth (user, password))) "thoughtbot" "paperclip" "README.md" contentsFor' :: Maybe GithubAuth -> String -> String -> String -> Maybe String -> IO (Either Error Content) -contentsFor' auth userName repoName path ref = +contentsFor' auth userName reqRepoName reqContentPath ref = githubGetWithQueryString' auth - ["repos", userName, repoName, "contents", path] $ + ["repos", userName, reqRepoName, "contents", reqContentPath] $ maybe "" ("ref="++) ref diff --git a/Github/Repos/Webhooks.hs b/Github/Repos/Webhooks.hs --- a/Github/Repos/Webhooks.hs +++ b/Github/Repos/Webhooks.hs @@ -39,19 +39,19 @@ type RepoOwner = String type RepoName = String type RepoWebhookId = Int - + data NewRepoWebhook = NewRepoWebhook { newRepoWebhookName :: String ,newRepoWebhookConfig :: M.Map String String - ,newRepoWebhookEvents :: Maybe [String] + ,newRepoWebhookEvents :: Maybe [RepoWebhookEvent] ,newRepoWebhookActive :: Maybe Bool } deriving Show data EditRepoWebhook = EditRepoWebhook { editRepoWebhookConfig :: Maybe (M.Map String String) - ,editRepoWebhookEvents :: Maybe [String] - ,editRepoWebhookAddEvents :: Maybe [String] - ,editRepoWebhookRemoveEvents :: Maybe [String] + ,editRepoWebhookEvents :: Maybe [RepoWebhookEvent] + ,editRepoWebhookAddEvents :: Maybe [RepoWebhookEvent] + ,editRepoWebhookRemoveEvents :: Maybe [RepoWebhookEvent] ,editRepoWebhookActive :: Maybe Bool } deriving Show diff --git a/github.cabal b/github.cabal --- a/github.cabal +++ b/github.cabal @@ -7,7 +7,7 @@ -- The package version. See the Haskell package versioning policy -- (http://www.haskell.org/haskellwiki/Package_versioning_policy) for -- standards guiding when and how versions should be incremented. -Version: 0.9 +Version: 0.10.0 -- A short (one-line) description of the package. Synopsis: Access to the Github API, v3. diff --git a/samples/Repos/Webhooks/CreateWebhook.hs b/samples/Repos/Webhooks/CreateWebhook.hs --- a/samples/Repos/Webhooks/CreateWebhook.hs +++ b/samples/Repos/Webhooks/CreateWebhook.hs @@ -12,7 +12,7 @@ let webhookDef = NewRepoWebhook { newRepoWebhookName = "web", newRepoWebhookConfig = config, - newRepoWebhookEvents = Just ["*"], + newRepoWebhookEvents = Just [WebhookWildcardEvent], newRepoWebhookActive = Just True } newWebhook <- createRepoWebhook' auth "repoOwner" "repoName" webhookDef diff --git a/samples/Repos/Webhooks/EditWebhook.hs b/samples/Repos/Webhooks/EditWebhook.hs --- a/samples/Repos/Webhooks/EditWebhook.hs +++ b/samples/Repos/Webhooks/EditWebhook.hs @@ -8,8 +8,8 @@ main = do let auth = Auth.GithubOAuth "oauthtoken" let editWebhookDef = EditRepoWebhook { - editRepoWebhookRemoveEvents = Just ["*"], - editRepoWebhookAddEvents = Just ["commit_comment"], + editRepoWebhookRemoveEvents = Just [WebhookWildcardEvent], + editRepoWebhookAddEvents = Just [WebhookCommitCommentEvent, WebhookGollumEvent], editRepoWebhookConfig = Nothing, editRepoWebhookEvents = Nothing, editRepoWebhookActive = Just True