github-0.23/0000755000000000000000000000000007346545000011111 5ustar0000000000000000github-0.23/CHANGELOG.md0000755000000000000000000001762407346545000012737 0ustar0000000000000000## Changes for 0.23 - Escape URI paths [#404](https://github.com/phadej/github/pull/404) - Add OwnerBot to OwnerType [#399](https://github.com/phadej/github/pull/399) - Make File.fileSha optional [#392](https://github.com/phadej/github/pull/392) - Update User-Agent to contain up to date version [#403](https://github.com/phadej/github/pull/403) [#394](https://github.com/phadej/github/pull/394) ## Changes for 0.22 - Type-class for various auth methods [#365](https://github.com/phadej/github/pull/365) - Throw on non-200 responses [#350](https://github.com/phadej/github/pull/350) - Add extension point for (preview) media types [#370](https://github.com/phadej/github/pull/370) - Add missing webhook event types [#359](https://github.com/phadej/github/pull/359) - Add invitation endpoint [#360](https://github.com/phadej/github/pull/360) - Add notifications endpoints [#324](https://github.com/phadej/github/pull/324) - Add ssh keys endpoints [#363](https://github.com/phadej/github/pull/365) - Case insensitive enum parsing [#373](https://github.com/phadej/github/pull/373) - Don't try parse unitary responses [#377](https://github.com/phadej/github/issues/377) - Update dependencies [#364](https://github.com/phadej/github/pull/364) [#368](https://github.com/phadej/github/pull/368) [#369](https://github.com/phadej/github/pull/369) - Documentation improvements [#357](https://github.com/phadej/github/pull/357) ## 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 - Add ratelimit endpoint [#315](https://github.com/phadej/github/pull/315) - Add some deployment endoints [#330](https://github.com/phadej/github/pull/330) - Add webhook installation events [#329](https://github.com/phadej/github/pull/330) - Tigthen lower bounds (also remove aeson-compat dep) [#332](https://github.com/phadej/github/pull/332) ## Changes for 0.19 - Fix issue event type enumeration [#301](https://github.com/phadej/github/issues/301) - Include label info in `IssseEvent` [#302](https://github.com/phadej/github/issues/302) - Fix `ShowRepo` example [#306](https://github.com/phadej/github/pull/306) - Add "Get archive link" API [#307](https://github.com/phadej/github/pull/307) - Make "repo" in PullRequestCommit nullable (repository can be gone) [#311](https://github.com/phadej/github/pull/311) - Add read-only emails endpoint [#313](https://github.com/phadej/github/pull/313) - Organisation membership API [#312](https://github.com/phadej/github/pull/312) - Fix isPullRequestMerged and other boolean responses [#312](https://github.com/phadej/github/pull/312) - Add `behind` pull request mergeable state [#308](https://github.com/phadej/github/pull/308) - Add list organisation invitations endpoint ## Changes for 0.18 - Endpoints for deleting issue comments. [#294](https://github.com/phadej/github/pull/294) - Endpoints for (un)starring gists. [#296](https://github.com/phadej/github/pull/296) - Add `archived` field to `Repo`. [#298](https://github.com/phadej/github/pull/298) - Update dependencies. [#295](https://github.com/phadej/github/pull/295) - Add Statuses endpoints. [#268](https://github.com/phadej/github/pull/268) - Add requested reviewers field to pull request records. [#292](https://github.com/phadej/github/pull/292) ## Changes for 0.17.0 - Add `Ord Request` instance - Repository contents - Repository starring endpoints - Pull Request review endpoints ## Changes for 0.16.0 - Add support for `mergeable_state = "blocked".` - Fix HTTP status code of merge PR - Supports newest versions of dependencies - user events - release endpoints - forkExistingRepo ## Changes for 0.15.0 - Reworked `PullRequest` (notably `pullRequestsFor`) - Reworked PR and Issue filtering - GHC-8.0.1 support - Change `repoMasterBranch` to `repoDefaultBranch` in `Repo` - Add `listTeamReposR` - Add `myStarredAcceptStarR` - Add `HeaderQuery` to `Request` - Add `Hashable Auth` instance - Add `mkUserId`, `mkUserName`, `fromUserId`, `fromOrganizationId` - Add 'userIssuesR' - Add 'organizationIssuesR' - Make `teamName :: Text` amnd `teamSlug :: Name Team` in both: `Team` and `SimpleTeam` - Refactor 'Request' structure - Added multiple issue assignees - Preliminary support for repository events: `repositoryEventsR` - Support for adding repository permissions to the team - Remove 'simpleUserType', it was always the same. See [git commit summary](https://github.com/phadej/github/compare/v0.14.1...v0.15.0) ## Changes for 0.14.1 - Add `membersOfWithR`, `listTeamMembersR` - Add related enums: `OrgMemberFilter`, `OrgMemberRole`, `TeamMemberRole` - Add `Enum` and `Bounded` instances to `Privacy`, `Permission`, `RepoPublicity` - Don't require network access for search tests ## Changes for 0.14.0 Large API changes: - Use `Text` and `Vector` in place of `String` and `[]`. - Use `Name` and `Id` tagged types for names and identifiers. - Make detailed structures un-prefixed, simple ones prefixed with `Simple`. Example: `Team` and `SimpleTeam`. - Decouple request creation from execution (`*R` and `executeRequest*` functions). - Add `Binary` instances for all data - `GithubOwner` is a `newtype` of `Either User Organization`. There's still `SimpleOwner`. ## Changes for 0.5.0: * OAuth. * New function: `Github.Repos.organizationRepo`, to get the repo for a specific organization. * Introduce a new `newRepoAutoInit` flag to `NewRepo`, for whether to initialize a repo while creating it. * Relax the attoparsec version requirements. * The above by [John Wiegley](https://github.com/jwiegley). ## Changes for 0.4.1: * Stop using the uri package. * Use aeson version 0.6.1.0. * Use attoparsec version 0.10.3.0. * Use http-conduit over 1.8. * Use unordered-containers between 0.2 and 0.3. ## Changes for 0.4.0: * Use http-conduit version 1.4.1.10. ## Changes for 0.3.0: * Re-instantiate the Blobs API. * `repoDescription1` and `repoPushedAt` are a `Maybe GithubDate`. * Add `deleteRepo`, `editRepo`, and `createRepo`. * Private gists, issues, organizations, pull requests, and users. * Lock down `tls` and `tls-extra` instead of keeping up with the ever-changing `http-conduit` package. * Features by [Pavel Ryzhov](https://github.com/paulrzcz) and [Simon Hengel](https://github.com/sol). ## Changes for 0.2.1: * Expand the unordered-containers dependency to anything in 0.1.x . ## Changes for 0.2.0: * `milestoneDueOn` and `repoLanguage` are now `Maybe` types. * Introduce `GithubOwner` as the sum type for a `GithubUser` or `GithubOrganization`. Everything that once produced a `GithubUser` now produces a `GithubOwner`. All record accessors have changed their names * Similar to `GithubOwner`, introduce `DetailedOwner`, which can be a `DetailedUser` or a `DetailedOrganization`. All record accessors have changed their names * An `HTTPConnectionError` now composes `SomeException` instead of `IOException`. All exceptions raised by the underlying http-conduit library are encapulated there. * The `githubIssueClosedBy` function now produces a `Maybe GithubOwner`. * Remove the Blobs API, as it is broken upstream. * Bugs found and squashed thanks to [Joey Hess](https://github.com/joeyh) and [Simon Hengel](https://github.com/sol). github-0.23/LICENSE0000644000000000000000000000275507346545000012127 0ustar0000000000000000Copyright (c)2011, Mike Burns All rights reserved. Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: * Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. * Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution. * Neither the name of Mike Burns nor the names of other contributors may be used to endorse or promote products derived from this software without specific prior written permission. THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. github-0.23/README.md0000755000000000000000000000575207346545000012404 0ustar0000000000000000Github ------ [![Build Status](https://travis-ci.org/phadej/github.svg?branch=master)](https://travis-ci.org/phadej/github) [![Hackage](https://img.shields.io/hackage/v/github.svg)][hackage] [![Stackage LTS 5](http://stackage.org/package/github/badge/lts-5)](http://stackage.org/lts-5/package/github) [![Stackage Nightly](http://stackage.org/package/github/badge/nightly)](http://stackage.org/nightly/package/github) The Github API v3 for Haskell. Some functions are missing; these are functions where the Github API did not work as expected. The full Github API is in beta and constantly improving. Installation ============ In your project's cabal file: ```cabal -- Packages needed in order to build this package. Build-depends: github ``` Or from the command line: ```sh cabal install github ``` Example Usage ============= See the samples in the [samples/](https://github.com/fpco/github/tree/master/samples) directory. Documentation ============= For details see the reference [documentation on Hackage][hackage]. Each module lines up with the hierarchy of [documentation from the Github API](http://developer.github.com/v3/). Request functions (ending with `R`) construct a data type with can be executed in `IO` by `executeRequest` functions. They are all listed in the root `GitHub` module. IO functions produce an `IO (Either Error a)`, where `a` is the actual thing you want. You must call the function using IO goodness, then dispatch on the possible error message. Here's an example from the samples: Many function have samples under [`samples/`](https://github.com/phadej/github/tree/master/samples) directory. ```hs {-# LANGUAGE NoImplicitPrelude #-} {-# LANGUAGE OverloadedStrings #-} import Prelude.Compat import Data.Text (Text, pack) import Data.Text.IO as T (putStrLn) import Data.Monoid ((<>)) import qualified GitHub.Endpoints.Users.Followers as GitHub main :: IO () main = do possibleUsers <- GitHub.usersFollowing "mike-burns" T.putStrLn $ either (("Error: " <>) . pack . show) (foldMap ((<> "\n") . formatUser)) possibleUsers formatUser :: GitHub.SimpleUser -> Text formatUser = GitHub.untagName . GitHub.simpleUserLogin ``` Test setup ========== To run integration part of tests, you'll need [github access token](https://github.com/settings/tokens/new) Token is needed, because unauthorised access is highly limited. It's enough to add only basic read access for public information. With `travis encrypt --org --repo yournick/github "GITHUB_TOKEN=yourtoken"` command you get a secret, you can use in your travis setup to run the test-suite there. Contributions ============= Please see [CONTRIBUTING.md](https://github.com/fpco/github/blob/master/CONTRIBUTING.md) for details on how you can help. Copyright ========= Copyright 2011-2012 Mike Burns. Copyright 2013-2015 John Wiegley. Copyright 2016 Oleg Grenrus. Available under the BSD 3-clause license. [hackage]: http://hackage.haskell.org/package/github "Hackage" github-0.23/Setup.hs0000644000000000000000000000005607346545000012546 0ustar0000000000000000import Distribution.Simple main = defaultMain github-0.23/fixtures/0000755000000000000000000000000007346545000012762 5ustar0000000000000000github-0.23/fixtures/issue-search.json0000755000000000000000000001314007346545000016252 0ustar0000000000000000{ "total_count": 2, "incomplete_results": false, "items": [ { "url": "https://api.github.com/repos/phadej/github/issues/130", "labels_url": "https://api.github.com/repos/phadej/github/issues/130/labels{/name}", "comments_url": "https://api.github.com/repos/phadej/github/issues/130/comments", "events_url": "https://api.github.com/repos/phadej/github/issues/130/events", "html_url": "https://github.com/phadej/github/pull/130", "id": 123898390, "number": 130, "title": "Make test runner more robust", "user": { "login": "phadej", "id": 51087, "avatar_url": "https://avatars.githubusercontent.com/u/51087?v=3", "gravatar_id": "", "url": "https://api.github.com/users/phadej", "html_url": "https://github.com/phadej", "followers_url": "https://api.github.com/users/phadej/followers", "following_url": "https://api.github.com/users/phadej/following{/other_user}", "gists_url": "https://api.github.com/users/phadej/gists{/gist_id}", "starred_url": "https://api.github.com/users/phadej/starred{/owner}{/repo}", "subscriptions_url": "https://api.github.com/users/phadej/subscriptions", "organizations_url": "https://api.github.com/users/phadej/orgs", "repos_url": "https://api.github.com/users/phadej/repos", "events_url": "https://api.github.com/users/phadej/events{/privacy}", "received_events_url": "https://api.github.com/users/phadej/received_events", "type": "User", "site_admin": false }, "labels": [ ], "state": "closed", "locked": false, "assignee": null, "assignees": [], "milestone": null, "comments": 0, "created_at": "2015-12-25T21:37:39Z", "updated_at": "2015-12-26T08:57:52Z", "closed_at": "2015-12-25T23:32:12Z", "pull_request": { "url": "https://api.github.com/repos/phadej/github/pulls/130", "html_url": "https://github.com/phadej/github/pull/130", "diff_url": "https://github.com/phadej/github/pull/130.diff", "patch_url": "https://github.com/phadej/github/pull/130.patch" }, "body": "As they use access token, it's highly unlikely it will be rate limited. ATM there's only one request per test job. i.e. travis could be re-enabled.\r\n\r\nExample run https://travis-ci.org/phadej/github/builds/98815089\r\nSome tests are pending as secret is made for this `jwiegley/github` repository.", "score": 0.75566536 }, { "url": "https://api.github.com/repos/phadej/github/issues/127", "labels_url": "https://api.github.com/repos/phadej/github/issues/127/labels{/name}", "comments_url": "https://api.github.com/repos/phadej/github/issues/127/comments", "events_url": "https://api.github.com/repos/phadej/github/issues/127/events", "html_url": "https://github.com/phadej/github/issues/127", "id": 119694665, "number": 127, "title": "Decouple request creation from execution", "user": { "login": "phadej", "id": 51087, "avatar_url": "https://avatars.githubusercontent.com/u/51087?v=3", "gravatar_id": "", "url": "https://api.github.com/users/phadej", "html_url": "https://github.com/phadej", "followers_url": "https://api.github.com/users/phadej/followers", "following_url": "https://api.github.com/users/phadej/following{/other_user}", "gists_url": "https://api.github.com/users/phadej/gists{/gist_id}", "starred_url": "https://api.github.com/users/phadej/starred{/owner}{/repo}", "subscriptions_url": "https://api.github.com/users/phadej/subscriptions", "organizations_url": "https://api.github.com/users/phadej/orgs", "repos_url": "https://api.github.com/users/phadej/repos", "events_url": "https://api.github.com/users/phadej/events{/privacy}", "received_events_url": "https://api.github.com/users/phadej/received_events", "type": "User", "site_admin": false }, "labels": [ ], "state": "open", "locked": false, "assignee": null, "assignees": [], "milestone": null, "comments": 2, "created_at": "2015-12-01T11:09:03Z", "updated_at": "2015-12-25T19:15:33Z", "closed_at": null, "body": "After working with this API, and making few others, I found that separating request creation and execution is better (i.e. more flexible) design.\r\n\r\nNow one cannot use different network client or add new endpoints.\r\n\r\nShorly\r\n\r\n```hs\r\n-- New stuff:\r\ndata GithubRequest a = GithubRequestGet Url\r\n | ...\r\n\r\n-- or alternatively\r\ndata GithubRequest a where\r\n GithubRequestGet :: Url -> GithubRequest a\r\n GithubRequestMultiGet :: Url -> GithubRequest [a]\r\n\r\nexecGithubRequest :: FromJSON a => GithubRequest a -> IO (Either Error a)\r\nexecGithubRequest' :: FromJSON a => Maybe GithubAuth -> GithubRequest a -> IO (Either Error a)\r\n\r\npublicOrganizationForRequest :: String -> GithubRequest [SimpleOrganisation]\r\npublicOrganizationForRequest org = GithubRequestGet ...\r\n\r\n-- Old IO methods become:\r\npublicOrganizationsFor :: String -> IO (Either Error [SimpleOrganization])\r\npublicOrganizationsFor = execGithubRequest . publicOrganizationForRequest\r\n\r\npublicOrganizationsFor' :: Maybe GithubAuth -> String -> IO (Either Error [SimpleOrganization])\r\npublicOrganizationsFor' auth = execGithubRequest' auth . publicOrganizationForRequest\r\n```\r\n\r\nHow does this sound? I can make a refactoring, it's quite straight-forward.", "score": 0.7265285 } ] } github-0.23/fixtures/list-teams.json0000755000000000000000000000053707346545000015747 0ustar0000000000000000[ { "id": 1, "url": "https://api.github.com/teams/1", "name": "Justice League", "slug": "justice-league", "description": "A great team.", "privacy": "closed", "permission": "admin", "members_url": "https://api.github.com/teams/1/members{/member}", "repositories_url": "https://api.github.com/teams/1/repos" } ] github-0.23/fixtures/members-list.json0000755000000000000000000000170407346545000016265 0ustar0000000000000000[ { "login": "octocat", "id": 1, "avatar_url": "https://github.com/images/error/octocat_happy.gif", "gravatar_id": "", "url": "https://api.github.com/users/octocat", "html_url": "https://github.com/octocat", "followers_url": "https://api.github.com/users/octocat/followers", "following_url": "https://api.github.com/users/octocat/following{/other_user}", "gists_url": "https://api.github.com/users/octocat/gists{/gist_id}", "starred_url": "https://api.github.com/users/octocat/starred{/owner}{/repo}", "subscriptions_url": "https://api.github.com/users/octocat/subscriptions", "organizations_url": "https://api.github.com/users/octocat/orgs", "repos_url": "https://api.github.com/users/octocat/repos", "events_url": "https://api.github.com/users/octocat/events{/privacy}", "received_events_url": "https://api.github.com/users/octocat/received_events", "type": "User", "site_admin": false } ] github-0.23/fixtures/pull-request-opened.json0000755000000000000000000003662707346545000017610 0ustar0000000000000000{ "url": "https://api.github.com/repos/phadej/github/pulls/9", "id": 144079630, "html_url": "https://github.com/phadej/github/pull/9", "diff_url": "https://github.com/phadej/github/pull/9.diff", "patch_url": "https://github.com/phadej/github/pull/9.patch", "issue_url": "https://api.github.com/repos/phadej/github/issues/9", "number": 9, "state": "open", "locked": false, "title": "Fetch my pull requests", "user": { "login": "phadej", "id": 123898390, "avatar_url": "https://avatars3.githubusercontent.com/u/123898390?v=4", "gravatar_id": "", "url": "https://api.github.com/users/phadej", "html_url": "https://github.com/phadej", "followers_url": "https://api.github.com/users/phadej/followers", "following_url": "https://api.github.com/users/phadej/following{/other_user}", "gists_url": "https://api.github.com/users/phadej/gists{/gist_id}", "starred_url": "https://api.github.com/users/phadej/starred{/owner}{/repo}", "subscriptions_url": "https://api.github.com/users/phadej/subscriptions", "organizations_url": "https://api.github.com/users/phadej/orgs", "repos_url": "https://api.github.com/users/phadej/repos", "events_url": "https://api.github.com/users/phadej/events{/privacy}", "received_events_url": "https://api.github.com/users/phadej/received_events", "type": "User", "site_admin": false }, "body": "", "created_at": "2017-10-01T17:22:12Z", "updated_at": "2017-10-01T17:22:12Z", "closed_at": null, "merged_at": null, "merge_commit_sha": null, "assignee": null, "assignees": [ ], "milestone": null, "commits_url": "https://api.github.com/repos/phadej/github/pulls/9/commits", "review_comments_url": "https://api.github.com/repos/phadej/github/pulls/9/comments", "review_comment_url": "https://api.github.com/repos/phadej/github/pulls/comments{/number}", "comments_url": "https://api.github.com/repos/phadej/github/issues/9/comments", "statuses_url": "https://api.github.com/repos/phadej/github/statuses/20218048bb9529de09f1fdaa9126f60ffeb07ce5", "head": { "label": "phadej:fetch-my-pull-requests", "ref": "fetch-my-pull-requests", "sha": "20218048bb9529de09f1fdaa9126f60ffeb07ce5", "user": { "login": "phadej", "id": 123898390, "avatar_url": "https://avatars3.githubusercontent.com/u/123898390?v=4", "gravatar_id": "", "url": "https://api.github.com/users/phadej", "html_url": "https://github.com/phadej", "followers_url": "https://api.github.com/users/phadej/followers", "following_url": "https://api.github.com/users/phadej/following{/other_user}", "gists_url": "https://api.github.com/users/phadej/gists{/gist_id}", "starred_url": "https://api.github.com/users/phadej/starred{/owner}{/repo}", "subscriptions_url": "https://api.github.com/users/phadej/subscriptions", "organizations_url": "https://api.github.com/users/phadej/orgs", "repos_url": "https://api.github.com/users/phadej/repos", "events_url": "https://api.github.com/users/phadej/events{/privacy}", "received_events_url": "https://api.github.com/users/phadej/received_events", "type": "User", "site_admin": false }, "repo": { "id": 102602684, "name": "github", "full_name": "phadej/github", "owner": { "login": "phadej", "id": 123898390, "avatar_url": "https://avatars3.githubusercontent.com/u/123898390?v=4", "gravatar_id": "", "url": "https://api.github.com/users/phadej", "html_url": "https://github.com/phadej", "followers_url": "https://api.github.com/users/phadej/followers", "following_url": "https://api.github.com/users/phadej/following{/other_user}", "gists_url": "https://api.github.com/users/phadej/gists{/gist_id}", "starred_url": "https://api.github.com/users/phadej/starred{/owner}{/repo}", "subscriptions_url": "https://api.github.com/users/phadej/subscriptions", "organizations_url": "https://api.github.com/users/phadej/orgs", "repos_url": "https://api.github.com/users/phadej/repos", "events_url": "https://api.github.com/users/phadej/events{/privacy}", "received_events_url": "https://api.github.com/users/phadej/received_events", "type": "User", "site_admin": false }, "private": true, "html_url": "https://github.com/phadej/github", "description": null, "fork": false, "url": "https://api.github.com/repos/phadej/github", "forks_url": "https://api.github.com/repos/phadej/github/forks", "keys_url": "https://api.github.com/repos/phadej/github/keys{/key_id}", "collaborators_url": "https://api.github.com/repos/phadej/github/collaborators{/collaborator}", "teams_url": "https://api.github.com/repos/phadej/github/teams", "hooks_url": "https://api.github.com/repos/phadej/github/hooks", "issue_events_url": "https://api.github.com/repos/phadej/github/issues/events{/number}", "events_url": "https://api.github.com/repos/phadej/github/events", "assignees_url": "https://api.github.com/repos/phadej/github/assignees{/user}", "branches_url": "https://api.github.com/repos/phadej/github/branches{/branch}", "tags_url": "https://api.github.com/repos/phadej/github/tags", "blobs_url": "https://api.github.com/repos/phadej/github/git/blobs{/sha}", "git_tags_url": "https://api.github.com/repos/phadej/github/git/tags{/sha}", "git_refs_url": "https://api.github.com/repos/phadej/github/git/refs{/sha}", "trees_url": "https://api.github.com/repos/phadej/github/git/trees{/sha}", "statuses_url": "https://api.github.com/repos/phadej/github/statuses/{sha}", "languages_url": "https://api.github.com/repos/phadej/github/languages", "stargazers_url": "https://api.github.com/repos/phadej/github/stargazers", "contributors_url": "https://api.github.com/repos/phadej/github/contributors", "subscribers_url": "https://api.github.com/repos/phadej/github/subscribers", "subscription_url": "https://api.github.com/repos/phadej/github/subscription", "commits_url": "https://api.github.com/repos/phadej/github/commits{/sha}", "git_commits_url": "https://api.github.com/repos/phadej/github/git/commits{/sha}", "comments_url": "https://api.github.com/repos/phadej/github/comments{/number}", "issue_comment_url": "https://api.github.com/repos/phadej/github/issues/comments{/number}", "contents_url": "https://api.github.com/repos/phadej/github/contents/{+path}", "compare_url": "https://api.github.com/repos/phadej/github/compare/{base}...{head}", "merges_url": "https://api.github.com/repos/phadej/github/merges", "archive_url": "https://api.github.com/repos/phadej/github/{archive_format}{/ref}", "downloads_url": "https://api.github.com/repos/phadej/github/downloads", "issues_url": "https://api.github.com/repos/phadej/github/issues{/number}", "pulls_url": "https://api.github.com/repos/phadej/github/pulls{/number}", "milestones_url": "https://api.github.com/repos/phadej/github/milestones{/number}", "notifications_url": "https://api.github.com/repos/phadej/github/notifications{?since,all,participating}", "labels_url": "https://api.github.com/repos/phadej/github/labels{/name}", "releases_url": "https://api.github.com/repos/phadej/github/releases{/id}", "deployments_url": "https://api.github.com/repos/phadej/github/deployments", "created_at": "2017-09-06T11:54:37Z", "updated_at": "2017-09-06T11:55:42Z", "pushed_at": "2017-10-01T16:58:54Z", "git_url": "git://github.com/phadej/github.git", "ssh_url": "git@github.com:phadej/github.git", "clone_url": "https://github.com/phadej/github.git", "svn_url": "https://github.com/phadej/github", "homepage": null, "size": 335, "stargazers_count": 0, "watchers_count": 0, "language": "Haskell", "has_issues": true, "has_projects": true, "has_downloads": true, "has_wiki": true, "has_pages": false, "forks_count": 0, "mirror_url": null, "open_issues_count": 1, "forks": 0, "open_issues": 1, "watchers": 0, "default_branch": "master" } }, "base": { "label": "phadej:master", "ref": "master", "sha": "cb686149c0d88af16de61488a1ba70a6c71a2b65", "user": { "login": "phadej", "id": 123898390, "avatar_url": "https://avatars3.githubusercontent.com/u/123898390?v=4", "gravatar_id": "", "url": "https://api.github.com/users/phadej", "html_url": "https://github.com/phadej", "followers_url": "https://api.github.com/users/phadej/followers", "following_url": "https://api.github.com/users/phadej/following{/other_user}", "gists_url": "https://api.github.com/users/phadej/gists{/gist_id}", "starred_url": "https://api.github.com/users/phadej/starred{/owner}{/repo}", "subscriptions_url": "https://api.github.com/users/phadej/subscriptions", "organizations_url": "https://api.github.com/users/phadej/orgs", "repos_url": "https://api.github.com/users/phadej/repos", "events_url": "https://api.github.com/users/phadej/events{/privacy}", "received_events_url": "https://api.github.com/users/phadej/received_events", "type": "User", "site_admin": false }, "repo": { "id": 102602684, "name": "github", "full_name": "phadej/github", "owner": { "login": "phadej", "id": 123898390, "avatar_url": "https://avatars3.githubusercontent.com/u/123898390?v=4", "gravatar_id": "", "url": "https://api.github.com/users/phadej", "html_url": "https://github.com/phadej", "followers_url": "https://api.github.com/users/phadej/followers", "following_url": "https://api.github.com/users/phadej/following{/other_user}", "gists_url": "https://api.github.com/users/phadej/gists{/gist_id}", "starred_url": "https://api.github.com/users/phadej/starred{/owner}{/repo}", "subscriptions_url": "https://api.github.com/users/phadej/subscriptions", "organizations_url": "https://api.github.com/users/phadej/orgs", "repos_url": "https://api.github.com/users/phadej/repos", "events_url": "https://api.github.com/users/phadej/events{/privacy}", "received_events_url": "https://api.github.com/users/phadej/received_events", "type": "User", "site_admin": false }, "private": true, "html_url": "https://github.com/phadej/github", "description": null, "fork": false, "url": "https://api.github.com/repos/phadej/github", "forks_url": "https://api.github.com/repos/phadej/github/forks", "keys_url": "https://api.github.com/repos/phadej/github/keys{/key_id}", "collaborators_url": "https://api.github.com/repos/phadej/github/collaborators{/collaborator}", "teams_url": "https://api.github.com/repos/phadej/github/teams", "hooks_url": "https://api.github.com/repos/phadej/github/hooks", "issue_events_url": "https://api.github.com/repos/phadej/github/issues/events{/number}", "events_url": "https://api.github.com/repos/phadej/github/events", "assignees_url": "https://api.github.com/repos/phadej/github/assignees{/user}", "branches_url": "https://api.github.com/repos/phadej/github/branches{/branch}", "tags_url": "https://api.github.com/repos/phadej/github/tags", "blobs_url": "https://api.github.com/repos/phadej/github/git/blobs{/sha}", "git_tags_url": "https://api.github.com/repos/phadej/github/git/tags{/sha}", "git_refs_url": "https://api.github.com/repos/phadej/github/git/refs{/sha}", "trees_url": "https://api.github.com/repos/phadej/github/git/trees{/sha}", "statuses_url": "https://api.github.com/repos/phadej/github/statuses/{sha}", "languages_url": "https://api.github.com/repos/phadej/github/languages", "stargazers_url": "https://api.github.com/repos/phadej/github/stargazers", "contributors_url": "https://api.github.com/repos/phadej/github/contributors", "subscribers_url": "https://api.github.com/repos/phadej/github/subscribers", "subscription_url": "https://api.github.com/repos/phadej/github/subscription", "commits_url": "https://api.github.com/repos/phadej/github/commits{/sha}", "git_commits_url": "https://api.github.com/repos/phadej/github/git/commits{/sha}", "comments_url": "https://api.github.com/repos/phadej/github/comments{/number}", "issue_comment_url": "https://api.github.com/repos/phadej/github/issues/comments{/number}", "contents_url": "https://api.github.com/repos/phadej/github/contents/{+path}", "compare_url": "https://api.github.com/repos/phadej/github/compare/{base}...{head}", "merges_url": "https://api.github.com/repos/phadej/github/merges", "archive_url": "https://api.github.com/repos/phadej/github/{archive_format}{/ref}", "downloads_url": "https://api.github.com/repos/phadej/github/downloads", "issues_url": "https://api.github.com/repos/phadej/github/issues{/number}", "pulls_url": "https://api.github.com/repos/phadej/github/pulls{/number}", "milestones_url": "https://api.github.com/repos/phadej/github/milestones{/number}", "notifications_url": "https://api.github.com/repos/phadej/github/notifications{?since,all,participating}", "labels_url": "https://api.github.com/repos/phadej/github/labels{/name}", "releases_url": "https://api.github.com/repos/phadej/github/releases{/id}", "deployments_url": "https://api.github.com/repos/phadej/github/deployments", "created_at": "2017-09-06T11:54:37Z", "updated_at": "2017-09-06T11:55:42Z", "pushed_at": "2017-10-01T16:58:54Z", "git_url": "git://github.com/phadej/github.git", "ssh_url": "git@github.com:phadej/github.git", "clone_url": "https://github.com/phadej/github.git", "svn_url": "https://github.com/phadej/github", "homepage": null, "size": 335, "stargazers_count": 0, "watchers_count": 0, "language": "Haskell", "has_issues": true, "has_projects": true, "has_downloads": true, "has_wiki": true, "has_pages": false, "forks_count": 0, "mirror_url": null, "open_issues_count": 1, "forks": 0, "open_issues": 1, "watchers": 0, "default_branch": "master" } }, "_links": { "self": { "href": "https://api.github.com/repos/phadej/github/pulls/9" }, "html": { "href": "https://github.com/phadej/github/pull/9" }, "issue": { "href": "https://api.github.com/repos/phadej/github/issues/9" }, "comments": { "href": "https://api.github.com/repos/phadej/github/issues/9/comments" }, "review_comments": { "href": "https://api.github.com/repos/phadej/github/pulls/9/comments" }, "review_comment": { "href": "https://api.github.com/repos/phadej/github/pulls/comments{/number}" }, "commits": { "href": "https://api.github.com/repos/phadej/github/pulls/9/commits" }, "statuses": { "href": "https://api.github.com/repos/phadej/github/statuses/20218048bb9529de09f1fdaa9126f60ffeb07ce5" } }, "author_association": "OWNER", "merged": false, "mergeable": null, "rebaseable": null, "mergeable_state": "unknown", "merged_by": null, "comments": 0, "review_comments": 0, "maintainer_can_modify": false, "commits": 6, "additions": 363, "deletions": 48, "changed_files": 19 } github-0.23/fixtures/pull-request-review-requested.json0000755000000000000000000004260507346545000021627 0ustar0000000000000000{ "url": "https://api.github.com/repos/phadej/github/pulls/9", "id": 144079630, "html_url": "https://github.com/phadej/github/pull/9", "diff_url": "https://github.com/phadej/github/pull/9.diff", "patch_url": "https://github.com/phadej/github/pull/9.patch", "issue_url": "https://api.github.com/repos/phadej/github/issues/9", "number": 9, "state": "open", "locked": false, "title": "Fetch my pull requests", "user": { "login": "phadej", "id": 123898390, "avatar_url": "https://avatars3.githubusercontent.com/u/123898390?v=4", "gravatar_id": "", "url": "https://api.github.com/users/phadej", "html_url": "https://github.com/phadej", "followers_url": "https://api.github.com/users/phadej/followers", "following_url": "https://api.github.com/users/phadej/following{/other_user}", "gists_url": "https://api.github.com/users/phadej/gists{/gist_id}", "starred_url": "https://api.github.com/users/phadej/starred{/owner}{/repo}", "subscriptions_url": "https://api.github.com/users/phadej/subscriptions", "organizations_url": "https://api.github.com/users/phadej/orgs", "repos_url": "https://api.github.com/users/phadej/repos", "events_url": "https://api.github.com/users/phadej/events{/privacy}", "received_events_url": "https://api.github.com/users/phadej/received_events", "type": "User", "site_admin": false }, "body": "", "created_at": "2017-10-01T17:22:12Z", "updated_at": "2017-10-01T17:22:12Z", "closed_at": null, "merged_at": null, "merge_commit_sha": null, "assignee": null, "assignees": [ { "login": "phadej", "id": 123898390, "avatar_url": "https://avatars3.githubusercontent.com/u/123898390?v=4", "gravatar_id": "", "url": "https://api.github.com/users/phadej", "html_url": "https://github.com/phadej", "followers_url": "https://api.github.com/users/phadej/followers", "following_url": "https://api.github.com/users/phadej/following{/other_user}", "gists_url": "https://api.github.com/users/phadej/gists{/gist_id}", "starred_url": "https://api.github.com/users/phadej/starred{/owner}{/repo}", "subscriptions_url": "https://api.github.com/users/phadej/subscriptions", "organizations_url": "https://api.github.com/users/phadej/orgs", "repos_url": "https://api.github.com/users/phadej/repos", "events_url": "https://api.github.com/users/phadej/events{/privacy}", "received_events_url": "https://api.github.com/users/phadej/received_events", "type": "User", "site_admin": false } ], "requested_reviewers": [ { "login": "phadej", "id": 123898390, "avatar_url": "https://avatars3.githubusercontent.com/u/123898390?v=4", "gravatar_id": "", "url": "https://api.github.com/users/phadej", "html_url": "https://github.com/phadej", "followers_url": "https://api.github.com/users/phadej/followers", "following_url": "https://api.github.com/users/phadej/following{/other_user}", "gists_url": "https://api.github.com/users/phadej/gists{/gist_id}", "starred_url": "https://api.github.com/users/phadej/starred{/owner}{/repo}", "subscriptions_url": "https://api.github.com/users/phadej/subscriptions", "organizations_url": "https://api.github.com/users/phadej/orgs", "repos_url": "https://api.github.com/users/phadej/repos", "events_url": "https://api.github.com/users/phadej/events{/privacy}", "received_events_url": "https://api.github.com/users/phadej/received_events", "type": "User", "site_admin": false } ], "milestone": null, "commits_url": "https://api.github.com/repos/phadej/github/pulls/9/commits", "review_comments_url": "https://api.github.com/repos/phadej/github/pulls/9/comments", "review_comment_url": "https://api.github.com/repos/phadej/github/pulls/comments{/number}", "comments_url": "https://api.github.com/repos/phadej/github/issues/9/comments", "statuses_url": "https://api.github.com/repos/phadej/github/statuses/20218048bb9529de09f1fdaa9126f60ffeb07ce5", "head": { "label": "phadej:fetch-my-pull-requests", "ref": "fetch-my-pull-requests", "sha": "20218048bb9529de09f1fdaa9126f60ffeb07ce5", "user": { "login": "phadej", "id": 123898390, "avatar_url": "https://avatars3.githubusercontent.com/u/123898390?v=4", "gravatar_id": "", "url": "https://api.github.com/users/phadej", "html_url": "https://github.com/phadej", "followers_url": "https://api.github.com/users/phadej/followers", "following_url": "https://api.github.com/users/phadej/following{/other_user}", "gists_url": "https://api.github.com/users/phadej/gists{/gist_id}", "starred_url": "https://api.github.com/users/phadej/starred{/owner}{/repo}", "subscriptions_url": "https://api.github.com/users/phadej/subscriptions", "organizations_url": "https://api.github.com/users/phadej/orgs", "repos_url": "https://api.github.com/users/phadej/repos", "events_url": "https://api.github.com/users/phadej/events{/privacy}", "received_events_url": "https://api.github.com/users/phadej/received_events", "type": "User", "site_admin": false }, "repo": { "id": 102602684, "name": "github", "full_name": "phadej/github", "owner": { "login": "phadej", "id": 123898390, "avatar_url": "https://avatars3.githubusercontent.com/u/123898390?v=4", "gravatar_id": "", "url": "https://api.github.com/users/phadej", "html_url": "https://github.com/phadej", "followers_url": "https://api.github.com/users/phadej/followers", "following_url": "https://api.github.com/users/phadej/following{/other_user}", "gists_url": "https://api.github.com/users/phadej/gists{/gist_id}", "starred_url": "https://api.github.com/users/phadej/starred{/owner}{/repo}", "subscriptions_url": "https://api.github.com/users/phadej/subscriptions", "organizations_url": "https://api.github.com/users/phadej/orgs", "repos_url": "https://api.github.com/users/phadej/repos", "events_url": "https://api.github.com/users/phadej/events{/privacy}", "received_events_url": "https://api.github.com/users/phadej/received_events", "type": "User", "site_admin": false }, "private": true, "html_url": "https://github.com/phadej/github", "description": null, "fork": false, "url": "https://api.github.com/repos/phadej/github", "forks_url": "https://api.github.com/repos/phadej/github/forks", "keys_url": "https://api.github.com/repos/phadej/github/keys{/key_id}", "collaborators_url": "https://api.github.com/repos/phadej/github/collaborators{/collaborator}", "teams_url": "https://api.github.com/repos/phadej/github/teams", "hooks_url": "https://api.github.com/repos/phadej/github/hooks", "issue_events_url": "https://api.github.com/repos/phadej/github/issues/events{/number}", "events_url": "https://api.github.com/repos/phadej/github/events", "assignees_url": "https://api.github.com/repos/phadej/github/assignees{/user}", "branches_url": "https://api.github.com/repos/phadej/github/branches{/branch}", "tags_url": "https://api.github.com/repos/phadej/github/tags", "blobs_url": "https://api.github.com/repos/phadej/github/git/blobs{/sha}", "git_tags_url": "https://api.github.com/repos/phadej/github/git/tags{/sha}", "git_refs_url": "https://api.github.com/repos/phadej/github/git/refs{/sha}", "trees_url": "https://api.github.com/repos/phadej/github/git/trees{/sha}", "statuses_url": "https://api.github.com/repos/phadej/github/statuses/{sha}", "languages_url": "https://api.github.com/repos/phadej/github/languages", "stargazers_url": "https://api.github.com/repos/phadej/github/stargazers", "contributors_url": "https://api.github.com/repos/phadej/github/contributors", "subscribers_url": "https://api.github.com/repos/phadej/github/subscribers", "subscription_url": "https://api.github.com/repos/phadej/github/subscription", "commits_url": "https://api.github.com/repos/phadej/github/commits{/sha}", "git_commits_url": "https://api.github.com/repos/phadej/github/git/commits{/sha}", "comments_url": "https://api.github.com/repos/phadej/github/comments{/number}", "issue_comment_url": "https://api.github.com/repos/phadej/github/issues/comments{/number}", "contents_url": "https://api.github.com/repos/phadej/github/contents/{+path}", "compare_url": "https://api.github.com/repos/phadej/github/compare/{base}...{head}", "merges_url": "https://api.github.com/repos/phadej/github/merges", "archive_url": "https://api.github.com/repos/phadej/github/{archive_format}{/ref}", "downloads_url": "https://api.github.com/repos/phadej/github/downloads", "issues_url": "https://api.github.com/repos/phadej/github/issues{/number}", "pulls_url": "https://api.github.com/repos/phadej/github/pulls{/number}", "milestones_url": "https://api.github.com/repos/phadej/github/milestones{/number}", "notifications_url": "https://api.github.com/repos/phadej/github/notifications{?since,all,participating}", "labels_url": "https://api.github.com/repos/phadej/github/labels{/name}", "releases_url": "https://api.github.com/repos/phadej/github/releases{/id}", "deployments_url": "https://api.github.com/repos/phadej/github/deployments", "created_at": "2017-09-06T11:54:37Z", "updated_at": "2017-09-06T11:55:42Z", "pushed_at": "2017-10-01T16:58:54Z", "git_url": "git://github.com/phadej/github.git", "ssh_url": "git@github.com:phadej/github.git", "clone_url": "https://github.com/phadej/github.git", "svn_url": "https://github.com/phadej/github", "homepage": null, "size": 335, "stargazers_count": 0, "watchers_count": 0, "language": "Haskell", "has_issues": true, "has_projects": true, "has_downloads": true, "has_wiki": true, "has_pages": false, "forks_count": 0, "mirror_url": null, "open_issues_count": 1, "forks": 0, "open_issues": 1, "watchers": 0, "default_branch": "master" } }, "base": { "label": "phadej:master", "ref": "master", "sha": "cb686149c0d88af16de61488a1ba70a6c71a2b65", "user": { "login": "phadej", "id": 123898390, "avatar_url": "https://avatars3.githubusercontent.com/u/123898390?v=4", "gravatar_id": "", "url": "https://api.github.com/users/phadej", "html_url": "https://github.com/phadej", "followers_url": "https://api.github.com/users/phadej/followers", "following_url": "https://api.github.com/users/phadej/following{/other_user}", "gists_url": "https://api.github.com/users/phadej/gists{/gist_id}", "starred_url": "https://api.github.com/users/phadej/starred{/owner}{/repo}", "subscriptions_url": "https://api.github.com/users/phadej/subscriptions", "organizations_url": "https://api.github.com/users/phadej/orgs", "repos_url": "https://api.github.com/users/phadej/repos", "events_url": "https://api.github.com/users/phadej/events{/privacy}", "received_events_url": "https://api.github.com/users/phadej/received_events", "type": "User", "site_admin": false }, "repo": { "id": 102602684, "name": "github", "full_name": "phadej/github", "owner": { "login": "phadej", "id": 123898390, "avatar_url": "https://avatars3.githubusercontent.com/u/123898390?v=4", "gravatar_id": "", "url": "https://api.github.com/users/phadej", "html_url": "https://github.com/phadej", "followers_url": "https://api.github.com/users/phadej/followers", "following_url": "https://api.github.com/users/phadej/following{/other_user}", "gists_url": "https://api.github.com/users/phadej/gists{/gist_id}", "starred_url": "https://api.github.com/users/phadej/starred{/owner}{/repo}", "subscriptions_url": "https://api.github.com/users/phadej/subscriptions", "organizations_url": "https://api.github.com/users/phadej/orgs", "repos_url": "https://api.github.com/users/phadej/repos", "events_url": "https://api.github.com/users/phadej/events{/privacy}", "received_events_url": "https://api.github.com/users/phadej/received_events", "type": "User", "site_admin": false }, "private": true, "html_url": "https://github.com/phadej/github", "description": null, "fork": false, "url": "https://api.github.com/repos/phadej/github", "forks_url": "https://api.github.com/repos/phadej/github/forks", "keys_url": "https://api.github.com/repos/phadej/github/keys{/key_id}", "collaborators_url": "https://api.github.com/repos/phadej/github/collaborators{/collaborator}", "teams_url": "https://api.github.com/repos/phadej/github/teams", "hooks_url": "https://api.github.com/repos/phadej/github/hooks", "issue_events_url": "https://api.github.com/repos/phadej/github/issues/events{/number}", "events_url": "https://api.github.com/repos/phadej/github/events", "assignees_url": "https://api.github.com/repos/phadej/github/assignees{/user}", "branches_url": "https://api.github.com/repos/phadej/github/branches{/branch}", "tags_url": "https://api.github.com/repos/phadej/github/tags", "blobs_url": "https://api.github.com/repos/phadej/github/git/blobs{/sha}", "git_tags_url": "https://api.github.com/repos/phadej/github/git/tags{/sha}", "git_refs_url": "https://api.github.com/repos/phadej/github/git/refs{/sha}", "trees_url": "https://api.github.com/repos/phadej/github/git/trees{/sha}", "statuses_url": "https://api.github.com/repos/phadej/github/statuses/{sha}", "languages_url": "https://api.github.com/repos/phadej/github/languages", "stargazers_url": "https://api.github.com/repos/phadej/github/stargazers", "contributors_url": "https://api.github.com/repos/phadej/github/contributors", "subscribers_url": "https://api.github.com/repos/phadej/github/subscribers", "subscription_url": "https://api.github.com/repos/phadej/github/subscription", "commits_url": "https://api.github.com/repos/phadej/github/commits{/sha}", "git_commits_url": "https://api.github.com/repos/phadej/github/git/commits{/sha}", "comments_url": "https://api.github.com/repos/phadej/github/comments{/number}", "issue_comment_url": "https://api.github.com/repos/phadej/github/issues/comments{/number}", "contents_url": "https://api.github.com/repos/phadej/github/contents/{+path}", "compare_url": "https://api.github.com/repos/phadej/github/compare/{base}...{head}", "merges_url": "https://api.github.com/repos/phadej/github/merges", "archive_url": "https://api.github.com/repos/phadej/github/{archive_format}{/ref}", "downloads_url": "https://api.github.com/repos/phadej/github/downloads", "issues_url": "https://api.github.com/repos/phadej/github/issues{/number}", "pulls_url": "https://api.github.com/repos/phadej/github/pulls{/number}", "milestones_url": "https://api.github.com/repos/phadej/github/milestones{/number}", "notifications_url": "https://api.github.com/repos/phadej/github/notifications{?since,all,participating}", "labels_url": "https://api.github.com/repos/phadej/github/labels{/name}", "releases_url": "https://api.github.com/repos/phadej/github/releases{/id}", "deployments_url": "https://api.github.com/repos/phadej/github/deployments", "created_at": "2017-09-06T11:54:37Z", "updated_at": "2017-09-06T11:55:42Z", "pushed_at": "2017-10-01T16:58:54Z", "git_url": "git://github.com/phadej/github.git", "ssh_url": "git@github.com:phadej/github.git", "clone_url": "https://github.com/phadej/github.git", "svn_url": "https://github.com/phadej/github", "homepage": null, "size": 335, "stargazers_count": 0, "watchers_count": 0, "language": "Haskell", "has_issues": true, "has_projects": true, "has_downloads": true, "has_wiki": true, "has_pages": false, "forks_count": 0, "mirror_url": null, "open_issues_count": 1, "forks": 0, "open_issues": 1, "watchers": 0, "default_branch": "master" } }, "_links": { "self": { "href": "https://api.github.com/repos/phadej/github/pulls/9" }, "html": { "href": "https://github.com/phadej/github/pull/9" }, "issue": { "href": "https://api.github.com/repos/phadej/github/issues/9" }, "comments": { "href": "https://api.github.com/repos/phadej/github/issues/9/comments" }, "review_comments": { "href": "https://api.github.com/repos/phadej/github/pulls/9/comments" }, "review_comment": { "href": "https://api.github.com/repos/phadej/github/pulls/comments{/number}" }, "commits": { "href": "https://api.github.com/repos/phadej/github/pulls/9/commits" }, "statuses": { "href": "https://api.github.com/repos/phadej/github/statuses/20218048bb9529de09f1fdaa9126f60ffeb07ce5" } }, "author_association": "OWNER", "merged": false, "mergeable": null, "rebaseable": null, "mergeable_state": "unknown", "merged_by": null, "comments": 0, "review_comments": 0, "maintainer_can_modify": false, "commits": 6, "additions": 363, "deletions": 48, "changed_files": 19 } github-0.23/fixtures/user-bot.json0000755000000000000000000000244207346545000015422 0ustar0000000000000000{ "login": "mike-burns", "id": 4550, "avatar_url": "https://avatars.githubusercontent.com/u/4550?v=3", "gravatar_id": "", "url": "https://api.github.com/users/mike-burns", "html_url": "https://github.com/mike-burns", "followers_url": "https://api.github.com/users/mike-burns/followers", "following_url": "https://api.github.com/users/mike-burns/following{/other_user}", "gists_url": "https://api.github.com/users/mike-burns/gists{/gist_id}", "starred_url": "https://api.github.com/users/mike-burns/starred{/owner}{/repo}", "subscriptions_url": "https://api.github.com/users/mike-burns/subscriptions", "organizations_url": "https://api.github.com/users/mike-burns/orgs", "repos_url": "https://api.github.com/users/mike-burns/repos", "events_url": "https://api.github.com/users/mike-burns/events{/privacy}", "received_events_url": "https://api.github.com/users/mike-burns/received_events", "type": "Bot", "site_admin": false, "name": "Mike Burns", "company": "thoughtbot", "blog": "http://mike-burns.com/", "location": "Stockholm, Sweden", "email": "mburns@thoughtbot.com", "hireable": true, "bio": null, "public_repos": 35, "public_gists": 32, "followers": 171, "following": 0, "created_at": "2008-04-03T17:54:24Z", "updated_at": "2015-10-02T16:53:25Z" } github-0.23/fixtures/user-organizations.json0000755000000000000000000000032207346545000017520 0ustar0000000000000000[ { "login": "github", "id": 1, "url": "https://api.github.com/orgs/github", "avatar_url": "https://github.com/images/error/octocat_happy.gif", "description": "A great organization" } ] github-0.23/fixtures/user.json0000755000000000000000000000244307346545000014641 0ustar0000000000000000{ "login": "mike-burns", "id": 4550, "avatar_url": "https://avatars.githubusercontent.com/u/4550?v=3", "gravatar_id": "", "url": "https://api.github.com/users/mike-burns", "html_url": "https://github.com/mike-burns", "followers_url": "https://api.github.com/users/mike-burns/followers", "following_url": "https://api.github.com/users/mike-burns/following{/other_user}", "gists_url": "https://api.github.com/users/mike-burns/gists{/gist_id}", "starred_url": "https://api.github.com/users/mike-burns/starred{/owner}{/repo}", "subscriptions_url": "https://api.github.com/users/mike-burns/subscriptions", "organizations_url": "https://api.github.com/users/mike-burns/orgs", "repos_url": "https://api.github.com/users/mike-burns/repos", "events_url": "https://api.github.com/users/mike-burns/events{/privacy}", "received_events_url": "https://api.github.com/users/mike-burns/received_events", "type": "User", "site_admin": false, "name": "Mike Burns", "company": "thoughtbot", "blog": "http://mike-burns.com/", "location": "Stockholm, Sweden", "email": "mburns@thoughtbot.com", "hireable": true, "bio": null, "public_repos": 35, "public_gists": 32, "followers": 171, "following": 0, "created_at": "2008-04-03T17:54:24Z", "updated_at": "2015-10-02T16:53:25Z" } github-0.23/github.cabal0000644000000000000000000001546507346545000013372 0ustar0000000000000000cabal-version: >=1.10 name: github version: 0.23 synopsis: Access to the GitHub API, v3. category: Network description: The GitHub API provides programmatic access to the full GitHub Web site, from Issues to Gists to repos down to the underlying git data like references and trees. This library wraps all of that, exposing a basic but Haskell-friendly set of functions and data structures. . For supported endpoints see "GitHub" module. . > import qualified GitHub as GH > > main :: IO () > main = do > possibleUser <- GH.executeRequest' $ GH.userInfoForR "phadej" > print possibleUser . For more of an overview please see the README: license: BSD3 license-file: LICENSE author: Mike Burns, John Wiegley, Oleg Grenrus maintainer: Oleg Grenrus homepage: https://github.com/phadej/github build-type: Simple copyright: Copyright 2012-2013 Mike Burns, Copyright 2013-2015 John Wiegley, Copyright 2016-2019 Oleg Grenrus tested-with: GHC ==7.8.4 || ==7.10.3 || ==8.0.2 || ==8.2.2 || ==8.4.4 || ==8.6.5 || ==8.8.1 extra-source-files: README.md CHANGELOG.md fixtures/issue-search.json fixtures/list-teams.json fixtures/members-list.json fixtures/pull-request-opened.json fixtures/pull-request-review-requested.json fixtures/user-organizations.json fixtures/user.json fixtures/user-bot.json source-repository head type: git location: git://github.com/phadej/github.git flag openssl description: "Use http-client-openssl" manual: True default: False library default-language: Haskell2010 ghc-options: -Wall hs-source-dirs: src default-extensions: DataKinds DeriveDataTypeable DeriveGeneric OverloadedStrings ScopedTypeVariables other-extensions: CPP FlexibleContexts FlexibleInstances GADTs KindSignatures RecordWildCards StandaloneDeriving exposed-modules: GitHub GitHub.Auth GitHub.Data GitHub.Data.Activities GitHub.Data.Comments GitHub.Data.Content GitHub.Data.Definitions GitHub.Data.DeployKeys GitHub.Data.Deployments GitHub.Data.Email GitHub.Data.Events GitHub.Data.Gists GitHub.Data.GitData GitHub.Data.Id GitHub.Data.Invitation GitHub.Data.Issues GitHub.Data.Milestone GitHub.Data.Name GitHub.Data.Options GitHub.Data.PublicSSHKeys GitHub.Data.PullRequests GitHub.Data.RateLimit GitHub.Data.Releases GitHub.Data.Repos GitHub.Data.Request GitHub.Data.Reviews GitHub.Data.Search GitHub.Data.Statuses GitHub.Data.Teams GitHub.Data.URL GitHub.Data.Webhooks GitHub.Data.Webhooks.Validate GitHub.Endpoints.Activity.Events GitHub.Endpoints.Activity.Notifications GitHub.Endpoints.Activity.Starring GitHub.Endpoints.Activity.Watching GitHub.Endpoints.Gists GitHub.Endpoints.Gists.Comments GitHub.Endpoints.GitData.Blobs GitHub.Endpoints.GitData.Commits GitHub.Endpoints.GitData.References GitHub.Endpoints.GitData.Trees GitHub.Endpoints.Issues GitHub.Endpoints.Issues.Comments GitHub.Endpoints.Issues.Events GitHub.Endpoints.Issues.Labels GitHub.Endpoints.Issues.Milestones GitHub.Endpoints.Organizations GitHub.Endpoints.Organizations.Members GitHub.Endpoints.Organizations.Teams GitHub.Endpoints.PullRequests GitHub.Endpoints.PullRequests.Comments GitHub.Endpoints.PullRequests.Reviews GitHub.Endpoints.RateLimit GitHub.Endpoints.Repos GitHub.Endpoints.Repos.Collaborators GitHub.Endpoints.Repos.Comments GitHub.Endpoints.Repos.Commits GitHub.Endpoints.Repos.Contents GitHub.Endpoints.Repos.DeployKeys GitHub.Endpoints.Repos.Deployments GitHub.Endpoints.Repos.Forks GitHub.Endpoints.Repos.Invitations GitHub.Endpoints.Repos.Releases GitHub.Endpoints.Repos.Statuses GitHub.Endpoints.Repos.Webhooks GitHub.Endpoints.Search GitHub.Endpoints.Users GitHub.Endpoints.Users.Emails GitHub.Endpoints.Users.Followers GitHub.Endpoints.Users.PublicSSHKeys GitHub.Internal.Prelude GitHub.Request other-modules: Paths_github -- Packages bundles with GHC, mtl and text are also here build-depends: base >=4.7 && <4.14 , binary >=0.7.1.0 && <0.11 , bytestring >=0.10.4.0 && <0.11 , containers >=0.5.5.1 && <0.7 , deepseq >=1.3.0.2 && <1.5 , mtl >=2.1.3.1 && <2.2 || >=2.2.1 && <2.3 , text >=1.2.0.6 && <1.3 , time >=1.4 && <1.10 , transformers >=0.3.0.0 && <0.6 -- other packages build-depends: aeson >=1.4.0.0 && <1.5 , base-compat >=0.10.4 && <0.12 , base16-bytestring >=0.1.1.6 && <0.2 , binary-instances >=1 && <1.1 , cryptohash-sha1 >=0.11.100.1 && <0.12 , deepseq-generics >=0.2.0.0 && <0.3 , exceptions >=0.10.2 && <0.11 , hashable >=1.2.7.0 && <1.4 , http-client >=0.5.12 && <0.7 , http-link-header >=1.0.3.1 && <1.1 , http-types >=0.12.3 && <0.13 , iso8601-time >=0.1.5 && <0.2 , network-uri >=2.6.1.0 && <2.7 , tagged >=0.8.5 && <0.9 , transformers-compat >=0.6.5 && <0.7 , unordered-containers >=0.2.10.0 && <0.3 , vector >=0.12.0.1 && <0.13 , vector-instances >=3.4 && <3.5 if flag(openssl) build-depends: HsOpenSSL >=0.11.4.16 && <0.12 , HsOpenSSL-x509-system >=0.1.0.3 && <0.2 , http-client-openssl >=0.2.2.0 && <0.4 else build-depends: http-client-tls >=0.3.5.3 && <0.4 , tls >=1.4.1 if !impl(ghc >=8.0) build-depends: semigroups >=0.18.5 && <0.20 test-suite github-test default-language: Haskell2010 type: exitcode-stdio-1.0 hs-source-dirs: spec main-is: Spec.hs ghc-options: -Wall -threaded build-tool-depends: hspec-discover:hspec-discover >=2.7.1 && <2.8 other-extensions: TemplateHaskell other-modules: GitHub.ActivitySpec GitHub.CommitsSpec GitHub.EventsSpec GitHub.IssuesSpec GitHub.OrganizationsSpec GitHub.PublicSSHKeysSpec GitHub.PullRequestReviewsSpec GitHub.PullRequestsSpec GitHub.RateLimitSpec GitHub.ReleasesSpec GitHub.ReposSpec GitHub.SearchSpec GitHub.UsersSpec build-depends: aeson , base , base-compat , bytestring , file-embed , github , hspec >=2.6.1 && <2.8 , tagged , text , unordered-containers , vector github-0.23/spec/GitHub/0000755000000000000000000000000007346545000013225 5ustar0000000000000000github-0.23/spec/GitHub/ActivitySpec.hs0000644000000000000000000000266707346545000016203 0ustar0000000000000000{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TemplateHaskell #-} module GitHub.ActivitySpec where import qualified GitHub import GitHub.Auth (Auth (..)) import GitHub.Endpoints.Activity.Starring (myStarredAcceptStarR) import GitHub.Endpoints.Activity.Watching (watchersForR) import GitHub.Request (executeRequest) import Data.Either.Compat (isRight) import Data.String (fromString) import System.Environment (lookupEnv) import Test.Hspec (Spec, describe, it, pendingWith, shouldSatisfy) import qualified Data.Vector as V fromRightS :: Show a => Either a b -> b fromRightS (Right b) = b fromRightS (Left a) = error $ "Expected a Right and got a Left" ++ show a withAuth :: (Auth -> IO ()) -> IO () withAuth action = do mtoken <- lookupEnv "GITHUB_TOKEN" case mtoken of Nothing -> pendingWith "no GITHUB_TOKEN" Just token -> action (OAuth $ fromString token) spec :: Spec spec = do describe "watchersForR" $ do it "works" $ withAuth $ \auth -> do cs <- executeRequest auth $ watchersForR "phadej" "github" GitHub.FetchAll cs `shouldSatisfy` isRight V.length (fromRightS cs) `shouldSatisfy` (> 10) describe "myStarredR" $ do it "works" $ withAuth $ \auth -> do cs <- executeRequest auth $ myStarredAcceptStarR (GitHub.FetchAtLeast 31) cs `shouldSatisfy` isRight fromRightS cs `shouldSatisfy` (\xs -> V.length xs > 30) github-0.23/spec/GitHub/CommitsSpec.hs0000644000000000000000000000507507346545000016016 0ustar0000000000000000{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TemplateHaskell #-} module GitHub.CommitsSpec where import qualified GitHub import GitHub.Auth (Auth (..)) import GitHub.Endpoints.Repos.Commits (commitSha, commitsFor', commitsForR, diffR, mkCommitName) import GitHub.Request (executeRequest) import Control.Monad (forM_) import Data.Either.Compat (isRight) import Data.List (nub, sort) import Data.String (fromString) import System.Environment (lookupEnv) import Test.Hspec (Spec, describe, it, pendingWith, shouldBe, shouldSatisfy) import qualified Data.Vector as V fromRightS :: Show a => Either a b -> b fromRightS (Right b) = b fromRightS (Left a) = error $ "Expected a Right and got a Left" ++ show a withAuth :: (Auth -> IO ()) -> IO () withAuth action = do mtoken <- lookupEnv "GITHUB_TOKEN" case mtoken of Nothing -> pendingWith "no GITHUB_TOKEN" Just token -> action (OAuth $ fromString token) spec :: Spec spec = do describe "commitsFor" $ do it "works" $ withAuth $ \auth -> do cs <- commitsFor' (Just auth) "phadej" "github" cs `shouldSatisfy` isRight V.length (fromRightS cs) `shouldSatisfy` (> 300) -- Page size is 30, so we get 60 commits it "limits the response" $ withAuth $ \auth -> do cs <- executeRequest auth $ commitsForR "phadej" "github" (GitHub.FetchAtLeast 40) cs `shouldSatisfy` isRight let cs' = fromRightS cs V.length cs' `shouldSatisfy` (< 70) let hashes = sort $ map commitSha $ V.toList cs' hashes `shouldBe` nub hashes describe "diff" $ do it "works" $ withAuth $ \auth -> do cs <- executeRequest auth $ commitsForR "phadej" "github" (GitHub.FetchAtLeast 30) cs `shouldSatisfy` isRight let commits = take 10 . V.toList . fromRightS $ cs let pairs = zip commits $ drop 1 commits forM_ pairs $ \(a, b) -> do d <- executeRequest auth $ diffR "phadej" "github" (commitSha a) (commitSha b) d `shouldSatisfy` isRight it "issue #155" $ withAuth $ \auth -> do d <- executeRequest auth $ diffR "nomeata" "codespeed" (mkCommitName "ghc") (mkCommitName "tobami:master") d `shouldSatisfy` isRight -- diff that includes a commit where a submodule is removed it "issue #339" $ withAuth $ \auth -> do d <- executeRequest auth $ diffR "scott-fleischman" "repo-remove-submodule" "d03c152482169d809be9b1eab71dcf64d7405f76" "42cfd732b20cd093534f246e630b309186eb485d" d `shouldSatisfy` isRight github-0.23/spec/GitHub/EventsSpec.hs0000644000000000000000000000225607346545000015645 0ustar0000000000000000{-# LANGUAGE OverloadedStrings #-} module GitHub.EventsSpec where import Data.Either (isRight) import Data.String (fromString) import Prelude () import Prelude.Compat import System.Environment (lookupEnv) import Test.Hspec (Spec, describe, it, shouldSatisfy, pendingWith) import qualified GitHub import GitHub.Data (Auth(..)) fromRightS :: Show a => Either a b -> b fromRightS (Left xs) = error $ "Should be Right" ++ show xs fromRightS (Right xs) = xs withAuth :: (Auth -> IO ()) -> IO () withAuth action = do mtoken <- lookupEnv "GITHUB_TOKEN" case mtoken of Nothing -> pendingWith "no GITHUB_TOKEN" Just token -> action (OAuth $ fromString token) spec :: Spec spec = do describe "repositoryEventsR" $ do it "returns non empty list of events" $ shouldSucceed $ GitHub.repositoryEventsR "phadej" "github" 1 describe "userEventsR" $ do it "returns non empty list of events" $ shouldSucceed $ GitHub.userEventsR "phadej" 1 where shouldSucceed f = withAuth $ \auth -> do cs <- GitHub.executeRequest auth $ f cs `shouldSatisfy` isRight length (fromRightS cs) `shouldSatisfy` (> 1) github-0.23/spec/GitHub/IssuesSpec.hs0000644000000000000000000000262607346545000015655 0ustar0000000000000000{-# LANGUAGE OverloadedStrings #-} module GitHub.IssuesSpec where import qualified GitHub import Prelude () import Prelude.Compat import Data.Either.Compat (isRight) import Data.Foldable (for_) import Data.String (fromString) import System.Environment (lookupEnv) import Test.Hspec (Spec, describe, expectationFailure, it, pendingWith, shouldSatisfy) fromRightS :: Show a => Either a b -> b fromRightS (Right b) = b fromRightS (Left a) = error $ "Expected a Right and got a Left" ++ show a withAuth :: (GitHub.Auth -> IO ()) -> IO () withAuth action = do mtoken <- lookupEnv "GITHUB_TOKEN" case mtoken of Nothing -> pendingWith "no GITHUB_TOKEN" Just token -> action (GitHub.OAuth $ fromString token) spec :: Spec spec = do describe "issuesForRepoR" $ do it "works" $ withAuth $ \auth -> for_ repos $ \(owner, repo) -> do cs <- GitHub.executeRequest auth $ GitHub.issuesForRepoR owner repo mempty GitHub.FetchAll case cs of Left e -> expectationFailure . show $ e Right cs' -> do for_ cs' $ \i -> do cms <- GitHub.executeRequest auth $ GitHub.commentsR owner repo (GitHub.issueNumber i) 1 cms `shouldSatisfy` isRight where repos = [ ("thoughtbot", "paperclip") , ("phadej", "github") ] github-0.23/spec/GitHub/OrganizationsSpec.hs0000644000000000000000000000367607346545000017237 0ustar0000000000000000{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TemplateHaskell #-} module GitHub.OrganizationsSpec where import GitHub.Auth (Auth (..)) import GitHub.Data (SimpleOrganization (..), SimpleOwner (..), SimpleTeam (..)) import GitHub.Endpoints.Organizations (publicOrganizationsFor') import GitHub.Endpoints.Organizations.Members (membersOf') import Data.Aeson (eitherDecodeStrict) import Data.Either.Compat (isRight) import Data.FileEmbed (embedFile) import Data.String (fromString) import System.Environment (lookupEnv) import Test.Hspec (Spec, describe, it, pendingWith, shouldBe, shouldSatisfy) fromRightS :: Show a => Either a b -> b fromRightS (Right b) = b fromRightS (Left a) = error $ "Expected a Right and got a Left" ++ show a withAuth :: (Auth -> IO ()) -> IO () withAuth action = do mtoken <- lookupEnv "GITHUB_TOKEN" case mtoken of Nothing -> pendingWith "no GITHUB_TOKEN" Just token -> action (OAuth $ fromString token) spec :: Spec spec = do describe "publicOrganizationsFor'" $ do it "decodes simple organization json" $ do let orgs = eitherDecodeStrict $(embedFile "fixtures/user-organizations.json") simpleOrganizationLogin (head $ fromRightS orgs) `shouldBe` "github" it "returns information about the user's organizations" $ withAuth $ \auth -> do orgs <- publicOrganizationsFor' (Just auth) "mike-burns" orgs `shouldSatisfy` isRight describe "teamsOf" $ do it "parse" $ do let ts = eitherDecodeStrict $(embedFile "fixtures/list-teams.json") simpleTeamName (head $ fromRightS ts) `shouldBe` "Justice League" describe "membersOf" $ do it "parse" $ do let ms = eitherDecodeStrict $(embedFile "fixtures/members-list.json") simpleOwnerLogin (head $ fromRightS ms) `shouldBe` "octocat" it "works" $ withAuth $ \auth -> do ms <- membersOf' (Just auth) "haskell" ms `shouldSatisfy` isRight github-0.23/spec/GitHub/PublicSSHKeysSpec.hs0000644000000000000000000000256007346545000017027 0ustar0000000000000000{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TemplateHaskell #-} module GitHub.PublicSSHKeysSpec where import GitHub (Auth (..), FetchCount (..), PublicSSHKey (..), executeRequest) import GitHub.Endpoints.Users.PublicSSHKeys (publicSSHKey', publicSSHKeys', publicSSHKeysForR) import Data.Either.Compat (isRight) import Data.String (fromString) import System.Environment (lookupEnv) import Test.Hspec (Spec, describe, it, pendingWith, shouldSatisfy) import qualified Data.Vector as V fromRightS :: Show a => Either a b -> b fromRightS (Right b) = b fromRightS (Left a) = error $ "Expected a Right and got a Left" ++ show a withAuth :: (Auth -> IO ()) -> IO () withAuth action = do mtoken <- lookupEnv "GITHUB_TOKEN" case mtoken of Nothing -> pendingWith "no GITHUB_TOKEN" Just token -> action (OAuth $ fromString token) spec :: Spec spec = do describe "publicSSHKeysFor'" $ do it "works" $ withAuth $ \auth -> do keys <- executeRequest auth $ publicSSHKeysForR "phadej" FetchAll V.length (fromRightS keys) `shouldSatisfy` (> 1) describe "publicSSHKeys' and publicSSHKey'" $ do it "works" $ withAuth $ \auth -> do keys <- publicSSHKeys' auth V.length (fromRightS keys) `shouldSatisfy` (> 1) key <- publicSSHKey' auth (publicSSHKeyId $ V.head (fromRightS keys)) key `shouldSatisfy` isRight github-0.23/spec/GitHub/PullRequestReviewsSpec.hs0000644000000000000000000000175607346545000020237 0ustar0000000000000000{-# LANGUAGE OverloadedStrings #-} module GitHub.PullRequestReviewsSpec where import qualified GitHub import GitHub.Data.Id (Id (Id)) import Prelude () import Prelude.Compat import Data.Either.Compat (isRight) import Data.Foldable (for_) import Data.String (fromString) import System.Environment (lookupEnv) import Test.Hspec (Spec, describe, it, pendingWith, shouldSatisfy) withAuth :: (GitHub.Auth -> IO ()) -> IO () withAuth action = do mtoken <- lookupEnv "GITHUB_TOKEN" case mtoken of Nothing -> pendingWith "no GITHUB_TOKEN" Just token -> action (GitHub.OAuth $ fromString token) spec :: Spec spec = do describe "pullRequestReviewsR" $ do it "works" $ withAuth $ \auth -> for_ prs $ \(owner, repo, prid) -> do cs <- GitHub.executeRequest auth $ GitHub.pullRequestReviewsR owner repo prid GitHub.FetchAll cs `shouldSatisfy` isRight where prs = [("phadej", "github", Id 268)] github-0.23/spec/GitHub/PullRequestsSpec.hs0000644000000000000000000001243207346545000017046 0ustar0000000000000000{-# LANGUAGE DataKinds #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TemplateHaskell #-} module GitHub.PullRequestsSpec where import qualified GitHub as GH import Prelude () import Prelude.Compat import Data.Aeson (FromJSON (..), eitherDecodeStrict, withObject, (.:)) import Data.ByteString (ByteString) import qualified Data.ByteString.Lazy.Char8 as LBS8 import Data.Either.Compat (isRight) import Data.FileEmbed (embedFile) import Data.Foldable (for_) import Data.String (fromString) import Data.Tagged (Tagged (..)) import Data.Text (Text) import qualified Data.Vector as V import System.Environment (lookupEnv) import Test.Hspec (Spec, describe, it, pendingWith, shouldBe, shouldSatisfy) fromRightS :: Show a => Either a b -> b fromRightS (Right b) = b fromRightS (Left a) = error $ "Expected a Right and got a Left" ++ show a withAuth :: (GH.Auth -> IO ()) -> IO () withAuth action = do mtoken <- lookupEnv "GITHUB_TOKEN" case mtoken of Nothing -> pendingWith "no GITHUB_TOKEN" Just token -> action (GH.OAuth $ fromString token) spec :: Spec spec = do describe "pullRequestsForR" $ do it "works" $ withAuth $ \auth -> for_ repos $ \(owner, repo) -> do cs <- GH.executeRequest auth $ GH.pullRequestsForR owner repo opts GH.FetchAll cs `shouldSatisfy` isRight describe "pullRequestPatchR" $ it "works" $ withAuth $ \auth -> do Right patch <- GH.executeRequest auth $ GH.pullRequestPatchR "phadej" "github" (GH.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 (GH.simplePullRequestRequestedReviewers simplePullRequestOpened) `shouldBe` 0 V.length (GH.pullRequestRequestedReviewers pullRequestOpened) `shouldBe` 0 it "decodes a pull request 'review_requested' payload" $ do V.length (GH.simplePullRequestRequestedReviewers simplePullRequestReviewRequested) `shouldBe` 1 V.length (GH.pullRequestRequestedReviewers pullRequestReviewRequested) `shouldBe` 1 describe "checking if a pull request is merged" $ do it "works" $ withAuth $ \auth -> do b <- GH.executeRequest auth $ GH.isPullRequestMergedR "phadej" "github" (GH.IssueNumber 14) b `shouldSatisfy` isRight fromRightS b `shouldBe` True describe "Draft Pull Request" $ do it "works" $ withAuth $ \auth -> do cs <- GH.executeRequest auth $ draftPullRequestsForR "phadej" "github" opts GH.FetchAll cs `shouldSatisfy` isRight where repos = [ ("thoughtbot", "paperclip") , ("phadej", "github") ] opts = GH.stateClosed simplePullRequestOpened :: GH.SimplePullRequest simplePullRequestOpened = fromRightS (eitherDecodeStrict prOpenedPayload) pullRequestOpened :: GH.PullRequest pullRequestOpened = fromRightS (eitherDecodeStrict prOpenedPayload) simplePullRequestReviewRequested :: GH.SimplePullRequest simplePullRequestReviewRequested = fromRightS (eitherDecodeStrict prReviewRequestedPayload) pullRequestReviewRequested :: GH.PullRequest pullRequestReviewRequested = fromRightS (eitherDecodeStrict prReviewRequestedPayload) prOpenedPayload :: ByteString prOpenedPayload = $(embedFile "fixtures/pull-request-opened.json") prReviewRequestedPayload :: ByteString prReviewRequestedPayload = $(embedFile "fixtures/pull-request-review-requested.json") ------------------------------------------------------------------------------- -- Draft Pull Requests ------------------------------------------------------------------------------- draftPullRequestsForR :: GH.Name GH.Owner -> GH.Name GH.Repo -> GH.PullRequestMod -> GH.FetchCount -> GH.GenRequest ('GH.MtPreview ShadowCat) k (V.Vector DraftPR) draftPullRequestsForR user repo opts = GH.PagedQuery ["repos", GH.toPathPart user, GH.toPathPart repo, "pulls"] (GH.prModToQueryString opts) data DraftPR = DraftPR { dprId :: !(GH.Id GH.PullRequest) , dprNumber :: !GH.IssueNumber , dprTitle :: !Text , dprDraft :: !Bool } deriving (Show) instance FromJSON DraftPR where parseJSON = withObject "DraftPR" $ \obj -> DraftPR <$> obj .: "id" <*> obj .: "number" <*> obj .: "title" <*> obj .: "draft" -- | @application/vnd.github.shadow-cat-preview+json@ data ShadowCat instance GH.PreviewAccept ShadowCat where previewContentType = Tagged "application/vnd.github.shadow-cat-preview+json" instance FromJSON a => GH.PreviewParseResponse ShadowCat a where previewParseResponse _ res = Tagged (GH.parseResponseJSON res) github-0.23/spec/GitHub/RateLimitSpec.hs0000644000000000000000000000156207346545000016272 0ustar0000000000000000{-# LANGUAGE OverloadedStrings #-} module GitHub.RateLimitSpec where import qualified GitHub import Prelude () import Prelude.Compat import Data.Either.Compat (isRight) import Data.String (fromString) import System.Environment (lookupEnv) import Test.Hspec (Spec, describe, it, pendingWith, shouldSatisfy) fromRightS :: Show a => Either a b -> b fromRightS (Right b) = b fromRightS (Left a) = error $ "Expected a Right and got a Left" ++ show a withAuth :: (GitHub.Auth -> IO ()) -> IO () withAuth action = do mtoken <- lookupEnv "GITHUB_TOKEN" case mtoken of Nothing -> pendingWith "no GITHUB_TOKEN" Just token -> action (GitHub.OAuth $ fromString token) spec :: Spec spec = describe "rateLimitR" $ it "works" $ withAuth $ \auth -> do cs <- GitHub.executeRequest auth GitHub.rateLimitR cs `shouldSatisfy` isRight github-0.23/spec/GitHub/ReleasesSpec.hs0000644000000000000000000000370107346545000016140 0ustar0000000000000000{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TemplateHaskell #-} module GitHub.ReleasesSpec where import qualified GitHub import GitHub.Auth (Auth (..)) import GitHub.Endpoints.Repos.Releases (Release (..), latestReleaseR, releaseByTagNameR, releaseR, releasesR) import GitHub.Request (executeRequest) import Data.Either.Compat (isRight) import Data.Proxy (Proxy (..)) import Data.String (fromString) import System.Environment (lookupEnv) import Test.Hspec (Spec, describe, it, pendingWith, shouldBe, shouldSatisfy) import qualified Data.Vector as V fromRightS :: Show a => Either a b -> b fromRightS (Right b) = b fromRightS (Left a) = error $ "Expected a Right and got a Left" ++ show a withAuth :: (Auth -> IO ()) -> IO () withAuth action = do mtoken <- lookupEnv "GITHUB_TOKEN" case mtoken of Nothing -> pendingWith "no GITHUB_TOKEN" Just token -> action (OAuth $ fromString token) spec :: Spec spec = do let v154Id = GitHub.mkId (Proxy :: Proxy Release) 5254449 v154Text = "v1.5.4" describe "releasesR" $ do it "works" $ withAuth $ \auth -> do rs <- executeRequest auth $ releasesR "calleerlandsson" "pick" GitHub.FetchAll rs `shouldSatisfy` isRight V.length (fromRightS rs) `shouldSatisfy` (> 14) describe "releaseR" $ do it "works" $ withAuth $ \auth -> do rs <- executeRequest auth $ releaseR "calleerlandsson" "pick" v154Id rs `shouldSatisfy` isRight releaseTagName (fromRightS rs)`shouldBe` v154Text describe "latestReleaseR" $ do it "works" $ withAuth $ \auth -> do rs <- executeRequest auth $ latestReleaseR "calleerlandsson" "pick" rs `shouldSatisfy` isRight describe "releaseByTagNameR" $ do it "works" $ withAuth $ \auth -> do rs <- executeRequest auth $ releaseByTagNameR "calleerlandsson" "pick" v154Text rs `shouldSatisfy` isRight releaseId (fromRightS rs)`shouldBe` v154Id github-0.23/spec/GitHub/ReposSpec.hs0000644000000000000000000000337607346545000015475 0ustar0000000000000000{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TemplateHaskell #-} module GitHub.ReposSpec where import GitHub (Auth (..), Repo (..), RepoPublicity (..), executeRequest, repositoryR) import GitHub.Endpoints.Repos (currentUserRepos, languagesFor', userRepos') import Data.Either.Compat (isRight) import Data.String (fromString) import System.Environment (lookupEnv) import Test.Hspec (Spec, describe, it, pendingWith, shouldBe, shouldSatisfy) import qualified Data.HashMap.Strict as HM fromRightS :: Show a => Either a b -> b fromRightS (Right b) = b fromRightS (Left a) = error $ "Expected a Right and got a Left" ++ show a withAuth :: (Auth -> IO ()) -> IO () withAuth action = do mtoken <- lookupEnv "GITHUB_TOKEN" case mtoken of Nothing -> pendingWith "no GITHUB_TOKEN" Just token -> action (OAuth $ fromString token) spec :: Spec spec = do describe "repositoryR" $ do it "works" $ withAuth $ \auth -> do er <- executeRequest auth $ repositoryR "phadej" "github" er `shouldSatisfy` isRight let Right r = er -- https://github.com/phadej/github/pull/219 repoDefaultBranch r `shouldBe` Just "master" describe "currentUserRepos" $ do it "works" $ withAuth $ \auth -> do cs <- currentUserRepos auth RepoPublicityAll cs `shouldSatisfy` isRight describe "userRepos" $ do it "works" $ withAuth $ \auth -> do cs <- userRepos' (Just auth) "phadej" RepoPublicityAll cs `shouldSatisfy` isRight describe "languagesFor'" $ do it "works" $ withAuth $ \auth -> do ls <- languagesFor' (Just auth) "phadej" "github" ls `shouldSatisfy` isRight fromRightS ls `shouldSatisfy` HM.member "Haskell" github-0.23/spec/GitHub/SearchSpec.hs0000644000000000000000000000427707346545000015613 0ustar0000000000000000{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TemplateHaskell #-} module GitHub.SearchSpec where import Prelude () import Prelude.Compat import Data.Aeson (eitherDecodeStrict) import Data.FileEmbed (embedFile) import Data.Proxy (Proxy (..)) import Data.String (fromString) import System.Environment (lookupEnv) import Test.Hspec (Spec, describe, it, pendingWith, shouldBe) import qualified Data.Vector as V import GitHub.Data (Auth (..), Issue (..), IssueNumber (..), IssueState (..), mkId) import GitHub.Endpoints.Search (SearchResult (..), searchIssues') fromRightS :: Show a => Either a b -> b fromRightS (Right b) = b fromRightS (Left a) = error $ "Expected a Right and got a Left" ++ show a withAuth :: (Auth -> IO ()) -> IO () withAuth action = do mtoken <- lookupEnv "GITHUB_TOKEN" case mtoken of Nothing -> pendingWith "no GITHUB_TOKEN" Just token -> action (OAuth $ fromString token) spec :: Spec spec = do describe "searchIssues" $ do it "decodes issue search response JSON" $ do let searchIssuesResult = fromRightS $ eitherDecodeStrict $(embedFile "fixtures/issue-search.json") :: SearchResult Issue searchResultTotalCount searchIssuesResult `shouldBe` 2 let issues = searchResultResults searchIssuesResult V.length issues `shouldBe` 2 let issue1 = issues V.! 0 issueId issue1 `shouldBe` mkId (Proxy :: Proxy Issue) 123898390 issueNumber issue1 `shouldBe` IssueNumber 130 issueTitle issue1 `shouldBe` "Make test runner more robust" issueState issue1 `shouldBe` StateClosed let issue2 = issues V.! 1 issueId issue2 `shouldBe` mkId (Proxy :: Proxy Issue) 119694665 issueNumber issue2 `shouldBe` IssueNumber 127 issueTitle issue2 `shouldBe` "Decouple request creation from execution" issueState issue2 `shouldBe` StateOpen it "performs an issue search via the API" $ withAuth $ \auth -> do let query = "Decouple in:title repo:phadej/github created:<=2015-12-01" issues <- searchResultResults . fromRightS <$> searchIssues' (Just auth) query length issues `shouldBe` 1 issueId (V.head issues) `shouldBe` mkId (Proxy :: Proxy Issue) 119694665 github-0.23/spec/GitHub/UsersSpec.hs0000644000000000000000000000611407346545000015477 0ustar0000000000000000{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TemplateHaskell #-} module GitHub.UsersSpec where import Data.Aeson (eitherDecodeStrict) import Data.Either.Compat (isLeft, isRight) import Data.FileEmbed (embedFile) import Data.String (fromString) import System.Environment (lookupEnv) import Test.Hspec (Spec, describe, it, pendingWith, shouldBe, shouldSatisfy) import qualified GitHub import GitHub.Data (Auth (..), Organization (..), User (..), fromOwner) import GitHub.Endpoints.Users (ownerInfoForR, userInfoCurrent', userInfoFor') import GitHub.Endpoints.Users.Followers (usersFollowedByR, usersFollowingR) import GitHub.Request (executeRequest) fromRightS :: Show a => Either a b -> b fromRightS (Right b) = b fromRightS (Left a) = error $ "Expected a Right and got a Left" ++ show a fromLeftS :: Show b => Either a b -> a fromLeftS (Left b) = b fromLeftS (Right a) = error $ "Expected a Left and got a RIght" ++ show a withAuth :: (Auth -> IO ()) -> IO () withAuth action = do mtoken <- lookupEnv "GITHUB_TOKEN" case mtoken of Nothing -> pendingWith "no GITHUB_TOKEN" Just token -> action (OAuth $ fromString token) spec :: Spec spec = do describe "userInfoFor" $ do it "decodes user json" $ do let userInfo = eitherDecodeStrict $(embedFile "fixtures/user.json") userLogin (fromRightS userInfo) `shouldBe` "mike-burns" it "decodes user-bot json" $ do let userInfo = eitherDecodeStrict $(embedFile "fixtures/user-bot.json") userLogin (fromRightS userInfo) `shouldBe` "mike-burns" it "returns information about the user" $ withAuth $ \auth -> do userInfo <- userInfoFor' (Just auth) "mike-burns" userLogin (fromRightS userInfo) `shouldBe` "mike-burns" it "catches http exceptions" $ withAuth $ \auth -> do userInfo <- userInfoFor' (Just auth) "i-hope-this-user-will-never-exist" userInfo `shouldSatisfy` isLeft it "should fail for organization" $ withAuth $ \auth -> do userInfo <- userInfoFor' (Just auth) "haskell" userInfo `shouldSatisfy` isLeft describe "ownerInfoFor" $ do it "works for users and organizations" $ withAuth $ \auth -> do a <- executeRequest auth $ ownerInfoForR "haskell" b <- executeRequest auth $ ownerInfoForR "phadej" a `shouldSatisfy` isRight b `shouldSatisfy` isRight (organizationLogin . fromRightS . fromOwner . fromRightS $ a) `shouldBe` "haskell" (userLogin . fromLeftS . fromOwner . fromRightS $ b) `shouldBe` "phadej" describe "userInfoCurrent'" $ do it "returns information about the autenticated user" $ withAuth $ \auth -> do userInfo <- userInfoCurrent' auth userInfo `shouldSatisfy` isRight describe "usersFollowing" $ do it "works" $ withAuth $ \auth -> do us <- executeRequest auth $ usersFollowingR "phadej" (GitHub.FetchAtLeast 10) us `shouldSatisfy` isRight describe "usersFollowedBy" $ do it "works" $ withAuth $ \auth -> do us <- executeRequest auth $ usersFollowedByR "phadej" (GitHub.FetchAtLeast 10) us `shouldSatisfy` isRight github-0.23/spec/0000755000000000000000000000000007346545000012043 5ustar0000000000000000github-0.23/spec/Spec.hs0000644000000000000000000000005407346545000013270 0ustar0000000000000000{-# OPTIONS_GHC -F -pgmF hspec-discover #-} github-0.23/src/0000755000000000000000000000000007346545000011700 5ustar0000000000000000github-0.23/src/GitHub.hs0000644000000000000000000002512207346545000013420 0ustar0000000000000000----------------------------------------------------------------------------- -- | -- License : BSD-3-Clause -- Maintainer : Oleg Grenrus -- -- This module re-exports all request constructrors and data definitions from -- this package. -- -- See "GitHub.Request" module for executing 'Request', or other modules -- of this package (e.g. "GitHub.Endpoints.Users") for already composed versions. -- -- The missing endpoints lists show which endpoints we know are missing, there -- might be more. module GitHub ( -- * Activity -- | See -- ** Events -- | See repositoryEventsR, userEventsR, -- ** Notifications -- | See getNotificationsR, markNotificationAsReadR, markAllNotificationsAsReadR, -- ** Starring -- | See -- -- Missing endpoints: -- -- * Check if you are starring a repository stargazersForR, reposStarredByR, myStarredR, myStarredAcceptStarR, starRepoR, unstarRepoR, -- ** Watching -- | See -- -- Missing endpoints: -- -- * Query a Repository Subscription -- * Set a Repository Subscription -- * Delete a Repository Subscription watchersForR, reposWatchedByR, -- * Gists -- | See -- -- Missing endpoints: -- -- * Query a specific revision of a gist -- * Create a gist -- * Edit a gist -- * List gist commits -- * Check if a gist is starred -- * Fork a gist -- * List gist forks gistsR, gistR, starGistR, unstarGistR, deleteGistR, -- ** Comments -- | See -- -- Missing endpoints: -- * Create a comment -- * Edit a comment -- * Delete a comment commentsOnR, gistCommentR, -- * Git Data -- | See -- ** Blobs -- | See blobR, -- ** Commits -- | See gitCommitR, -- ** References -- | See referenceR, referencesR, createReferenceR, -- ** Trees -- | See treeR, nestedTreeR, -- * Issues -- | See -- currentUserIssuesR, organizationIssuesR, issueR, issuesForRepoR, createIssueR, editIssueR, -- ** Comments -- | See -- commentR, commentsR, createCommentR, deleteCommentR, editCommentR, -- ** Events -- | See -- eventsForIssueR, eventsForRepoR, eventR, -- ** Labels -- | See -- labelsOnRepoR, labelR, createLabelR, updateLabelR, deleteLabelR, labelsOnIssueR, addLabelsToIssueR, removeLabelFromIssueR, replaceAllLabelsForIssueR, removeAllLabelsFromIssueR, labelsOnMilestoneR, -- ** Milestone -- | See -- milestonesR, milestoneR, createMilestone, createMilestoneR, updateMilestone, updateMilestoneR, deleteMilestone, deleteMilestoneR, -- * Organizations -- | See -- -- Missing endpoints: -- -- * List your organizations -- * List all organizations -- * Edit an organization publicOrganizationsForR, publicOrganizationR, organizationsR, -- ** Members -- | See -- -- Missing endpoints: All except /Members List/ and /Check Membership/ membersOfR, membersOfWithR, isMemberOfR, orgInvitationsR, -- ** Teams -- | See -- -- Missing endpoints: -- -- * Query team member (deprecated) -- * Add team member (deprecated) -- * Remove team member (deprecated) -- * Check if a team manages a repository -- * Add team repository -- * Remove team repository teamsOfR, teamInfoForR, createTeamForR, editTeamR, deleteTeamR, listTeamMembersR, listTeamReposR, teamMembershipInfoForR, addTeamMembershipForR, deleteTeamMembershipForR, listTeamsCurrentR, -- * Pull Requests -- | See pullRequestsForR, pullRequestR, pullRequestPatchR, pullRequestDiffR, createPullRequestR, updatePullRequestR, pullRequestCommitsR, pullRequestFilesR, isPullRequestMergedR, mergePullRequestR, -- ** Review comments -- | See -- -- Missing endpoints: -- -- * List comments in a repository -- * Edit a comment -- * Delete a comment pullRequestCommentsR, pullRequestCommentR, createPullCommentR, -- ** Pull request reviews -- | See -- -- Missing endpoints: -- -- * Delete a pending review -- * Create a pull request review -- * Submit a pull request review -- * Dismiss a pull request review pullRequestReviewsR, pullRequestReviews, pullRequestReviews', pullRequestReviewR, pullRequestReview, pullRequestReview', pullRequestReviewCommentsR, pullRequestReviewCommentsIO, pullRequestReviewCommentsIO', -- * Repositories -- | See -- -- Missing endpoints: -- -- * List all public repositories -- * List Teams -- * Query Branch -- * Enabling and disabling branch protection currentUserReposR, userReposR, organizationReposR, repositoryR, contributorsR, languagesForR, tagsForR, branchesForR, -- ** Collaborators -- | See collaboratorsOnR, isCollaboratorOnR, addCollaboratorR, -- ** Comments -- | See -- -- Missing endpoints: -- -- * Create a commit comment -- * Update a commit comment -- * Delete a commit comment commentsForR, commitCommentsForR, commitCommentForR, -- ** Commits -- | See commitsForR, commitsWithOptionsForR, commitR, diffR, -- ** Deployments -- | See -- -- Missing endpoints: -- * Get a single deployment -- * Update a deployment -- * Get a single deployment status deploymentsWithOptionsForR, createDeploymentR, deploymentStatusesForR, createDeploymentStatusR, -- ** Forks -- | See -- -- Missing endpoints: -- -- * Create a fork forksForR, -- ** Webhooks -- | See webhooksForR, webhookForR, createRepoWebhookR, editRepoWebhookR, testPushRepoWebhookR, pingRepoWebhookR, deleteRepoWebhookR, -- * Releases releasesR, releaseR, latestReleaseR, releaseByTagNameR, -- ** Invitations -- | See -- Missing endpoints: -- * Delete a repository invitation -- * Update a repository invitation -- * Decline a repository invitation listInvitationsOnR, acceptInvitationFromR, listInvitationsForR, -- * Search -- | See -- -- Missing endpoints: -- -- * Search users searchReposR, searchCodeR, searchIssuesR, -- * Users -- | See -- -- Missing endpoints: -- -- * Update the authenticated user -- * Query all users userInfoForR, ownerInfoForR, userInfoCurrentR, -- ** Emails -- | See -- -- Missing endpoints: -- -- * Add email address(es) -- * Delete email address(es) -- * Toggle primary email visibility currentUserEmailsR, currentUserPublicEmailsR, -- ** Followers -- | See -- -- Missing endpoints: -- -- * Check if you are following a user -- * Check if one user follows another -- * Follow a user -- * Unfollow a user usersFollowingR, usersFollowedByR, -- ** Statuses -- | See createStatusR, statusesForR, statusForR, -- ** Rate Limit -- | See rateLimitR, -- * Data definitions module GitHub.Data, -- * Request handling module GitHub.Request, ) where import GitHub.Data import GitHub.Endpoints.Activity.Events import GitHub.Endpoints.Activity.Notifications import GitHub.Endpoints.Activity.Starring import GitHub.Endpoints.Activity.Watching import GitHub.Endpoints.Gists import GitHub.Endpoints.Gists.Comments import GitHub.Endpoints.GitData.Blobs import GitHub.Endpoints.GitData.Commits import GitHub.Endpoints.GitData.References import GitHub.Endpoints.GitData.Trees import GitHub.Endpoints.Issues import GitHub.Endpoints.Issues.Comments import GitHub.Endpoints.Issues.Events import GitHub.Endpoints.Issues.Labels import GitHub.Endpoints.Issues.Milestones import GitHub.Endpoints.Organizations import GitHub.Endpoints.Organizations.Members import GitHub.Endpoints.Organizations.Teams import GitHub.Endpoints.PullRequests import GitHub.Endpoints.PullRequests.Comments import GitHub.Endpoints.PullRequests.Reviews import GitHub.Endpoints.RateLimit import GitHub.Endpoints.Repos import GitHub.Endpoints.Repos.Collaborators import GitHub.Endpoints.Repos.Comments import GitHub.Endpoints.Repos.Commits import GitHub.Endpoints.Repos.Deployments import GitHub.Endpoints.Repos.Forks import GitHub.Endpoints.Repos.Invitations import GitHub.Endpoints.Repos.Releases import GitHub.Endpoints.Repos.Statuses import GitHub.Endpoints.Repos.Webhooks import GitHub.Endpoints.Search import GitHub.Endpoints.Users import GitHub.Endpoints.Users.Emails import GitHub.Endpoints.Users.Followers import GitHub.Request github-0.23/src/GitHub/0000755000000000000000000000000007346545000013062 5ustar0000000000000000github-0.23/src/GitHub/Auth.hs0000644000000000000000000000321707346545000014322 0ustar0000000000000000----------------------------------------------------------------------------- -- | -- License : BSD-3-Clause -- Maintainer : Oleg Grenrus -- module GitHub.Auth ( Auth (..), AuthMethod, endpoint, setAuthRequest ) where import GitHub.Internal.Prelude import Prelude () import qualified Data.ByteString as BS import qualified Network.HTTP.Client as HTTP type Token = BS.ByteString -- | The Github auth data type data Auth = BasicAuth BS.ByteString BS.ByteString -- ^ Username and password | OAuth Token -- ^ OAuth token | EnterpriseOAuth Text Token -- ^ Custom endpoint and OAuth token deriving (Show, Data, Typeable, Eq, Ord, Generic) instance NFData Auth where rnf = genericRnf instance Binary Auth instance Hashable Auth -- | A type class for different authentication methods class AuthMethod a where -- | Custom API endpoint without trailing slash endpoint :: a -> Maybe Text -- | A function which sets authorisation on an HTTP request setAuthRequest :: a -> HTTP.Request -> HTTP.Request instance AuthMethod Auth where endpoint (BasicAuth _ _) = Nothing endpoint (OAuth _) = Nothing endpoint (EnterpriseOAuth e _) = Just e setAuthRequest (BasicAuth u p) = HTTP.applyBasicAuth u p setAuthRequest (OAuth t) = setAuthHeader $ "token " <> t setAuthRequest (EnterpriseOAuth _ t) = setAuthHeader $ "token " <> t setAuthHeader :: BS.ByteString -> HTTP.Request -> HTTP.Request setAuthHeader auth req = req { HTTP.requestHeaders = ("Authorization", auth) : HTTP.requestHeaders req } github-0.23/src/GitHub/Data.hs0000644000000000000000000000641407346545000014274 0ustar0000000000000000{-# LANGUAGE CPP #-} ----------------------------------------------------------------------------- -- | -- License : BSD-3-Clause -- Maintainer : Oleg Grenrus -- -- This module re-exports the @GitHub.Data.@ and "GitHub.Auth" submodules. module GitHub.Data ( -- * Tagged types -- ** Name Name, mkName, untagName, mkOwnerName, mkUserName, mkTeamName, mkOrganizationName, mkRepoName, mkCommitName, fromUserName, fromOrganizationName, -- ** Id Id, mkId, untagId, mkOwnerId, mkUserId, mkTeamId, mkOrganizationId, mkRepoId, fromUserId, fromOrganizationId, -- * IssueNumber IssueNumber (..), -- * Module re-exports module GitHub.Auth, module GitHub.Data.Activities, module GitHub.Data.Comments, module GitHub.Data.Content, module GitHub.Data.Definitions, module GitHub.Data.DeployKeys, module GitHub.Data.Deployments, module GitHub.Data.Email, module GitHub.Data.Events, module GitHub.Data.Gists, module GitHub.Data.GitData, module GitHub.Data.Invitation, module GitHub.Data.Issues, module GitHub.Data.Milestone, module GitHub.Data.Options, module GitHub.Data.PublicSSHKeys, module GitHub.Data.PullRequests, module GitHub.Data.RateLimit, module GitHub.Data.Releases, module GitHub.Data.Repos, module GitHub.Data.Request, module GitHub.Data.Reviews, module GitHub.Data.Search, module GitHub.Data.Statuses, module GitHub.Data.Teams, module GitHub.Data.URL, module GitHub.Data.Webhooks ) where import GitHub.Internal.Prelude import Prelude () import GitHub.Auth import GitHub.Data.Activities import GitHub.Data.Comments import GitHub.Data.Content import GitHub.Data.Definitions import GitHub.Data.DeployKeys import GitHub.Data.Deployments import GitHub.Data.Email import GitHub.Data.Events import GitHub.Data.Gists import GitHub.Data.GitData import GitHub.Data.Id import GitHub.Data.Invitation import GitHub.Data.Issues import GitHub.Data.Milestone import GitHub.Data.Name import GitHub.Data.Options import GitHub.Data.PublicSSHKeys import GitHub.Data.PullRequests import GitHub.Data.RateLimit import GitHub.Data.Releases import GitHub.Data.Repos import GitHub.Data.Request import GitHub.Data.Reviews import GitHub.Data.Search import GitHub.Data.Statuses import GitHub.Data.Teams import GitHub.Data.URL import GitHub.Data.Webhooks mkOwnerId :: Int -> Id Owner mkOwnerId = Id mkOwnerName :: Text -> Name Owner mkOwnerName = N mkUserId :: Int -> Id User mkUserId = Id mkUserName :: Text -> Name User mkUserName = N mkTeamId :: Int -> Id Team mkTeamId = Id mkTeamName :: Text -> Name Team mkTeamName = N mkOrganizationId :: Int -> Id Organization mkOrganizationId = Id mkOrganizationName :: Text -> Name Organization mkOrganizationName = N mkRepoId :: Int -> Id Repo mkRepoId = Id mkRepoName :: Text -> Name Repo mkRepoName = N mkCommitName :: Text -> Name Commit mkCommitName = N fromOrganizationName :: Name Organization -> Name Owner fromOrganizationName = N . untagName fromUserName :: Name User -> Name Owner fromUserName = N . untagName fromOrganizationId :: Id Organization -> Id Owner fromOrganizationId = Id . untagId fromUserId :: Id User -> Id Owner fromUserId = Id . untagId github-0.23/src/GitHub/Data/0000755000000000000000000000000007346545000013733 5ustar0000000000000000github-0.23/src/GitHub/Data/Activities.hs0000644000000000000000000000676107346545000016405 0ustar0000000000000000----------------------------------------------------------------------------- -- | -- License : BSD-3-Clause -- Maintainer : Oleg Grenrus -- module GitHub.Data.Activities where import GitHub.Data.Id (Id, mkId) import GitHub.Data.Repos (Repo, RepoRef) import GitHub.Data.URL (URL) import GitHub.Internal.Prelude import Prelude () import qualified Data.Text as T data RepoStarred = RepoStarred { repoStarredStarredAt :: !UTCTime , repoStarredRepo :: !Repo } deriving (Show, Data, Typeable, Eq, Ord, Generic) instance NFData RepoStarred where rnf = genericRnf instance Binary RepoStarred -- JSON Instances instance FromJSON RepoStarred where parseJSON = withObject "RepoStarred" $ \o -> RepoStarred <$> o .: "starred_at" <*> o .: "repo" data Subject = Subject { subjectTitle :: !Text , subjectURL :: !URL , subjectLatestCommentURL :: !(Maybe URL) -- https://developer.github.com/v3/activity/notifications/ doesn't indicate -- what the possible values for this field are. -- TODO: Make an ADT for this. , subjectType :: !Text } deriving (Show, Data, Typeable, Eq, Ord, Generic) instance NFData Subject where rnf = genericRnf instance Binary Subject instance FromJSON Subject where parseJSON = withObject "Subject" $ \o -> Subject <$> o .: "title" <*> o .: "url" <*> o .:? "latest_comment_url" <*> o .: "type" data NotificationReason = AssignReason | AuthorReason | CommentReason | InvitationReason | ManualReason | MentionReason | ReviewRequestedReason | StateChangeReason | SubscribedReason | TeamMentionReason deriving (Show, Data, Enum, Bounded, Typeable, Eq, Ord, Generic) instance NFData NotificationReason where rnf = genericRnf instance Binary NotificationReason instance FromJSON NotificationReason where parseJSON = withText "NotificationReason" $ \t -> case T.toLower t of "assign" -> pure AssignReason "author" -> pure AuthorReason "comment" -> pure CommentReason "invitation" -> pure InvitationReason "manual" -> pure ManualReason "mention" -> pure MentionReason "review_requested" -> pure ReviewRequestedReason "state_change" -> pure StateChangeReason "subscribed" -> pure SubscribedReason "team_mention" -> pure TeamMentionReason _ -> fail $ "Unknown NotificationReason " ++ show t data Notification = Notification -- XXX: The notification id field type IS in fact string. Not sure why gh -- chose to do this when all the other ids are Numbers... { notificationId :: !(Id Notification) , notificationRepo :: !RepoRef , notificationSubject :: !Subject , notificationReason :: !NotificationReason , notificationUnread :: !Bool , notificationUpdatedAt :: !(Maybe UTCTime) , notificationLastReadAt :: !(Maybe UTCTime) , notificationUrl :: !URL } deriving (Show, Data, Typeable, Eq, Ord, Generic) instance NFData Notification where rnf = genericRnf instance Binary Notification instance FromJSON Notification where parseJSON = withObject "Notification" $ \o -> Notification <$> (mkId undefined . read <$> o .: "id") <*> o .: "repository" <*> o .: "subject" <*> o .: "reason" <*> o .: "unread" <*> o .: "updated_at" <*> o .: "last_read_at" <*> o .: "url" github-0.23/src/GitHub/Data/Comments.hs0000644000000000000000000000460307346545000016057 0ustar0000000000000000----------------------------------------------------------------------------- -- | -- License : BSD-3-Clause -- Maintainer : Oleg Grenrus -- module GitHub.Data.Comments where import GitHub.Data.Definitions import GitHub.Data.Id (Id) import GitHub.Data.URL (URL) import GitHub.Internal.Prelude import Prelude () data Comment = Comment { commentPosition :: !(Maybe Int) , commentLine :: !(Maybe Int) , commentBody :: !Text , commentCommitId :: !(Maybe Text) , commentUpdatedAt :: !UTCTime , commentHtmlUrl :: !(Maybe URL) , commentUrl :: !URL , commentCreatedAt :: !(Maybe UTCTime) , commentPath :: !(Maybe Text) , commentUser :: !SimpleUser , commentId :: !(Id Comment) } deriving (Show, Data, Typeable, Eq, Ord, Generic) instance NFData Comment where rnf = genericRnf instance Binary Comment instance FromJSON Comment where parseJSON = withObject "Comment" $ \o -> Comment <$> o .:? "position" <*> o .:? "line" <*> o .: "body" <*> o .:? "commit_id" <*> o .: "updated_at" <*> o .:? "html_url" <*> o .: "url" <*> o .: "created_at" <*> o .:? "path" <*> o .: "user" <*> o .: "id" data NewComment = NewComment { newCommentBody :: !Text } deriving (Show, Data, Typeable, Eq, Ord, Generic) instance NFData NewComment where rnf = genericRnf instance Binary NewComment instance ToJSON NewComment where toJSON (NewComment b) = object [ "body" .= b ] data EditComment = EditComment { editCommentBody :: !Text } deriving (Show, Data, Typeable, Eq, Ord, Generic) instance NFData EditComment where rnf = genericRnf 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 ] github-0.23/src/GitHub/Data/Content.hs0000644000000000000000000001450307346545000015704 0ustar0000000000000000{-# LANGUAGE RecordWildCards #-} ----------------------------------------------------------------------------- -- | -- License : BSD-3-Clause -- Maintainer : Oleg Grenrus -- module GitHub.Data.Content where import GitHub.Data.GitData import GitHub.Data.URL import GitHub.Internal.Prelude import Prelude () import Data.Aeson.Types (Pair) import Data.Maybe (maybe) import qualified Data.Text as T data Content = ContentFile !ContentFileData | ContentDirectory !(Vector ContentItem) deriving (Show, Data, Typeable, Eq, Ord, Generic) instance NFData Content where rnf = genericRnf instance Binary Content data ContentFileData = ContentFileData { contentFileInfo :: !ContentInfo ,contentFileEncoding :: !Text ,contentFileSize :: !Int ,contentFileContent :: !Text } deriving (Show, Data, Typeable, Eq, Ord, Generic) instance NFData ContentFileData where rnf = genericRnf instance Binary ContentFileData -- | An item in a directory listing. data ContentItem = ContentItem { contentItemType :: !ContentItemType ,contentItemInfo :: !ContentInfo } deriving (Show, Data, Typeable, Eq, Ord, Generic) instance NFData ContentItem where rnf = genericRnf instance Binary ContentItem data ContentItemType = ItemFile | ItemDir deriving (Show, Data, Typeable, Eq, Ord, Generic) instance NFData ContentItemType where rnf = genericRnf instance Binary ContentItemType -- | Information common to both kinds of Content: files and directories. data ContentInfo = ContentInfo { contentName :: !Text ,contentPath :: !Text ,contentSha :: !Text ,contentUrl :: !URL ,contentGitUrl :: !URL ,contentHtmlUrl :: !URL } deriving (Show, Data, Typeable, Eq, Ord, Generic) instance NFData ContentInfo where rnf = genericRnf instance Binary ContentInfo data ContentResultInfo = ContentResultInfo { contentResultInfo :: !ContentInfo , contentResultSize :: !Int } deriving (Show, Data, Typeable, Eq, Ord, Generic) instance NFData ContentResultInfo where rnf = genericRnf instance Binary ContentResultInfo data ContentResult = ContentResult { contentResultContent :: !ContentResultInfo , contentResultCommit :: !GitCommit } deriving (Show, Data, Typeable, Eq, Ord, Generic) instance NFData ContentResult where rnf = genericRnf instance Binary ContentResult data Author = Author { authorName :: !Text , authorEmail :: !Text } deriving (Eq, Ord, Show, Data, Typeable, Generic) instance NFData Author where rnf = genericRnf instance Binary Author data CreateFile = CreateFile { createFilePath :: !Text , createFileMessage :: !Text , createFileContent :: !Text , createFileBranch :: !(Maybe Text) , createFileAuthor :: !(Maybe Author) , createFileCommitter :: !(Maybe Author) } deriving (Eq, Ord, Show, Data, Typeable, Generic) instance NFData CreateFile where rnf = genericRnf instance Binary CreateFile data UpdateFile = UpdateFile { updateFilePath :: !Text , updateFileMessage :: !Text , updateFileContent :: !Text , updateFileSHA :: !Text , updateFileBranch :: !(Maybe Text) , updateFileAuthor :: !(Maybe Author) , updateFileCommitter :: !(Maybe Author) } deriving (Eq, Ord, Show, Data, Typeable, Generic) instance NFData UpdateFile where rnf = genericRnf instance Binary UpdateFile data DeleteFile = DeleteFile { deleteFilePath :: !Text , deleteFileMessage :: !Text , deleteFileSHA :: !Text , deleteFileBranch :: !(Maybe Text) , deleteFileAuthor :: !(Maybe Author) , deleteFileCommitter :: !(Maybe Author) } deriving (Eq, Ord, Show, Data, Typeable, Generic) instance NFData DeleteFile where rnf = genericRnf instance Binary DeleteFile instance FromJSON Content where parseJSON o@(Object _) = ContentFile <$> parseJSON o parseJSON (Array os) = ContentDirectory <$> traverse parseJSON os parseJSON _ = fail "Could not build a Content" instance FromJSON ContentFileData where parseJSON = withObject "ContentFileData" $ \o -> ContentFileData <$> parseJSON (Object o) <*> o .: "encoding" <*> o .: "size" <*> o .: "content" instance FromJSON ContentItem where parseJSON = withObject "ContentItem" $ \o -> ContentItem <$> o .: "type" <*> parseJSON (Object o) instance FromJSON ContentItemType where parseJSON = withText "ContentItemType" $ \t -> case T.toLower t of "file" -> pure ItemFile "dir" -> pure ItemDir _ -> fail $ "Unknown ContentItemType: " <> T.unpack t instance FromJSON ContentInfo where parseJSON = withObject "ContentInfo" $ \o -> ContentInfo <$> o .: "name" <*> o .: "path" <*> o .: "sha" <*> o .: "url" <*> o .: "git_url" <*> o .: "html_url" instance FromJSON ContentResultInfo where parseJSON = withObject "ContentResultInfo" $ \o -> ContentResultInfo <$> parseJSON (Object o) <*> o .: "size" instance FromJSON ContentResult where parseJSON = withObject "ContentResult" $ \o -> ContentResult <$> o .: "content" <*> o .: "commit" instance ToJSON Author where toJSON Author {..} = object [ "name" .= authorName , "email" .= authorEmail ] instance ToJSON CreateFile where toJSON CreateFile {..} = object $ [ "path" .= createFilePath , "message" .= createFileMessage , "content" .= createFileContent ] ++ "branch" .=? createFileBranch ++ "author" .=? createFileAuthor ++ "committer" .=? createFileCommitter instance ToJSON UpdateFile where toJSON UpdateFile {..} = object $ [ "path" .= updateFilePath , "message" .= updateFileMessage , "content" .= updateFileContent , "sha" .= updateFileSHA ] ++ "branch" .=? updateFileBranch ++ "author" .=? updateFileAuthor ++ "committer" .=? updateFileCommitter instance ToJSON DeleteFile where toJSON DeleteFile {..} = object $ [ "path" .= deleteFilePath , "message" .= deleteFileMessage , "sha" .= deleteFileSHA ] ++ "branch" .=? deleteFileBranch ++ "author" .=? deleteFileAuthor ++ "committer" .=? deleteFileCommitter (.=?) :: ToJSON v => Text -> Maybe v -> [Pair] name .=? value = maybe [] (pure . (name .=)) value github-0.23/src/GitHub/Data/Definitions.hs0000644000000000000000000002165707346545000016555 0ustar0000000000000000----------------------------------------------------------------------------- -- | -- License : BSD-3-Clause -- Maintainer : Oleg Grenrus -- module GitHub.Data.Definitions where import GitHub.Internal.Prelude import Prelude () import Control.Monad (mfilter) import Data.Aeson.Types (Parser) import Network.HTTP.Client (HttpException) import qualified Control.Exception as E import qualified Data.ByteString as BS import qualified Data.Text as T import GitHub.Data.Id (Id) import GitHub.Data.Name (Name) import GitHub.Data.URL (URL (..)) -- | Errors have been tagged according to their source, so you can more easily -- dispatch and handle them. data Error = HTTPError !HttpException -- ^ A HTTP error occurred. The actual caught error is included. | ParseError !Text -- ^ An error in the parser itself. | JsonError !Text -- ^ The JSON is malformed or unexpected. | UserError !Text -- ^ Incorrect input. deriving (Show, Typeable) instance E.Exception Error -- | Type of the repository owners. data OwnerType = OwnerUser | OwnerOrganization | OwnerBot deriving (Eq, Ord, Enum, Bounded, Show, Read, Generic, Typeable, Data) instance NFData OwnerType instance Binary OwnerType data SimpleUser = SimpleUser { simpleUserId :: !(Id User) , simpleUserLogin :: !(Name User) , simpleUserAvatarUrl :: !URL , simpleUserUrl :: !URL } deriving (Show, Data, Typeable, Eq, Ord, Generic) instance NFData SimpleUser where rnf = genericRnf instance Binary SimpleUser data SimpleOrganization = SimpleOrganization { simpleOrganizationId :: !(Id Organization) , simpleOrganizationLogin :: !(Name Organization) , simpleOrganizationUrl :: !URL , simpleOrganizationAvatarUrl :: !URL } deriving (Show, Data, Typeable, Eq, Ord, Generic) instance NFData SimpleOrganization where rnf = genericRnf instance Binary SimpleOrganization -- | Sometimes we don't know the type of the owner, e.g. in 'Repo' data SimpleOwner = SimpleOwner { simpleOwnerId :: !(Id Owner) , simpleOwnerLogin :: !(Name Owner) , simpleOwnerUrl :: !URL , simpleOwnerAvatarUrl :: !URL , simpleOwnerType :: !OwnerType } deriving (Show, Data, Typeable, Eq, Ord, Generic) instance NFData SimpleOwner where rnf = genericRnf instance Binary SimpleOwner data User = User { userId :: !(Id User) , userLogin :: !(Name User) , userName :: !(Maybe Text) , userType :: !OwnerType -- ^ Should always be 'OwnerUser' or 'OwnerBot' , userCreatedAt :: !UTCTime , userPublicGists :: !Int , userAvatarUrl :: !URL , userFollowers :: !Int , userFollowing :: !Int , userHireable :: !(Maybe Bool) , userBlog :: !(Maybe Text) , userBio :: !(Maybe Text) , userPublicRepos :: !Int , userLocation :: !(Maybe Text) , userCompany :: !(Maybe Text) , userEmail :: !(Maybe Text) , userUrl :: !URL , userHtmlUrl :: !URL } deriving (Show, Data, Typeable, Eq, Ord, Generic) instance NFData User where rnf = genericRnf instance Binary User data Organization = Organization { organizationId :: !(Id Organization) , organizationLogin :: !(Name Organization) , organizationName :: !(Maybe Text) , organizationType :: !OwnerType -- ^ Should always be 'OwnerOrganization' , organizationBlog :: !(Maybe Text) , organizationLocation :: !(Maybe Text) , organizationFollowers :: !Int , organizationCompany :: !(Maybe Text) , organizationAvatarUrl :: !URL , organizationPublicGists :: !Int , organizationHtmlUrl :: !URL , organizationEmail :: !(Maybe Text) , organizationFollowing :: !Int , organizationPublicRepos :: !Int , organizationUrl :: !URL , organizationCreatedAt :: !UTCTime } deriving (Show, Data, Typeable, Eq, Ord, Generic) instance NFData Organization where rnf = genericRnf instance Binary Organization -- | In practic, you cam't have concrete values of 'Owner'. newtype Owner = Owner (Either User Organization) deriving (Show, Data, Typeable, Eq, Ord, Generic) instance NFData Owner where rnf = genericRnf instance Binary Owner fromOwner :: Owner -> Either User Organization fromOwner (Owner owner) = owner -- JSON instances instance FromJSON OwnerType where parseJSON = withText "OwnerType" $ \t -> case T.toLower t of "user" -> pure $ OwnerUser "organization" -> pure $ OwnerOrganization "bot" -> pure $ OwnerBot _ -> fail $ "Unknown OwnerType: " <> T.unpack t instance FromJSON SimpleUser where parseJSON = withObject "SimpleUser" $ \obj -> do SimpleUser <$> obj .: "id" <*> obj .: "login" <*> obj .: "avatar_url" <*> obj .: "url" instance FromJSON SimpleOrganization where parseJSON = withObject "SimpleOrganization" $ \obj -> SimpleOrganization <$> obj .: "id" <*> obj .: "login" <*> obj .: "url" <*> obj .: "avatar_url" instance FromJSON SimpleOwner where parseJSON = withObject "SimpleOwner" $ \obj -> do SimpleOwner <$> obj .: "id" <*> obj .: "login" <*> obj .: "url" <*> obj .: "avatar_url" <*> obj .: "type" parseUser :: Object -> Parser User parseUser obj = User <$> obj .: "id" <*> obj .: "login" <*> obj .:? "name" <*> obj .: "type" <*> obj .: "created_at" <*> obj .: "public_gists" <*> obj .: "avatar_url" <*> obj .: "followers" <*> obj .: "following" <*> obj .:? "hireable" <*> obj .:? "blog" <*> obj .:? "bio" <*> obj .: "public_repos" <*> obj .:? "location" <*> obj .:? "company" <*> obj .:? "email" <*> obj .: "url" <*> obj .: "html_url" parseOrganization :: Object -> Parser Organization parseOrganization obj = Organization <$> obj .: "id" <*> obj .: "login" <*> obj .:? "name" <*> obj .: "type" <*> obj .:? "blog" <*> obj .:? "location" <*> obj .: "followers" <*> obj .:? "company" <*> obj .: "avatar_url" <*> obj .: "public_gists" <*> obj .: "html_url" <*> obj .:? "email" <*> obj .: "following" <*> obj .: "public_repos" <*> obj .: "url" <*> obj .: "created_at" instance FromJSON User where parseJSON = mfilter ((/= OwnerOrganization) . userType) . withObject "User" parseUser instance FromJSON Organization where parseJSON = withObject "Organization" parseOrganization instance FromJSON Owner where parseJSON = withObject "Owner" $ \obj -> do t <- obj .: "type" case t of OwnerUser -> Owner . Left <$> parseUser obj OwnerBot -> Owner . Left <$> parseUser obj OwnerOrganization -> Owner . Right <$> parseOrganization obj -- | Filter members returned in the list. data OrgMemberFilter = OrgMemberFilter2faDisabled -- ^ Members without two-factor authentication enabled. Available for organization owners. | OrgMemberFilterAll -- ^ All members the authenticated user can see. deriving (Show, Eq, Ord, Enum, Bounded, Typeable, Data, Generic) -- | Filter members returned by their role. data OrgMemberRole = OrgMemberRoleAll -- ^ All members of the organization, regardless of role. | OrgMemberRoleAdmin -- ^ Organization owners. | OrgMemberRoleMember -- ^ Non-owner organization members. deriving (Show, Eq, Ord, Enum, Bounded, Typeable, Data, Generic) -- | Request query string type QueryString = [(BS.ByteString, Maybe BS.ByteString)] -- | Count of elements type Count = Int ------------------------------------------------------------------------------- -- IssueNumber ------------------------------------------------------------------------------- newtype IssueNumber = IssueNumber Int deriving (Eq, Ord, Show, Generic, Typeable, Data) unIssueNumber :: IssueNumber -> Int unIssueNumber (IssueNumber i) = i instance Hashable IssueNumber instance Binary IssueNumber instance NFData IssueNumber where rnf (IssueNumber s) = rnf s instance FromJSON IssueNumber where parseJSON = fmap IssueNumber . parseJSON instance ToJSON IssueNumber where toJSON = toJSON . unIssueNumber ------------------------------------------------------------------------------- -- IssueLabel ------------------------------------------------------------------------------- data IssueLabel = IssueLabel { labelColor :: !Text , labelUrl :: !URL , labelName :: !(Name IssueLabel) } deriving (Show, Data, Typeable, Eq, Ord, Generic) instance NFData IssueLabel where rnf = genericRnf instance Binary IssueLabel instance FromJSON IssueLabel where parseJSON = withObject "IssueLabel" $ \o -> IssueLabel <$> o .: "color" <*> o .:? "url" .!= URL "" -- in events there aren't URL <*> o .: "name" github-0.23/src/GitHub/Data/DeployKeys.hs0000644000000000000000000000306407346545000016362 0ustar0000000000000000----------------------------------------------------------------------------- -- | -- License : BSD-3-Clause -- Maintainer : Todd Mohney -- module GitHub.Data.DeployKeys where import GitHub.Data.Id (Id) import GitHub.Data.URL (URL) import GitHub.Internal.Prelude import Prelude () data RepoDeployKey = RepoDeployKey { repoDeployKeyId :: !(Id RepoDeployKey) , repoDeployKeyKey :: !Text , repoDeployKeyUrl :: !URL , repoDeployKeyTitle :: !Text , repoDeployKeyVerified :: !Bool , repoDeployKeyCreatedAt :: !UTCTime , repoDeployKeyReadOnly :: !Bool } deriving (Show, Data, Typeable, Eq, Ord, Generic) instance FromJSON RepoDeployKey where parseJSON = withObject "RepoDeployKey" $ \o -> RepoDeployKey <$> o .: "id" <*> o .: "key" <*> o .: "url" <*> o .: "title" <*> o .: "verified" <*> o .: "created_at" <*> o .: "read_only" data NewRepoDeployKey = NewRepoDeployKey { newRepoDeployKeyKey :: !Text , newRepoDeployKeyTitle :: !Text , newRepoDeployKeyReadOnly :: !Bool } deriving (Show, Data, Typeable, Eq, Ord, Generic) instance ToJSON NewRepoDeployKey where toJSON (NewRepoDeployKey key title readOnly) = object [ "key" .= key , "title" .= title , "read_only" .= readOnly ] instance FromJSON NewRepoDeployKey where parseJSON = withObject "RepoDeployKey" $ \o -> NewRepoDeployKey <$> o .: "key" <*> o .: "title" <*> o .: "read_only" github-0.23/src/GitHub/Data/Deployments.hs0000644000000000000000000002014707346545000016576 0ustar0000000000000000{-# LANGUAGE LambdaCase #-} module GitHub.Data.Deployments ( DeploymentQueryOption (..) , renderDeploymentQueryOption , Deployment (..) , CreateDeployment (..) , DeploymentStatus (..) , DeploymentStatusState (..) , CreateDeploymentStatus (..) ) where import GitHub.Internal.Prelude import Prelude () import Control.Arrow (second) import Data.ByteString (ByteString) import Data.Maybe (catMaybes) import Data.Text (Text) import Data.Time.Clock (UTCTime) import Data.Vector (Vector) import GitHub.Data.Definitions (SimpleUser) import GitHub.Data.Id (Id) import GitHub.Data.Name (Name) import GitHub.Data.URL (URL) import qualified Data.Aeson as JSON import qualified Data.Text as T import qualified Data.Text.Encoding as T data DeploymentQueryOption = DeploymentQuerySha !Text | DeploymentQueryRef !Text | DeploymentQueryTask !Text | DeploymentQueryEnvironment !Text deriving (Show, Data, Typeable, Eq, Ord, Generic) instance NFData DeploymentQueryOption where rnf = genericRnf instance Binary DeploymentQueryOption renderDeploymentQueryOption :: DeploymentQueryOption -> (ByteString, ByteString) renderDeploymentQueryOption = second T.encodeUtf8 . \case DeploymentQuerySha sha -> ("sha", sha) DeploymentQueryRef ref -> ("ref", ref) DeploymentQueryTask task -> ("task", task) DeploymentQueryEnvironment env -> ("environment", env) data Deployment a = Deployment { deploymentUrl :: !URL , deploymentId :: !(Id (Deployment a)) , deploymentSha :: !(Name (Deployment a)) , deploymentRef :: !Text , deploymentTask :: !Text , deploymentPayload :: !(Maybe a) , deploymentEnvironment :: !Text , deploymentDescription :: !Text , deploymentCreator :: !SimpleUser , deploymentCreatedAt :: !UTCTime , deploymentUpdatedAt :: !UTCTime , deploymentStatusesUrl :: !URL , deploymentRepositoryUrl :: !URL } deriving (Show, Data, Typeable, Eq, Ord, Generic) instance NFData a => NFData (Deployment a) where rnf = genericRnf instance Binary a => Binary (Deployment a) instance FromJSON a => FromJSON (Deployment a) where parseJSON = withObject "GitHub Deployment" $ \o -> Deployment <$> o .: "url" <*> o .: "id" <*> o .: "sha" <*> o .: "ref" <*> o .: "task" <*> o .:? "payload" <*> o .: "environment" <*> o .: "description" <*> o .: "creator" <*> o .: "created_at" <*> o .: "updated_at" <*> o .: "statuses_url" <*> o .: "repository_url" data CreateDeployment a = CreateDeployment { createDeploymentRef :: !Text -- ^ Required. The ref to deploy. This can be a branch, tag, or SHA. , createDeploymentTask :: !(Maybe Text) -- ^ Specifies a task to execute (e.g., deploy or deploy:migrations). -- Default: deploy , createDeploymentAutoMerge :: !(Maybe Bool) -- ^ Attempts to automatically merge the default branch into the requested -- ref, if it is behind the default branch. Default: true , createDeploymentRequiredContexts :: !(Maybe (Vector Text)) -- ^ The status contexts to verify against commit status checks. If this -- parameter is omitted, then all unique contexts will be verified before a -- deployment is created. To bypass checking entirely pass an empty array. -- Defaults to all unique contexts. , createDeploymentPayload :: !(Maybe a) -- ^ JSON payload with extra information about the deployment. Default: "" , createDeploymentEnvironment :: !(Maybe Text) -- ^ Name for the target deployment environment (e.g., production, staging, -- qa). Default: production , createDeploymentDescription :: !(Maybe Text) -- ^ Short description of the deployment. Default: "" } deriving (Show, Data, Typeable, Eq, Ord, Generic) instance NFData a => NFData (CreateDeployment a) where rnf = genericRnf instance Binary a => Binary (CreateDeployment a) instance ToJSON a => ToJSON (CreateDeployment a) where toJSON x = JSON.object $ catMaybes [ Just ("ref" .= createDeploymentRef x) , ("task" .=) <$> createDeploymentTask x , ("auto_merge" .=) <$> createDeploymentAutoMerge x , ("required_contexts" .=) <$> createDeploymentRequiredContexts x , ("payload" .=) <$> createDeploymentPayload x , ("environment" .=) <$> createDeploymentEnvironment x , ("description" .=) <$> createDeploymentDescription x ] data DeploymentStatus = DeploymentStatus { deploymentStatusUrl :: !URL , deploymentStatusId :: !(Id DeploymentStatus) , deploymentStatusState :: !DeploymentStatusState , deploymentStatusCreator :: !SimpleUser , deploymentStatusDescription :: !Text , deploymentStatusTargetUrl :: !URL , deploymentStatusCreatedAt :: !UTCTime , deploymentStatusUpdatedAt :: !UTCTime , deploymentStatusDeploymentUrl :: !URL , deploymentStatusRepositoryUrl :: !URL } deriving (Show, Data, Typeable, Eq, Ord, Generic) instance NFData DeploymentStatus where rnf = genericRnf instance Binary DeploymentStatus instance FromJSON DeploymentStatus where parseJSON = withObject "GitHub DeploymentStatus" $ \o -> DeploymentStatus <$> o .: "url" <*> o .: "id" <*> o .: "state" <*> o .: "creator" <*> o .: "description" <*> o .: "target_url" <*> o .: "created_at" <*> o .: "updated_at" <*> o .: "deployment_url" <*> o .: "repository_url" data DeploymentStatusState = DeploymentStatusError | DeploymentStatusFailure | DeploymentStatusPending | DeploymentStatusSuccess | DeploymentStatusInactive deriving (Show, Data, Typeable, Eq, Ord, Generic) instance NFData DeploymentStatusState where rnf = genericRnf instance Binary DeploymentStatusState instance ToJSON DeploymentStatusState where toJSON = \case DeploymentStatusError -> "error" DeploymentStatusFailure -> "failure" DeploymentStatusPending -> "pending" DeploymentStatusSuccess -> "success" DeploymentStatusInactive -> "inactive" instance FromJSON DeploymentStatusState where parseJSON = withText "DeploymentStatusState" $ \t -> case T.toLower t of "error" -> pure DeploymentStatusError "failure" -> pure DeploymentStatusFailure "pending" -> pure DeploymentStatusPending "success" -> pure DeploymentStatusSuccess "inactive" -> pure DeploymentStatusInactive _ -> fail $ "Unknown DeploymentStatusState: " <> T.unpack t data CreateDeploymentStatus = CreateDeploymentStatus { createDeploymentStatusState :: !DeploymentStatusState -- ^ Required. The state of the status. Can be one of error, failure, -- pending, or success. , createDeploymentStatusTargetUrl :: !(Maybe Text) -- TODO: should this be URL? -- ^ The target URL to associate with this status. This URL should contain -- output to keep the user updated while the task is running or serve as -- historical information for what happened in the deployment. Default: "" , createDeploymentStatusDescription :: !(Maybe Text) -- ^ A short description of the status. Maximum length of 140 characters. -- Default: "" } deriving (Show, Data, Typeable, Eq, Ord, Generic) instance NFData CreateDeploymentStatus where rnf = genericRnf instance Binary CreateDeploymentStatus instance ToJSON CreateDeploymentStatus where toJSON x = JSON.object $ catMaybes [ Just ("state" .= createDeploymentStatusState x) , ("target_url" .=) <$> createDeploymentStatusTargetUrl x , ("description" .=) <$> createDeploymentStatusDescription x ] github-0.23/src/GitHub/Data/Email.hs0000644000000000000000000000240007346545000015312 0ustar0000000000000000----------------------------------------------------------------------------- -- | -- License : BSD-3-Clause -- Maintainer : Oleg Grenrus -- module GitHub.Data.Email where import GitHub.Internal.Prelude import Prelude () import qualified Data.Text as T data EmailVisibility = EmailVisibilityPrivate | EmailVisibilityPublic deriving (Show, Data, Enum, Bounded, Typeable, Eq, Ord, Generic) instance NFData EmailVisibility where rnf = genericRnf instance Binary EmailVisibility instance FromJSON EmailVisibility where parseJSON = withText "EmailVisibility" $ \t -> case T.toLower t of "private" -> pure EmailVisibilityPrivate "public" -> pure EmailVisibilityPublic _ -> fail $ "Unknown EmailVisibility: " <> T.unpack t data Email = Email { emailAddress :: !Text , emailVerified :: !Bool , emailPrimary :: !Bool , emailVisibility :: !(Maybe EmailVisibility) } deriving (Show, Data, Typeable, Eq, Ord, Generic) instance NFData Email where rnf = genericRnf instance Binary Email instance FromJSON Email where parseJSON = withObject "Email" $ \o -> Email <$> o .: "email" <*> o .: "verified" <*> o .: "primary" <*> o .:? "visibility" github-0.23/src/GitHub/Data/Events.hs0000644000000000000000000000154107346545000015534 0ustar0000000000000000----------------------------------------------------------------------------- -- | -- License : BSD-3-Clause -- Maintainer : Oleg Grenrus -- module GitHub.Data.Events where import GitHub.Data.Definitions import GitHub.Internal.Prelude import Prelude () -- | Events. -- -- /TODO:/ -- -- * missing repo, org, payload, id data Event = Event -- { eventId :: !(Id Event) -- id can be encoded as string. { eventActor :: !SimpleUser , eventCreatedAt :: !UTCTime , eventPublic :: !Bool } deriving (Show, Data, Typeable, Eq, Ord, Generic) instance NFData Event where rnf = genericRnf instance Binary Event instance FromJSON Event where parseJSON = withObject "Event" $ \obj -> Event -- <$> obj .: "id" <$> obj .: "actor" <*> obj .: "created_at" <*> obj .: "public" github-0.23/src/GitHub/Data/Gists.hs0000644000000000000000000000515107346545000015362 0ustar0000000000000000----------------------------------------------------------------------------- -- | -- License : BSD-3-Clause -- Maintainer : Oleg Grenrus -- module GitHub.Data.Gists where import GitHub.Data.Definitions import GitHub.Data.Id (Id) import GitHub.Data.Name (Name) import GitHub.Data.Repos (Language) import GitHub.Data.URL (URL) import GitHub.Internal.Prelude import Prelude () data Gist = Gist { gistUser :: !SimpleUser , gistGitPushUrl :: !URL , gistUrl :: !URL , gistDescription :: !(Maybe Text) , gistCreatedAt :: !UTCTime , gistPublic :: !Bool , gistComments :: !Int , gistUpdatedAt :: !UTCTime , gistHtmlUrl :: !URL , gistId :: !(Name Gist) , gistFiles :: !(HashMap Text GistFile) , gistGitPullUrl :: !URL } deriving (Show, Data, Typeable, Eq, Generic) instance NFData Gist where rnf = genericRnf instance Binary Gist instance FromJSON Gist where parseJSON = withObject "Gist" $ \o -> Gist <$> o .: "owner" <*> o .: "git_push_url" <*> o .: "url" <*> o .:? "description" <*> o .: "created_at" <*> o .: "public" <*> o .: "comments" <*> o .: "updated_at" <*> o .: "html_url" <*> o .: "id" <*> o .: "files" <*> o .: "git_push_url" data GistFile = GistFile { gistFileType :: !Text , gistFileRawUrl :: !URL , gistFileSize :: !Int , gistFileLanguage :: !(Maybe Language) , gistFileFilename :: !Text , gistFileContent :: !(Maybe Text) } deriving (Show, Data, Typeable, Eq, Generic) instance NFData GistFile where rnf = genericRnf instance Binary GistFile instance FromJSON GistFile where parseJSON = withObject "GistFile" $ \o -> GistFile <$> o .: "type" <*> o .: "raw_url" <*> o .: "size" <*> o .:? "language" <*> o .: "filename" <*> o .:? "content" data GistComment = GistComment { gistCommentUser :: !SimpleUser , gistCommentUrl :: !URL , gistCommentCreatedAt :: !UTCTime , gistCommentBody :: !Text , gistCommentUpdatedAt :: !UTCTime , gistCommentId :: !(Id GistComment) } deriving (Show, Data, Typeable, Eq, Ord, Generic) instance NFData GistComment where rnf = genericRnf instance Binary GistComment instance FromJSON GistComment where parseJSON = withObject "GistComment" $ \o -> GistComment <$> o .: "user" <*> o .: "url" <*> o .: "created_at" <*> o .: "body" <*> o .: "updated_at" <*> o .: "id" github-0.23/src/GitHub/Data/GitData.hs0000644000000000000000000002057407346545000015614 0ustar0000000000000000----------------------------------------------------------------------------- -- | -- License : BSD-3-Clause -- Maintainer : Oleg Grenrus -- module GitHub.Data.GitData where import GitHub.Data.Definitions import GitHub.Data.Name (Name) import GitHub.Data.URL (URL) import GitHub.Internal.Prelude import Prelude () import qualified Data.Vector as V -- | The options for querying commits. data CommitQueryOption = CommitQuerySha !Text | CommitQueryPath !Text | CommitQueryAuthor !Text | CommitQuerySince !UTCTime | CommitQueryUntil !UTCTime deriving (Show, Eq, Ord, Generic, Typeable, Data) data Stats = Stats { statsAdditions :: !Int , statsTotal :: !Int , statsDeletions :: !Int } deriving (Show, Data, Typeable, Eq, Ord, Generic) instance NFData Stats where rnf = genericRnf instance Binary Stats data Commit = Commit { commitSha :: !(Name Commit) , commitParents :: !(Vector Tree) , commitUrl :: !URL , commitGitCommit :: !GitCommit , commitCommitter :: !(Maybe SimpleUser) , commitAuthor :: !(Maybe SimpleUser) , commitFiles :: !(Vector File) , commitStats :: !(Maybe Stats) } deriving (Show, Data, Typeable, Eq, Ord, Generic) instance NFData Commit where rnf = genericRnf instance Binary Commit data Tree = Tree { treeSha :: !(Name Tree) , treeUrl :: !URL , treeGitTrees :: !(Vector GitTree) } deriving (Show, Data, Typeable, Eq, Ord, Generic) instance NFData Tree where rnf = genericRnf instance Binary Tree data GitTree = GitTree { gitTreeType :: !Text , gitTreeSha :: !(Name GitTree) -- Can be empty for submodule , gitTreeUrl :: !(Maybe URL) , gitTreeSize :: !(Maybe Int) , gitTreePath :: !Text , gitTreeMode :: !Text } deriving (Show, Data, Typeable, Eq, Ord, Generic) instance NFData GitTree where rnf = genericRnf instance Binary GitTree data GitCommit = GitCommit { gitCommitMessage :: !Text , gitCommitUrl :: !URL , gitCommitCommitter :: !GitUser , gitCommitAuthor :: !GitUser , gitCommitTree :: !Tree , gitCommitSha :: !(Maybe (Name GitCommit)) , gitCommitParents :: !(Vector Tree) } deriving (Show, Data, Typeable, Eq, Ord, Generic) instance NFData GitCommit where rnf = genericRnf instance Binary GitCommit data Blob = Blob { blobUrl :: !URL , blobEncoding :: !Text , blobContent :: !Text , blobSha :: !(Name Blob) , blobSize :: !Int } deriving (Show, Data, Typeable, Eq, Ord, Generic) instance NFData Blob where rnf = genericRnf instance Binary Blob data Tag = Tag { tagName :: !Text , tagZipballUrl :: !URL , tagTarballUrl :: !URL , tagCommit :: !BranchCommit } deriving (Show, Data, Typeable, Eq, Ord, Generic) instance NFData Tag where rnf = genericRnf instance Binary Tag data Branch = Branch { branchName :: !Text , branchCommit :: !BranchCommit } deriving (Show, Data, Typeable, Eq, Ord, Generic) instance NFData Branch where rnf = genericRnf data BranchCommit = BranchCommit { branchCommitSha :: !Text , branchCommitUrl :: !URL } deriving (Show, Data, Typeable, Eq, Ord, Generic) instance NFData BranchCommit where rnf = genericRnf instance Binary BranchCommit data Diff = Diff { diffStatus :: !Text , diffBehindBy :: !Int , diffPatchUrl :: !URL , diffUrl :: !URL , diffBaseCommit :: !Commit , diffCommits :: !(Vector Commit) , diffTotalCommits :: !Int , diffHtmlUrl :: !URL , diffFiles :: !(Vector File) , diffAheadBy :: !Int , diffDiffUrl :: !URL , diffPermalinkUrl :: !URL } deriving (Show, Data, Typeable, Eq, Ord, Generic) instance NFData Diff where rnf = genericRnf instance Binary Diff data NewGitReference = NewGitReference { newGitReferenceRef :: !Text , newGitReferenceSha :: !Text } deriving (Show, Data, Typeable, Eq, Ord, Generic) instance NFData NewGitReference where rnf = genericRnf instance Binary NewGitReference data GitReference = GitReference { gitReferenceObject :: !GitObject , gitReferenceUrl :: !URL , gitReferenceRef :: !Text } deriving (Show, Data, Typeable, Eq, Ord, Generic) instance NFData GitReference where rnf = genericRnf instance Binary GitReference data GitObject = GitObject { gitObjectType :: !Text , gitObjectSha :: !Text , gitObjectUrl :: !URL } deriving (Show, Data, Typeable, Eq, Ord, Generic) instance NFData GitObject where rnf = genericRnf instance Binary GitObject data GitUser = GitUser { gitUserName :: !Text , gitUserEmail :: !Text , gitUserDate :: !UTCTime } deriving (Show, Data, Typeable, Eq, Ord, Generic) instance NFData GitUser where rnf = genericRnf instance Binary GitUser data File = File { fileBlobUrl :: !(Maybe URL) , fileStatus :: !Text , fileRawUrl :: !(Maybe URL) , fileAdditions :: !Int , fileSha :: !(Maybe Text) , fileChanges :: !Int , filePatch :: !(Maybe Text) , fileFilename :: !Text , fileDeletions :: !Int } deriving (Show, Data, Typeable, Eq, Ord, Generic) instance NFData File where rnf = genericRnf instance Binary File -- JSON instances instance FromJSON Stats where parseJSON = withObject "Stats" $ \o -> Stats <$> o .: "additions" <*> o .: "total" <*> o .: "deletions" instance FromJSON Commit where parseJSON = withObject "Commit" $ \o -> Commit <$> o .: "sha" <*> o .: "parents" <*> o .: "url" <*> o .: "commit" <*> o .:? "committer" <*> o .:? "author" <*> o .:? "files" .!= V.empty <*> o .:? "stats" instance FromJSON Tree where parseJSON = withObject "Tree" $ \o -> Tree <$> o .: "sha" <*> o .: "url" <*> o .:? "tree" .!= V.empty instance FromJSON GitTree where parseJSON = withObject "GitTree" $ \o -> GitTree <$> o .: "type" <*> o .: "sha" <*> o .:? "url" <*> o .:? "size" <*> o .: "path" <*> o .: "mode" instance FromJSON GitCommit where parseJSON = withObject "GitCommit" $ \o -> GitCommit <$> o .: "message" <*> o .: "url" <*> o .: "committer" <*> o .: "author" <*> o .: "tree" <*> o .:? "sha" <*> o .:? "parents" .!= V.empty instance FromJSON GitUser where parseJSON = withObject "GitUser" $ \o -> GitUser <$> o .: "name" <*> o .: "email" <*> o .: "date" instance FromJSON File where parseJSON = withObject "File" $ \o -> File <$> o .:? "blob_url" <*> o .: "status" <*> o .:? "raw_url" <*> o .: "additions" <*> o .:? "sha" <*> o .: "changes" <*> o .:? "patch" <*> o .: "filename" <*> o .: "deletions" instance ToJSON NewGitReference where toJSON (NewGitReference r s) = object [ "ref" .= r, "sha" .= s ] instance FromJSON GitReference where parseJSON = withObject "GitReference" $ \o -> GitReference <$> o .: "object" <*> o .: "url" <*> o .: "ref" instance FromJSON GitObject where parseJSON = withObject "GitObject" $ \o -> GitObject <$> o .: "type" <*> o .: "sha" <*> o .: "url" instance FromJSON Diff where parseJSON = withObject "Diff" $ \o -> Diff <$> o .: "status" <*> o .: "behind_by" <*> o .: "patch_url" <*> o .: "url" <*> o .: "base_commit" <*> o .:? "commits" .!= V.empty <*> o .: "total_commits" <*> o .: "html_url" <*> o .:? "files" .!= V.empty <*> o .: "ahead_by" <*> o .: "diff_url" <*> o .: "permalink_url" instance FromJSON Blob where parseJSON = withObject "Blob" $ \o -> Blob <$> o .: "url" <*> o .: "encoding" <*> o .: "content" <*> o .: "sha" <*> o .: "size" instance FromJSON Tag where parseJSON = withObject "Tag" $ \o -> Tag <$> o .: "name" <*> o .: "zipball_url" <*> o .: "tarball_url" <*> o .: "commit" instance FromJSON Branch where parseJSON = withObject "Branch" $ \o -> Branch <$> o .: "name" <*> o .: "commit" instance FromJSON BranchCommit where parseJSON = withObject "BranchCommit" $ \o -> BranchCommit <$> o .: "sha" <*> o .: "url" github-0.23/src/GitHub/Data/Id.hs0000644000000000000000000000143207346545000014623 0ustar0000000000000000----------------------------------------------------------------------------- -- | -- License : BSD-3-Clause -- Maintainer : Oleg Grenrus -- module GitHub.Data.Id ( Id(..), mkId, untagId, ) where import GitHub.Internal.Prelude import Prelude () -- | Numeric identifier. newtype Id entity = Id Int deriving (Eq, Ord, Show, Generic, Typeable, Data) -- | Smart constructor for 'Id'. mkId :: proxy entity -> Int -> Id entity mkId _ = Id untagId :: Id entity -> Int untagId (Id name) = name instance Hashable (Id entity) instance Binary (Id entity) instance NFData (Id entity) where rnf (Id s) = rnf s instance FromJSON (Id entity) where parseJSON = fmap Id . parseJSON instance ToJSON (Id entity) where toJSON = toJSON . untagId github-0.23/src/GitHub/Data/Invitation.hs0000644000000000000000000000552207346545000016417 0ustar0000000000000000----------------------------------------------------------------------------- -- | -- License : BSD-3-Clause -- Maintainer : Oleg Grenrus -- module GitHub.Data.Invitation where import GitHub.Data.Definitions import GitHub.Data.Id (Id) import GitHub.Data.Name (Name) import GitHub.Data.Repos (Repo) import GitHub.Data.URL (URL) import GitHub.Internal.Prelude import Prelude () import qualified Data.Text as T data Invitation = Invitation { invitationId :: !(Id Invitation) -- TODO: technically either one should be, maybe both. use `these` ? , invitationLogin :: !(Maybe (Name User)) , invitationEmail :: !(Maybe Text) , invitationRole :: !InvitationRole , invitationCreatedAt :: !UTCTime , inviter :: !SimpleUser } deriving (Show, Data, Typeable, Eq, Ord, Generic) instance NFData Invitation where rnf = genericRnf instance Binary Invitation instance FromJSON Invitation where parseJSON = withObject "Invitation" $ \o -> Invitation <$> o .: "id" <*> o .:? "login" <*> o .:? "email" <*> o .: "role" <*> o .: "created_at" <*> o .: "inviter" data InvitationRole = InvitationRoleDirectMember | InvitationRoleAdmin | InvitationRoleBillingManager | InvitationRoleHiringManager | InvitationRoleReinstate deriving (Eq, Ord, Show, Enum, Bounded, Generic, Typeable, Data) instance NFData InvitationRole where rnf = genericRnf instance Binary InvitationRole instance FromJSON InvitationRole where parseJSON = withText "InvitationRole" $ \t -> case T.toLower t of "direct_member" -> pure InvitationRoleDirectMember "admin" -> pure InvitationRoleAdmin "billing_manager" -> pure InvitationRoleBillingManager "hiring_manager" -> pure InvitationRoleHiringManager "reinstate" -> pure InvitationRoleReinstate _ -> fail $ "Unknown InvitationRole: " <> T.unpack t data RepoInvitation = RepoInvitation { repoInvitationId :: !(Id RepoInvitation) , repoInvitationInvitee :: !SimpleUser , repoInvitationInviter :: !SimpleUser , repoInvitationRepo :: !Repo , repoInvitationUrl :: !URL , repoInvitationCreatedAt :: !UTCTime , repoInvitationPermission :: !Text , repoInvitationHtmlUrl :: !URL } deriving (Show, Data, Typeable, Eq, Ord, Generic) instance NFData RepoInvitation where rnf = genericRnf instance Binary RepoInvitation instance FromJSON RepoInvitation where parseJSON = withObject "RepoInvitation" $ \o -> RepoInvitation <$> o .: "id" <*> o .: "invitee" <*> o .: "inviter" <*> o .: "repository" <*> o .: "url" <*> o .: "created_at" <*> o .: "permissions" <*> o .: "html_url" github-0.23/src/GitHub/Data/Issues.hs0000644000000000000000000002265007346545000015547 0ustar0000000000000000----------------------------------------------------------------------------- -- | -- License : BSD-3-Clause -- Maintainer : Oleg Grenrus -- module GitHub.Data.Issues where import GitHub.Data.Definitions import GitHub.Data.Id (Id) import GitHub.Data.Milestone (Milestone) import GitHub.Data.Name (Name) import GitHub.Data.Options (IssueState) import GitHub.Data.PullRequests import GitHub.Data.URL (URL) import GitHub.Internal.Prelude import Prelude () import qualified Data.Text as T data Issue = Issue { issueClosedAt :: !(Maybe UTCTime) , issueUpdatedAt :: !UTCTime , issueEventsUrl :: !URL , issueHtmlUrl :: !(Maybe URL) , issueClosedBy :: !(Maybe SimpleUser) , issueLabels :: !(Vector IssueLabel) , issueNumber :: !IssueNumber , issueAssignees :: !(Vector SimpleUser) , issueUser :: !SimpleUser , issueTitle :: !Text , issuePullRequest :: !(Maybe PullRequestReference) , issueUrl :: !URL , issueCreatedAt :: !UTCTime , issueBody :: !(Maybe Text) , issueState :: !IssueState , issueId :: !(Id Issue) , issueComments :: !Int , issueMilestone :: !(Maybe Milestone) } deriving (Show, Data, Typeable, Eq, Ord, Generic) instance NFData Issue where rnf = genericRnf instance Binary Issue data NewIssue = NewIssue { newIssueTitle :: !Text , newIssueBody :: !(Maybe Text) , newIssueAssignees :: !(Vector (Name User)) , newIssueMilestone :: !(Maybe (Id Milestone)) , newIssueLabels :: !(Maybe (Vector (Name IssueLabel))) } deriving (Show, Data, Typeable, Eq, Ord, Generic) instance NFData NewIssue where rnf = genericRnf instance Binary NewIssue data EditIssue = EditIssue { editIssueTitle :: !(Maybe Text) , editIssueBody :: !(Maybe Text) , editIssueAssignees :: !(Maybe (Vector (Name User))) , editIssueState :: !(Maybe IssueState) , editIssueMilestone :: !(Maybe (Id Milestone)) , editIssueLabels :: !(Maybe (Vector (Name IssueLabel))) } deriving (Show, Data, Typeable, Eq, Ord, Generic) instance NFData EditIssue where rnf = genericRnf instance Binary EditIssue data IssueComment = IssueComment { issueCommentUpdatedAt :: !UTCTime , issueCommentUser :: !SimpleUser , issueCommentUrl :: !URL , issueCommentHtmlUrl :: !URL , issueCommentCreatedAt :: !UTCTime , issueCommentBody :: !Text , issueCommentId :: !Int } deriving (Show, Data, Typeable, Eq, Ord, Generic) instance NFData IssueComment where rnf = genericRnf instance Binary IssueComment -- | See data EventType = Mentioned -- ^ The actor was @mentioned in an issue body. | Subscribed -- ^ The actor subscribed to receive notifications for an issue. | Unsubscribed -- ^ The issue was unsubscribed from by the actor. | Referenced -- ^ The issue was referenced from a commit message. The commit_id attribute is the commit SHA1 of where that happened. | Merged -- ^ The issue was merged by the actor. The commit_id attribute is the SHA1 of the HEAD commit that was merged. | 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. | ReviewRequested -- ^ The actor requested review from the subject on this pull request. | ReviewDismissed -- ^ The actor dismissed a review from the pull request. | ReviewRequestRemoved -- ^ The actor removed the review request for the subject on this pull request. | MarkedAsDuplicate -- ^ A user with write permissions marked an issue as a duplicate of another issue or a pull request as a duplicate of another pull request. | UnmarkedAsDuplicate -- ^ An issue that a user had previously marked as a duplicate of another issue is no longer considered a duplicate, or a pull request that a user had previously marked as a duplicate of another pull request is no longer considered a duplicate. | AddedToProject -- ^ The issue was added to a project board. | MovedColumnsInProject -- ^ The issue was moved between columns in a project board. | RemovedFromProject -- ^ The issue was removed from a project board. | ConvertedNoteToIssue -- ^ The issue was created by converting a note in a project board to an issue. deriving (Show, Data, Enum, Bounded, Typeable, Eq, Ord, Generic) instance NFData EventType where rnf = genericRnf instance Binary EventType -- | Issue event data IssueEvent = IssueEvent { issueEventActor :: !SimpleUser , issueEventType :: !EventType , issueEventCommitId :: !(Maybe Text) , issueEventUrl :: !URL , issueEventCreatedAt :: !UTCTime , issueEventId :: !Int , issueEventIssue :: !(Maybe Issue) , issueEventLabel :: !(Maybe IssueLabel) } deriving (Show, Data, Typeable, Eq, Ord, Generic) instance NFData IssueEvent where rnf = genericRnf instance Binary IssueEvent instance FromJSON IssueEvent where parseJSON = withObject "Event" $ \o -> IssueEvent <$> o .: "actor" <*> o .: "event" <*> o .:? "commit_id" <*> o .: "url" <*> o .: "created_at" <*> o .: "id" <*> o .:? "issue" <*> o .:? "label" instance FromJSON EventType where parseJSON = withText "EventType" $ \t -> case T.toLower t of "closed" -> pure Closed "reopened" -> pure Reopened "subscribed" -> pure Subscribed "merged" -> pure Merged "referenced" -> pure Referenced "mentioned" -> pure Mentioned "assigned" -> pure Assigned "unassigned" -> pure ActorUnassigned "labeled" -> pure Labeled "unlabeled" -> pure Unlabeled "milestoned" -> pure Milestoned "demilestoned" -> pure Demilestoned "renamed" -> pure Renamed "locked" -> pure Locked "unlocked" -> pure Unlocked "head_ref_deleted" -> pure HeadRefDeleted "head_ref_restored" -> pure HeadRefRestored "review_requested" -> pure ReviewRequested "review_dismissed" -> pure ReviewDismissed "review_request_removed" -> pure ReviewRequestRemoved "marked_as_duplicate" -> pure MarkedAsDuplicate "unmarked_as_duplicate" -> pure UnmarkedAsDuplicate "added_to_project" -> pure AddedToProject "moved_columns_in_project" -> pure MovedColumnsInProject "removed_from_project" -> pure RemovedFromProject "converted_note_to_issue" -> pure ConvertedNoteToIssue "unsubscribed" -> pure Unsubscribed -- not in api docs list _ -> fail $ "Unknown EventType: " <> T.unpack t instance FromJSON IssueComment where parseJSON = withObject "IssueComment" $ \o -> IssueComment <$> o .: "updated_at" <*> o .: "user" <*> o .: "url" <*> o .: "html_url" <*> o .: "created_at" <*> o .: "body" <*> o .: "id" instance FromJSON Issue where parseJSON = withObject "Issue" $ \o -> Issue <$> o .:? "closed_at" <*> o .: "updated_at" <*> o .: "events_url" <*> o .: "html_url" <*> o .:? "closed_by" <*> o .: "labels" <*> o .: "number" <*> o .: "assignees" <*> o .: "user" <*> o .: "title" <*> o .:? "pull_request" <*> o .: "url" <*> o .: "created_at" <*> o .: "body" <*> o .: "state" <*> o .: "id" <*> o .: "comments" <*> o .:? "milestone" instance ToJSON NewIssue where toJSON (NewIssue t b a m ls) = object $ filter notNull [ "title" .= t , "body" .= b , "assignees" .= a , "milestone" .= m , "labels" .= ls ] where notNull (_, Null) = False notNull (_, _) = True instance ToJSON EditIssue where toJSON (EditIssue t b a s m ls) = object $ filter notNull [ "title" .= t , "body" .= b , "assignees" .= a , "state" .= s , "milestone" .= m , "labels" .= ls ] where notNull (_, Null) = False notNull (_, _) = True github-0.23/src/GitHub/Data/Milestone.hs0000644000000000000000000000515307346545000016232 0ustar0000000000000000----------------------------------------------------------------------------- -- | -- License : BSD-3-Clause -- Maintainer : Oleg Grenrus -- module GitHub.Data.Milestone where import GitHub.Data.Definitions import GitHub.Data.Id (Id) import GitHub.Data.URL (URL) import GitHub.Internal.Prelude import Prelude () data Milestone = Milestone { milestoneCreator :: !SimpleUser , milestoneDueOn :: !(Maybe UTCTime) , milestoneOpenIssues :: !Int , milestoneNumber :: !(Id Milestone) , milestoneClosedIssues :: !Int , milestoneDescription :: !(Maybe Text) , milestoneTitle :: !Text , milestoneUrl :: !URL , milestoneCreatedAt :: !UTCTime , milestoneState :: !Text } deriving (Show, Data, Typeable, Eq, Ord, Generic) instance NFData Milestone where rnf = genericRnf instance Binary Milestone instance FromJSON Milestone where parseJSON = withObject "Milestone" $ \o -> Milestone <$> o .: "creator" <*> o .: "due_on" <*> o .: "open_issues" <*> o .: "number" <*> o .: "closed_issues" <*> o .: "description" <*> o .: "title" <*> o .: "url" <*> o .: "created_at" <*> o .: "state" data NewMilestone = NewMilestone { newMilestoneTitle :: !Text , newMilestoneState :: !Text , newMilestoneDescription :: !(Maybe Text) , newMilestoneDueOn :: !(Maybe UTCTime) } deriving (Show, Data, Typeable, Eq, Ord, Generic) instance NFData NewMilestone where rnf = genericRnf instance Binary NewMilestone instance ToJSON NewMilestone where toJSON (NewMilestone title state desc due) = object $ filter notNull [ "title" .= title , "state" .= state , "description" .= desc , "due_on" .= due ] where notNull (_, Null) = False notNull (_, _) = True data UpdateMilestone = UpdateMilestone { updateMilestoneTitle :: !(Maybe Text) , updateMilestoneState :: !(Maybe Text) , updateMilestoneDescription :: !(Maybe Text) , updateMilestoneDueOn :: !(Maybe UTCTime) } deriving (Show, Data, Typeable, Eq, Ord, Generic) instance NFData UpdateMilestone where rnf = genericRnf instance Binary UpdateMilestone instance ToJSON UpdateMilestone where toJSON (UpdateMilestone title state desc due) = object $ filter notNull [ "title" .= title , "state" .= state , "description" .= desc , "due_on" .= due ] where notNull (_, Null) = False notNull (_, _) = True github-0.23/src/GitHub/Data/Name.hs0000644000000000000000000000236307346545000015153 0ustar0000000000000000{-# LANGUAGE CPP #-} ----------------------------------------------------------------------------- -- | -- License : BSD-3-Clause -- Maintainer : Oleg Grenrus -- module GitHub.Data.Name ( Name(..), mkName, untagName, ) where import Prelude () import GitHub.Internal.Prelude #if MIN_VERSION_aeson(1,0,0) import Data.Aeson.Types (FromJSONKey (..), ToJSONKey (..), fromJSONKeyCoerce, toJSONKeyText) #endif newtype Name entity = N Text deriving (Eq, Ord, Show, Generic, Typeable, Data) -- | Smart constructor for 'Name' mkName :: proxy entity -> Text -> Name entity mkName _ = N untagName :: Name entity -> Text untagName (N name) = name instance Hashable (Name entity) instance Binary (Name entity) instance NFData (Name entity) where rnf (N s) = rnf s instance FromJSON (Name entity) where parseJSON = fmap N . parseJSON instance ToJSON (Name entity) where toJSON = toJSON . untagName instance IsString (Name entity) where fromString = N . fromString #if MIN_VERSION_aeson(1,0,0) -- | @since 0.15.0.0 instance ToJSONKey (Name entity) where toJSONKey = toJSONKeyText untagName -- | @since 0.15.0.0 instance FromJSONKey (Name entity) where fromJSONKey = fromJSONKeyCoerce #endif github-0.23/src/GitHub/Data/Options.hs0000644000000000000000000004625607346545000015737 0ustar0000000000000000{-# LANGUAGE RecordWildCards #-} ----------------------------------------------------------------------------- -- | -- License : BSD-3-Clause -- Maintainer : Oleg Grenrus -- -- Module with modifiers for pull requests' and issues' listings. module GitHub.Data.Options ( -- * Common modifiers stateOpen, stateClosed, stateAll, sortAscending, sortDescending, sortByCreated, sortByUpdated, -- * Pull Requests PullRequestMod, prModToQueryString, optionsBase, optionsNoBase, optionsHead, optionsNoHead, sortByPopularity, sortByLongRunning, -- * Issues IssueMod, issueModToQueryString, sortByComments, optionsLabels, optionsSince, optionsSinceAll, optionsAssignedIssues, optionsCreatedIssues, optionsMentionedIssues, optionsSubscribedIssues, optionsAllIssues, -- * Repo issues IssueRepoMod, issueRepoModToQueryString, optionsIrrelevantMilestone, optionsAnyMilestone, optionsNoMilestone, optionsIrrelevantAssignee, optionsAnyAssignee, optionsNoAssignee, -- * Data IssueState (..), MergeableState (..), -- * Internal HasState, HasDirection, HasCreatedUpdated, HasComments, HasLabels, HasSince, ) where import GitHub.Data.Definitions import GitHub.Data.Id (Id, untagId) import GitHub.Data.Milestone (Milestone) import GitHub.Data.Name (Name, untagName) import GitHub.Internal.Prelude import Prelude () import qualified Data.Text as T import qualified Data.Text.Encoding as TE ------------------------------------------------------------------------------- -- Data ------------------------------------------------------------------------------- -- | 'GitHub.Data.Issues.Issue' or 'GitHub.Data.PullRequests.PullRequest' state data IssueState = StateOpen | StateClosed deriving (Eq, Ord, Show, Enum, Bounded, Generic, Typeable, Data) instance ToJSON IssueState where toJSON StateOpen = String "open" toJSON StateClosed = String "closed" instance FromJSON IssueState where parseJSON = withText "IssueState" $ \t -> case T.toLower t of "open" -> pure StateOpen "closed" -> pure StateClosed _ -> fail $ "Unknown IssueState: " <> T.unpack t instance NFData IssueState where rnf = genericRnf instance Binary IssueState -- | 'GitHub.Data.PullRequests.PullRequest' mergeable_state data MergeableState = StateUnknown | StateClean | StateDirty | StateUnstable | StateBlocked | StateBehind deriving (Eq, Ord, Show, Enum, Bounded, Generic, Typeable, Data) instance ToJSON MergeableState where toJSON StateUnknown = String "unknown" toJSON StateClean = String "clean" toJSON StateDirty = String "dirty" toJSON StateUnstable = String "unstable" toJSON StateBlocked = String "blocked" toJSON StateBehind = String "behind" instance FromJSON MergeableState where parseJSON = withText "MergeableState" $ \t -> case T.toLower t of "unknown" -> pure StateUnknown "clean" -> pure StateClean "dirty" -> pure StateDirty "unstable" -> pure StateUnstable "blocked" -> pure StateBlocked "behind" -> pure StateBehind _ -> fail $ "Unknown MergeableState: " <> T.unpack t instance NFData MergeableState where rnf = genericRnf instance Binary MergeableState data SortDirection = SortAscending | SortDescending deriving (Eq, Ord, Show, Enum, Bounded, Generic, Typeable, Data) instance NFData SortDirection where rnf = genericRnf instance Binary SortDirection -- PR data SortPR = SortPRCreated | SortPRUpdated | SortPRPopularity | SortPRLongRunning deriving (Eq, Ord, Show, Enum, Bounded, Generic, Typeable, Data) instance NFData SortPR where rnf = genericRnf instance Binary SortPR -- Issue data IssueFilter = IssueFilterAssigned | IssueFilterCreated | IssueFilterMentioned | IssueFilterSubscribed | IssueFilterAll deriving (Eq, Ord, Show, Enum, Bounded, Generic, Typeable, Data) instance NFData IssueFilter where rnf = genericRnf instance Binary IssueFilter data SortIssue = SortIssueCreated | SortIssueUpdated | SortIssueComments deriving (Eq, Ord, Show, Enum, Bounded, Generic, Typeable, Data) instance NFData SortIssue where rnf = genericRnf instance Binary SortIssue data FilterBy a = FilterAny | FilterNone | FilterBy a | FilterNotSpecified -- ^ e.g. for milestones "any" means "any milestone". -- I.e. won't show issues without mileston specified deriving (Eq, Ord, Show, Generic, Typeable, Data) ------------------------------------------------------------------------------- -- Classes ------------------------------------------------------------------------------- class HasState mod where state :: Maybe IssueState -> mod stateOpen :: HasState mod => mod stateOpen = state (Just StateOpen) stateClosed :: HasState mod => mod stateClosed = state (Just StateClosed) stateAll :: HasState mod => mod stateAll = state Nothing instance HasState PullRequestMod where state s = PRMod $ \opts -> opts { pullRequestOptionsState = s } instance HasState IssueMod where state s = IssueMod $ \opts -> opts { issueOptionsState = s } instance HasState IssueRepoMod where state s = IssueRepoMod $ \opts -> opts { issueRepoOptionsState = s } class HasDirection mod where sortDir :: SortDirection -> mod sortAscending :: HasDirection mod => mod sortAscending = sortDir SortAscending sortDescending :: HasDirection mod => mod sortDescending = sortDir SortDescending instance HasDirection PullRequestMod where sortDir x = PRMod $ \opts -> opts { pullRequestOptionsDirection = x } instance HasDirection IssueMod where sortDir x = IssueMod $ \opts -> opts { issueOptionsDirection = x } instance HasDirection IssueRepoMod where sortDir x = IssueRepoMod $ \opts -> opts { issueRepoOptionsDirection = x } class HasCreatedUpdated mod where sortByCreated :: mod sortByUpdated :: mod instance HasCreatedUpdated PullRequestMod where sortByCreated = PRMod $ \opts -> opts { pullRequestOptionsSort = SortPRCreated } sortByUpdated = PRMod $ \opts -> opts { pullRequestOptionsSort = SortPRUpdated } instance HasCreatedUpdated IssueMod where sortByCreated = IssueMod $ \opts -> opts { issueOptionsSort = SortIssueCreated } sortByUpdated = IssueMod $ \opts -> opts { issueOptionsSort = SortIssueUpdated } instance HasCreatedUpdated IssueRepoMod where sortByCreated = IssueRepoMod $ \opts -> opts { issueRepoOptionsSort = SortIssueCreated } sortByUpdated = IssueRepoMod $ \opts -> opts { issueRepoOptionsSort = SortIssueUpdated } ------------------------------------------------------------------------------- -- Pull Request ------------------------------------------------------------------------------- -- | See . data PullRequestOptions = PullRequestOptions { pullRequestOptionsState :: !(Maybe IssueState) , pullRequestOptionsHead :: !(Maybe Text) , pullRequestOptionsBase :: !(Maybe Text) , pullRequestOptionsSort :: !SortPR , pullRequestOptionsDirection :: !SortDirection } deriving (Eq, Ord, Show, Generic, Typeable, Data) defaultPullRequestOptions :: PullRequestOptions defaultPullRequestOptions = PullRequestOptions { pullRequestOptionsState = Just StateOpen , pullRequestOptionsHead = Nothing , pullRequestOptionsBase = Nothing , pullRequestOptionsSort = SortPRCreated , pullRequestOptionsDirection = SortDescending } -- | See . newtype PullRequestMod = PRMod (PullRequestOptions -> PullRequestOptions) instance Semigroup PullRequestMod where PRMod f <> PRMod g = PRMod (g . f) instance Monoid PullRequestMod where mempty = PRMod id mappend = (<>) toPullRequestOptions :: PullRequestMod -> PullRequestOptions toPullRequestOptions (PRMod f) = f defaultPullRequestOptions prModToQueryString :: PullRequestMod -> QueryString prModToQueryString = pullRequestOptionsToQueryString . toPullRequestOptions pullRequestOptionsToQueryString :: PullRequestOptions -> QueryString pullRequestOptionsToQueryString (PullRequestOptions st head_ base sort dir) = [ mk "state" state' , mk "sort" sort' , mk "direction" direction' ] ++ catMaybes [ mk "head" <$> head' , mk "base" <$> base' ] where mk k v = (k, Just v) state' = case st of Nothing -> "all" Just StateOpen -> "open" Just StateClosed -> "closed" sort' = case sort of SortPRCreated -> "created" SortPRUpdated -> "updated" SortPRPopularity -> "popularity" SortPRLongRunning -> "long-running" direction' = case dir of SortDescending -> "desc" SortAscending -> "asc" head' = fmap TE.encodeUtf8 head_ base' = fmap TE.encodeUtf8 base ------------------------------------------------------------------------------- -- Pull request modifiers ------------------------------------------------------------------------------- optionsBase :: Text -> PullRequestMod optionsBase x = PRMod $ \opts -> opts { pullRequestOptionsBase = Just x } optionsNoBase :: PullRequestMod optionsNoBase = PRMod $ \opts -> opts { pullRequestOptionsBase = Nothing } optionsHead :: Text -> PullRequestMod optionsHead x = PRMod $ \opts -> opts { pullRequestOptionsHead = Just x } optionsNoHead :: PullRequestMod optionsNoHead = PRMod $ \opts -> opts { pullRequestOptionsHead = Nothing } sortByPopularity :: PullRequestMod sortByPopularity = PRMod $ \opts -> opts { pullRequestOptionsSort = SortPRPopularity } sortByLongRunning :: PullRequestMod sortByLongRunning = PRMod $ \opts -> opts { pullRequestOptionsSort = SortPRLongRunning } ------------------------------------------------------------------------------- -- Issues ------------------------------------------------------------------------------- -- | See . data IssueOptions = IssueOptions { issueOptionsFilter :: !IssueFilter , issueOptionsState :: !(Maybe IssueState) , issueOptionsLabels :: ![Name IssueLabel] -- TODO: change to newtype , issueOptionsSort :: !SortIssue , issueOptionsDirection :: !SortDirection , issueOptionsSince :: !(Maybe UTCTime) } deriving (Eq, Ord, Show, Generic, Typeable, Data) defaultIssueOptions :: IssueOptions defaultIssueOptions = IssueOptions { issueOptionsFilter = IssueFilterAssigned , issueOptionsState = Just StateOpen , issueOptionsLabels = [] , issueOptionsSort = SortIssueCreated , issueOptionsDirection = SortDescending , issueOptionsSince = Nothing } -- | See . newtype IssueMod = IssueMod (IssueOptions -> IssueOptions) instance Semigroup IssueMod where IssueMod f <> IssueMod g = IssueMod (g . f) instance Monoid IssueMod where mempty = IssueMod id mappend = (<>) toIssueOptions :: IssueMod -> IssueOptions toIssueOptions (IssueMod f) = f defaultIssueOptions issueModToQueryString :: IssueMod -> QueryString issueModToQueryString = issueOptionsToQueryString . toIssueOptions issueOptionsToQueryString :: IssueOptions -> QueryString issueOptionsToQueryString (IssueOptions filt st labels sort dir since) = [ mk "state" state' , mk "sort" sort' , mk "direction" direction' , mk "filter" filt' ] ++ catMaybes [ mk "labels" <$> labels' , mk "since" <$> since' ] where mk k v = (k, Just v) filt' = case filt of IssueFilterAssigned -> "assigned" IssueFilterCreated -> "created" IssueFilterMentioned -> "mentioned" IssueFilterSubscribed -> "subscribed" IssueFilterAll -> "all" state' = case st of Nothing -> "all" Just StateOpen -> "open" Just StateClosed -> "closed" sort' = case sort of SortIssueCreated -> "created" SortIssueUpdated -> "updated" SortIssueComments -> "comments" direction' = case dir of SortDescending -> "desc" SortAscending -> "asc" since' = fmap (TE.encodeUtf8 . T.pack . show) since labels' = TE.encodeUtf8 . T.intercalate "," . fmap untagName <$> nullToNothing labels nullToNothing :: Foldable f => f a -> Maybe (f a) nullToNothing xs | null xs = Nothing | otherwise = Just xs ------------------------------------------------------------------------------- -- Issues modifiers ------------------------------------------------------------------------------- class HasComments mod where sortByComments :: mod instance HasComments IssueMod where sortByComments = IssueMod $ \opts -> opts { issueOptionsSort = SortIssueComments } instance HasComments IssueRepoMod where sortByComments = IssueRepoMod $ \opts -> opts { issueRepoOptionsSort = SortIssueComments } class HasLabels mod where optionsLabels :: Foldable f => f (Name IssueLabel) -> mod instance HasLabels IssueMod where optionsLabels lbls = IssueMod $ \opts -> opts { issueOptionsLabels = toList lbls } instance HasLabels IssueRepoMod where optionsLabels lbls = IssueRepoMod $ \opts -> opts { issueRepoOptionsLabels = toList lbls } class HasSince mod where optionsSince :: UTCTime -> mod optionsSinceAll :: mod instance HasSince IssueMod where optionsSince since = IssueMod $ \opts -> opts { issueOptionsSince = Just since } optionsSinceAll = IssueMod $ \opts -> opts { issueOptionsSince = Nothing } instance HasSince IssueRepoMod where optionsSince since = IssueRepoMod $ \opts -> opts { issueRepoOptionsSince = Just since } optionsSinceAll = IssueRepoMod $ \opts -> opts { issueRepoOptionsSince = Nothing } ------------------------------------------------------------------------------- -- Only issues modifiers ------------------------------------------------------------------------------- optionsAssignedIssues, optionsCreatedIssues, optionsMentionedIssues, optionsSubscribedIssues, optionsAllIssues :: IssueMod optionsAssignedIssues = issueFilter IssueFilterAssigned optionsCreatedIssues = issueFilter IssueFilterCreated optionsMentionedIssues = issueFilter IssueFilterMentioned optionsSubscribedIssues = issueFilter IssueFilterSubscribed optionsAllIssues = issueFilter IssueFilterAll issueFilter :: IssueFilter -> IssueMod issueFilter f = IssueMod $ \opts -> opts { issueOptionsFilter = f } ------------------------------------------------------------------------------- -- Issues repo ------------------------------------------------------------------------------- data IssueRepoOptions = IssueRepoOptions { issueRepoOptionsMilestone :: !(FilterBy (Id Milestone)) , issueRepoOptionsState :: !(Maybe IssueState) , issueRepoOptionsAssignee :: !(FilterBy (Name User)) , issueRepoOptionsCreator :: !(Maybe (Name User)) , issueRepoOptionsMentioned :: !(Maybe (Name User)) , issueRepoOptionsLabels :: ![Name IssueLabel] , issueRepoOptionsSort :: !SortIssue , issueRepoOptionsDirection :: !SortDirection , issueRepoOptionsSince :: !(Maybe UTCTime) } deriving (Eq, Ord, Show, Generic, Typeable, Data) defaultIssueRepoOptions :: IssueRepoOptions defaultIssueRepoOptions = IssueRepoOptions { issueRepoOptionsMilestone = FilterNotSpecified , issueRepoOptionsState = (Just StateOpen) , issueRepoOptionsAssignee = FilterNotSpecified , issueRepoOptionsCreator = Nothing , issueRepoOptionsMentioned = Nothing , issueRepoOptionsLabels = [] , issueRepoOptionsSort = SortIssueCreated , issueRepoOptionsDirection = SortDescending , issueRepoOptionsSince = Nothing } -- | See . newtype IssueRepoMod = IssueRepoMod (IssueRepoOptions -> IssueRepoOptions) instance Semigroup IssueRepoMod where IssueRepoMod f <> IssueRepoMod g = IssueRepoMod (g . f) instance Monoid IssueRepoMod where mempty = IssueRepoMod id mappend = (<>) toIssueRepoOptions :: IssueRepoMod -> IssueRepoOptions toIssueRepoOptions (IssueRepoMod f) = f defaultIssueRepoOptions issueRepoModToQueryString :: IssueRepoMod -> QueryString issueRepoModToQueryString = issueRepoOptionsToQueryString . toIssueRepoOptions issueRepoOptionsToQueryString :: IssueRepoOptions -> QueryString issueRepoOptionsToQueryString IssueRepoOptions {..} = [ mk "state" state' , mk "sort" sort' , mk "direction" direction' ] ++ catMaybes [ mk "milestone" <$> milestone' , mk "assignee" <$> assignee' , mk "labels" <$> labels' , mk "since" <$> since' , mk "creator" <$> creator' , mk "mentioned" <$> mentioned' ] where mk k v = (k, Just v) filt f x = case x of FilterAny -> Just "*" FilterNone -> Just "none" FilterBy x' -> Just $ TE.encodeUtf8 $ f x' FilterNotSpecified -> Nothing milestone' = filt (T.pack . show . untagId) issueRepoOptionsMilestone assignee' = filt untagName issueRepoOptionsAssignee state' = case issueRepoOptionsState of Nothing -> "all" Just StateOpen -> "open" Just StateClosed -> "closed" sort' = case issueRepoOptionsSort of SortIssueCreated -> "created" SortIssueUpdated -> "updated" SortIssueComments -> "comments" direction' = case issueRepoOptionsDirection of SortDescending -> "desc" SortAscending -> "asc" since' = TE.encodeUtf8 . T.pack . show <$> issueRepoOptionsSince labels' = TE.encodeUtf8 . T.intercalate "," . fmap untagName <$> nullToNothing issueRepoOptionsLabels creator' = TE.encodeUtf8 . untagName <$> issueRepoOptionsCreator mentioned' = TE.encodeUtf8 . untagName <$> issueRepoOptionsMentioned ------------------------------------------------------------------------------- -- Issues repo modifiers ------------------------------------------------------------------------------- -- | Don't care about milestones. -- -- 'optionsAnyMilestone' means there should be some milestone, but it can be any. -- -- See optionsIrrelevantMilestone :: IssueRepoMod optionsIrrelevantMilestone = IssueRepoMod $ \opts -> opts { issueRepoOptionsMilestone = FilterNotSpecified } optionsAnyMilestone :: IssueRepoMod optionsAnyMilestone = IssueRepoMod $ \opts -> opts { issueRepoOptionsMilestone = FilterAny } optionsNoMilestone :: IssueRepoMod optionsNoMilestone = IssueRepoMod $ \opts -> opts { issueRepoOptionsMilestone = FilterNone } optionsIrrelevantAssignee :: IssueRepoMod optionsIrrelevantAssignee = IssueRepoMod $ \opts -> opts { issueRepoOptionsAssignee = FilterNotSpecified } optionsAnyAssignee :: IssueRepoMod optionsAnyAssignee = IssueRepoMod $ \opts -> opts { issueRepoOptionsAssignee = FilterAny } optionsNoAssignee :: IssueRepoMod optionsNoAssignee = IssueRepoMod $ \opts -> opts { issueRepoOptionsAssignee = FilterNone } github-0.23/src/GitHub/Data/PublicSSHKeys.hs0000644000000000000000000000344207346545000016722 0ustar0000000000000000----------------------------------------------------------------------------- -- | -- License : BSD-3-Clause -- Maintainer : Todd Mohney -- module GitHub.Data.PublicSSHKeys where import GitHub.Data.Id (Id) import GitHub.Data.URL (URL) import GitHub.Internal.Prelude import Prelude () data PublicSSHKeyBasic = PublicSSHKeyBasic { basicPublicSSHKeyId :: !(Id PublicSSHKey) , basicPublicSSHKeyKey :: !Text } deriving (Show, Data, Typeable, Eq, Ord, Generic) instance FromJSON PublicSSHKeyBasic where parseJSON = withObject "PublicSSHKeyBasic" $ \o -> PublicSSHKeyBasic <$> o .: "id" <*> o .: "key" data PublicSSHKey = PublicSSHKey { publicSSHKeyId :: !(Id PublicSSHKey) , publicSSHKeyKey :: !Text , publicSSHKeyUrl :: !URL , publicSSHKeyTitle :: !Text , publicSSHKeyVerified :: !Bool , publicSSHKeyCreatedAt :: !(Maybe UTCTime) , publicSSHKeyReadOnly :: !Bool } deriving (Show, Data, Typeable, Eq, Ord, Generic) instance FromJSON PublicSSHKey where parseJSON = withObject "PublicSSHKey" $ \o -> PublicSSHKey <$> o .: "id" <*> o .: "key" <*> o .: "url" <*> o .: "title" <*> o .: "verified" <*> o .:? "created_at" <*> o .: "read_only" data NewPublicSSHKey = NewPublicSSHKey { newPublicSSHKeyKey :: !Text , newPublicSSHKeyTitle :: !Text } deriving (Show, Data, Typeable, Eq, Ord, Generic) instance ToJSON NewPublicSSHKey where toJSON (NewPublicSSHKey key title) = object [ "key" .= key , "title" .= title ] instance FromJSON NewPublicSSHKey where parseJSON = withObject "PublicSSHKey" $ \o -> NewPublicSSHKey <$> o .: "key" <*> o .: "title" github-0.23/src/GitHub/Data/PullRequests.hs0000644000000000000000000002622707346545000016750 0ustar0000000000000000----------------------------------------------------------------------------- -- | -- License : BSD-3-Clause -- Maintainer : Oleg Grenrus -- module GitHub.Data.PullRequests ( SimplePullRequest(..), PullRequest(..), EditPullRequest(..), CreatePullRequest(..), PullRequestLinks(..), PullRequestCommit(..), PullRequestEvent(..), PullRequestEventType(..), PullRequestReference(..), MergeResult(..), ) where import GitHub.Data.Definitions import GitHub.Data.Id (Id) import GitHub.Data.Options (IssueState (..), MergeableState (..)) import GitHub.Data.Repos (Repo) import GitHub.Data.URL (URL) import GitHub.Internal.Prelude import Prelude () import qualified Data.Text as T data SimplePullRequest = SimplePullRequest { simplePullRequestClosedAt :: !(Maybe UTCTime) , simplePullRequestCreatedAt :: !UTCTime , simplePullRequestUser :: !SimpleUser , simplePullRequestPatchUrl :: !URL , simplePullRequestState :: !IssueState , simplePullRequestNumber :: !IssueNumber , simplePullRequestHtmlUrl :: !URL , simplePullRequestUpdatedAt :: !UTCTime , simplePullRequestBody :: !(Maybe Text) , simplePullRequestAssignees :: (Vector SimpleUser) , simplePullRequestRequestedReviewers :: (Vector SimpleUser) , simplePullRequestIssueUrl :: !URL , simplePullRequestDiffUrl :: !URL , simplePullRequestUrl :: !URL , simplePullRequestLinks :: !PullRequestLinks , simplePullRequestMergedAt :: !(Maybe UTCTime) , simplePullRequestTitle :: !Text , simplePullRequestId :: !(Id PullRequest) } deriving (Show, Data, Typeable, Eq, Ord, Generic) instance NFData SimplePullRequest where rnf = genericRnf instance Binary SimplePullRequest data PullRequest = PullRequest { pullRequestClosedAt :: !(Maybe UTCTime) , pullRequestCreatedAt :: !UTCTime , pullRequestUser :: !SimpleUser , pullRequestPatchUrl :: !URL , pullRequestState :: !IssueState , pullRequestNumber :: !IssueNumber , pullRequestHtmlUrl :: !URL , pullRequestUpdatedAt :: !UTCTime , pullRequestBody :: !(Maybe Text) , pullRequestAssignees :: (Vector SimpleUser) , pullRequestRequestedReviewers :: (Vector SimpleUser) , pullRequestIssueUrl :: !URL , pullRequestDiffUrl :: !URL , pullRequestUrl :: !URL , pullRequestLinks :: !PullRequestLinks , pullRequestMergedAt :: !(Maybe UTCTime) , pullRequestTitle :: !Text , pullRequestId :: !(Id PullRequest) , pullRequestMergedBy :: !(Maybe SimpleUser) , pullRequestChangedFiles :: !Int , pullRequestHead :: !PullRequestCommit , pullRequestComments :: !Count , pullRequestDeletions :: !Count , pullRequestAdditions :: !Count , pullRequestReviewComments :: !Count , pullRequestBase :: !PullRequestCommit , pullRequestCommits :: !Count , pullRequestMerged :: !Bool , pullRequestMergeable :: !(Maybe Bool) , pullRequestMergeableState :: !MergeableState } deriving (Show, Data, Typeable, Eq, Ord, Generic) instance NFData PullRequest where rnf = genericRnf instance Binary PullRequest data EditPullRequest = EditPullRequest { editPullRequestTitle :: !(Maybe Text) , editPullRequestBody :: !(Maybe Text) , editPullRequestState :: !(Maybe IssueState) , editPullRequestBase :: !(Maybe Text) , editPullRequestMaintainerCanModify :: !(Maybe Bool) } deriving (Show, Generic) instance NFData EditPullRequest where rnf = genericRnf instance Binary EditPullRequest data CreatePullRequest = CreatePullRequest { createPullRequestTitle :: !Text , createPullRequestBody :: !Text , createPullRequestHead :: !Text , createPullRequestBase :: !Text } | CreatePullRequestIssue { createPullRequestIssueNum :: !Int , createPullRequestHead :: !Text , createPullRequestBase :: !Text } deriving (Show, Generic) instance NFData CreatePullRequest where rnf = genericRnf instance Binary CreatePullRequest data PullRequestLinks = PullRequestLinks { pullRequestLinksReviewComments :: !URL , pullRequestLinksComments :: !URL , pullRequestLinksHtml :: !URL , pullRequestLinksSelf :: !URL } deriving (Show, Data, Typeable, Eq, Ord, Generic) instance NFData PullRequestLinks where rnf = genericRnf instance Binary PullRequestLinks data PullRequestCommit = PullRequestCommit { pullRequestCommitLabel :: !Text , pullRequestCommitRef :: !Text , pullRequestCommitSha :: !Text , pullRequestCommitUser :: !SimpleUser , pullRequestCommitRepo :: !(Maybe Repo) } deriving (Show, Data, Typeable, Eq, Ord, Generic) instance NFData PullRequestCommit where rnf = genericRnf instance Binary PullRequestCommit data PullRequestEvent = PullRequestEvent { pullRequestEventAction :: !PullRequestEventType , pullRequestEventNumber :: !Int , pullRequestEventPullRequest :: !PullRequest , pullRequestRepository :: !Repo , pullRequestSender :: !SimpleUser } deriving (Show, Data, Typeable, Eq, Ord, Generic) instance NFData PullRequestEvent where rnf = genericRnf instance Binary PullRequestEvent data PullRequestEventType = PullRequestOpened | PullRequestClosed | PullRequestSynchronized | PullRequestReopened | PullRequestAssigned | PullRequestUnassigned | PullRequestLabeled | PullRequestUnlabeled | PullRequestReviewRequested | PullRequestReviewRequestRemoved | PullRequestEdited deriving (Show, Data, Typeable, Eq, Ord, Generic) instance NFData PullRequestEventType where rnf = genericRnf instance Binary PullRequestEventType data PullRequestReference = PullRequestReference { pullRequestReferenceHtmlUrl :: !(Maybe URL) , pullRequestReferencePatchUrl :: !(Maybe URL) , pullRequestReferenceDiffUrl :: !(Maybe URL) } deriving (Eq, Ord, Show, Generic, Typeable, Data) instance NFData PullRequestReference where rnf = genericRnf instance Binary PullRequestReference ------------------------------------------------------------------------------- -- JSON instances ------------------------------------------------------------------------------- instance FromJSON SimplePullRequest where parseJSON = withObject "SimplePullRequest" $ \o -> SimplePullRequest <$> o .:? "closed_at" <*> o .: "created_at" <*> o .: "user" <*> o .: "patch_url" <*> o .: "state" <*> o .: "number" <*> o .: "html_url" <*> o .: "updated_at" <*> o .:? "body" <*> o .: "assignees" <*> o .:? "requested_reviewers" .!= mempty <*> o .: "issue_url" <*> o .: "diff_url" <*> o .: "url" <*> o .: "_links" <*> o .:? "merged_at" <*> o .: "title" <*> o .: "id" instance ToJSON EditPullRequest where toJSON (EditPullRequest t b s base mcm) = object $ filter notNull [ "title" .= t , "body" .= b , "state" .= s , "base" .= base , "maintainer_can_modify" .= mcm ] where notNull (_, Null) = False notNull (_, _) = True instance ToJSON CreatePullRequest where toJSON (CreatePullRequest t b headPR basePR) = object [ "title" .= t, "body" .= b, "head" .= headPR, "base" .= basePR ] toJSON (CreatePullRequestIssue issueNum headPR basePR) = object [ "issue" .= issueNum, "head" .= headPR, "base" .= basePR] instance FromJSON PullRequest where parseJSON = withObject "PullRequest" $ \o -> PullRequest <$> o .:? "closed_at" <*> o .: "created_at" <*> o .: "user" <*> o .: "patch_url" <*> o .: "state" <*> o .: "number" <*> o .: "html_url" <*> o .: "updated_at" <*> o .:? "body" <*> o .: "assignees" <*> o .:? "requested_reviewers" .!= mempty <*> o .: "issue_url" <*> o .: "diff_url" <*> o .: "url" <*> o .: "_links" <*> o .:? "merged_at" <*> o .: "title" <*> o .: "id" <*> o .:? "merged_by" <*> o .: "changed_files" <*> o .: "head" <*> o .: "comments" <*> o .: "deletions" <*> o .: "additions" <*> o .: "review_comments" <*> o .: "base" <*> o .: "commits" <*> o .: "merged" <*> o .:? "mergeable" <*> o .: "mergeable_state" instance FromJSON PullRequestLinks where parseJSON = withObject "PullRequestLinks" $ \o -> PullRequestLinks <$> fmap getHref (o .: "review_comments") <*> fmap getHref (o .: "comments") <*> fmap getHref (o .: "html") <*> fmap getHref (o .: "self") instance FromJSON PullRequestCommit where parseJSON = withObject "PullRequestCommit" $ \o -> PullRequestCommit <$> o .: "label" <*> o .: "ref" <*> o .: "sha" <*> o .: "user" <*> o .: "repo" instance FromJSON PullRequestEvent where parseJSON = withObject "PullRequestEvent" $ \o -> PullRequestEvent <$> o .: "action" <*> o .: "number" <*> o .: "pull_request" <*> o .: "repository" <*> o .: "sender" instance FromJSON PullRequestEventType where parseJSON = withText "PullRequestEventType" $ \t -> case T.toLower t of "opened" -> pure PullRequestOpened "closed" -> pure PullRequestClosed "synchronize" -> pure PullRequestSynchronized "reopened" -> pure PullRequestReopened "assigned" -> pure PullRequestAssigned "unassigned" -> pure PullRequestUnassigned "labeled" -> pure PullRequestLabeled "unlabeled" -> pure PullRequestUnlabeled "review_requested" -> pure PullRequestReviewRequested "review_request_removed" -> pure PullRequestReviewRequestRemoved "edited" -> pure PullRequestEdited _ -> fail $ "Unknown PullRequestEventType: " <> T.unpack t instance FromJSON PullRequestReference where parseJSON = withObject "PullRequestReference" $ \o -> PullRequestReference <$> o .:? "html_url" <*> o .:? "patch_url" <*> o .:? "diff_url" -- Helpers newtype Href a = Href { getHref :: a } instance FromJSON a => FromJSON (Href a) where parseJSON = withObject "href object" $ \obj -> Href <$> obj .: "href" -- | Pull request merge results data MergeResult = MergeSuccessful | MergeCannotPerform | MergeConflict deriving (Eq, Ord, Read, Show, Enum, Bounded, Generic, Typeable) github-0.23/src/GitHub/Data/RateLimit.hs0000644000000000000000000000227707346545000016171 0ustar0000000000000000----------------------------------------------------------------------------- -- | -- License : BSD-3-Clause -- Maintainer : Oleg Grenrus -- module GitHub.Data.RateLimit where import GitHub.Internal.Prelude import Prelude () data Limits = Limits { limitsMax :: !Int , limitsRemaining :: !Int , limitsReset :: !Int -- TODO: change to proper type } deriving (Show, Data, Typeable, Eq, Ord, Generic) instance NFData Limits where rnf = genericRnf instance Binary Limits instance FromJSON Limits where parseJSON = withObject "Limits" $ \obj -> Limits <$> obj .: "limit" <*> obj .: "remaining" <*> obj .: "reset" data RateLimit = RateLimit { rateLimitCore :: Limits , rateLimitSearch :: Limits , rateLimitGraphQL :: Limits } deriving (Show, Data, Typeable, Eq, Ord, Generic) instance NFData RateLimit where rnf = genericRnf instance Binary RateLimit instance FromJSON RateLimit where parseJSON = withObject "RateLimit" $ \obj -> do resources <- obj .: "resources" RateLimit <$> resources .: "core" <*> resources .: "search" <*> resources .: "graphql" github-0.23/src/GitHub/Data/Releases.hs0000644000000000000000000000533407346545000016037 0ustar0000000000000000module GitHub.Data.Releases where import GitHub.Data.Definitions import GitHub.Data.Id (Id) import GitHub.Data.URL (URL) import GitHub.Internal.Prelude import Prelude () data Release = Release { releaseUrl :: !URL , releaseHtmlUrl :: !URL , releaseAssetsurl :: !URL , releaseUploadUrl :: !URL , releaseTarballUrl :: !URL , releaseZipballUrl :: !URL , releaseId :: !(Id Release) , releaseTagName :: !Text , releaseTargetCommitish :: !Text , releaseName :: !Text , releaseBody :: !Text , releaseDraft :: !Bool , releasePrerelease :: !Bool , releaseCreatedAt :: !UTCTime , releasePublishedAt :: !(Maybe UTCTime) , releaseAuthor :: !SimpleUser , releaseAssets :: !(Vector ReleaseAsset) } deriving (Show, Data, Typeable, Eq, Ord, Generic) instance FromJSON Release where parseJSON = withObject "Event" $ \o -> Release <$> o .: "url" <*> o .: "html_url" <*> o .: "assets_url" <*> o .: "upload_url" <*> o .: "tarball_url" <*> o .: "zipball_url" <*> o .: "id" <*> o .: "tag_name" <*> o .: "target_commitish" <*> o .: "name" <*> o .: "body" <*> o .: "draft" <*> o .: "prerelease" <*> o .: "created_at" <*> o .:? "published_at" <*> o .: "author" <*> o .: "assets" instance NFData Release where rnf = genericRnf instance Binary Release data ReleaseAsset = ReleaseAsset { releaseAssetUrl :: !URL , releaseAssetBrowserDownloadUrl :: !Text , releaseAssetId :: !(Id ReleaseAsset) , releaseAssetName :: !Text , releaseAssetLabel :: !(Maybe Text) , releaseAssetState :: !Text , releaseAssetContentType :: !Text , releaseAssetSize :: !Int , releaseAssetDownloadCount :: !Int , releaseAssetCreatedAt :: !UTCTime , releaseAssetUpdatedAt :: !UTCTime , releaseAssetUploader :: !SimpleUser } deriving (Show, Data, Typeable, Eq, Ord, Generic) instance FromJSON ReleaseAsset where parseJSON = withObject "Event" $ \o -> ReleaseAsset <$> o .: "url" <*> o .: "browser_download_url" <*> o .: "id" <*> o .: "name" <*> o .:? "label" <*> o .: "state" <*> o .: "content_type" <*> o .: "size" <*> o .: "download_count" <*> o .: "created_at" <*> o .: "updated_at" <*> o .: "uploader" instance NFData ReleaseAsset where rnf = genericRnf instance Binary ReleaseAsset github-0.23/src/GitHub/Data/Repos.hs0000644000000000000000000002243307346545000015363 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE FlexibleInstances #-} #define UNSAFE 1 ----------------------------------------------------------------------------- -- | -- License : BSD-3-Clause -- Maintainer : Oleg Grenrus -- -- This module also exports -- @'FromJSON' a => 'FromJSON' ('HM.HashMap' 'Language' a)@ -- orphan-ish instance for @aeson < 1@ module GitHub.Data.Repos where import GitHub.Data.Definitions import GitHub.Data.Id (Id) import GitHub.Data.Name (Name) import GitHub.Data.Request (IsPathPart (..)) import GitHub.Data.URL (URL) import GitHub.Internal.Prelude import Prelude () import qualified Data.HashMap.Strict as HM #if MIN_VERSION_aeson(1,0,0) import Data.Aeson.Types (FromJSONKey (..), fromJSONKeyCoerce) #else #ifdef UNSAFE import Unsafe.Coerce (unsafeCoerce) #endif #endif data Repo = Repo { repoSshUrl :: !(Maybe URL) , repoDescription :: !(Maybe Text) , repoCreatedAt :: !(Maybe UTCTime) , repoHtmlUrl :: !URL , repoSvnUrl :: !(Maybe URL) , repoForks :: !(Maybe Int) , repoHomepage :: !(Maybe Text) , repoFork :: !(Maybe Bool) , repoGitUrl :: !(Maybe URL) , repoPrivate :: !Bool , repoArchived :: !Bool , repoCloneUrl :: !(Maybe URL) , repoSize :: !(Maybe Int) , repoUpdatedAt :: !(Maybe UTCTime) , repoWatchers :: !(Maybe Int) , repoOwner :: !SimpleOwner , repoName :: !(Name Repo) , repoLanguage :: !(Maybe Language) , repoDefaultBranch :: !(Maybe Text) , repoPushedAt :: !(Maybe UTCTime) -- ^ this is Nothing for new repositories , repoId :: !(Id Repo) , repoUrl :: !URL , repoOpenIssues :: !(Maybe Int) , repoHasWiki :: !(Maybe Bool) , repoHasIssues :: !(Maybe Bool) , repoHasDownloads :: !(Maybe Bool) , repoParent :: !(Maybe RepoRef) , repoSource :: !(Maybe RepoRef) , repoHooksUrl :: !URL , repoStargazersCount :: !Int } deriving (Show, Data, Typeable, Eq, Ord, Generic) instance NFData Repo where rnf = genericRnf instance Binary Repo data RepoRef = RepoRef { repoRefOwner :: !SimpleOwner , repoRefRepo :: !(Name Repo) } deriving (Show, Data, Typeable, Eq, Ord, Generic) instance NFData RepoRef where rnf = genericRnf instance Binary RepoRef data NewRepo = NewRepo { newRepoName :: !(Name Repo) , newRepoDescription :: !(Maybe Text) , newRepoHomepage :: !(Maybe Text) , newRepoPrivate :: !(Maybe Bool) , newRepoHasIssues :: !(Maybe Bool) , newRepoHasWiki :: !(Maybe Bool) , newRepoAutoInit :: !(Maybe Bool) } deriving (Eq, Ord, Show, Data, Typeable, Generic) instance NFData NewRepo where rnf = genericRnf instance Binary NewRepo newRepo :: Name Repo -> NewRepo newRepo name = NewRepo name Nothing Nothing Nothing Nothing Nothing Nothing data EditRepo = EditRepo { editName :: !(Maybe (Name Repo)) , editDescription :: !(Maybe Text) , editHomepage :: !(Maybe Text) , editPublic :: !(Maybe Bool) , editHasIssues :: !(Maybe Bool) , editHasWiki :: !(Maybe Bool) , editHasDownloads :: !(Maybe Bool) } deriving (Eq, Ord, Show, Data, Typeable, Generic) instance NFData EditRepo where rnf = genericRnf instance Binary EditRepo -- | Filter the list of the user's repos using any of these constructors. data RepoPublicity = RepoPublicityAll -- ^ All repos accessible to the user. | RepoPublicityOwner -- ^ Only repos owned by the user. | RepoPublicityPublic -- ^ Only public repos. | RepoPublicityPrivate -- ^ Only private repos. | RepoPublicityMember -- ^ Only repos to which the user is a member but not an owner. deriving (Show, Eq, Ord, Enum, Bounded, Typeable, Data, Generic) -- | The value is the number of bytes of code written in that language. type Languages = HM.HashMap Language Int -- | A programming language. newtype Language = Language Text deriving (Show, Data, Typeable, Eq, Ord, Generic) getLanguage :: Language -> Text getLanguage (Language l) = l instance NFData Language where rnf = genericRnf instance Binary Language instance Hashable Language where hashWithSalt salt (Language l) = hashWithSalt salt l instance IsString Language where fromString = Language . fromString data Contributor -- | An existing Github user, with their number of contributions, avatar -- URL, login, URL, ID, and Gravatar ID. = KnownContributor !Int !URL !(Name User) !URL !(Id User) !Text -- | An unknown Github user with their number of contributions and recorded name. | AnonymousContributor !Int !Text deriving (Show, Data, Typeable, Eq, Ord, Generic) instance NFData Contributor where rnf = genericRnf instance Binary Contributor contributorToSimpleUser :: Contributor -> Maybe SimpleUser contributorToSimpleUser (AnonymousContributor _ _) = Nothing contributorToSimpleUser (KnownContributor _contributions avatarUrl name url uid _gravatarid) = Just $ SimpleUser uid name avatarUrl url -- JSON instances instance FromJSON Repo where parseJSON = withObject "Repo" $ \o -> Repo <$> o .:? "ssh_url" <*> o .: "description" <*> o .:? "created_at" <*> o .: "html_url" <*> o .:? "svn_url" <*> o .:? "forks" <*> o .:? "homepage" <*> o .: "fork" <*> o .:? "git_url" <*> o .: "private" <*> o .:? "archived" .!= False <*> o .:? "clone_url" <*> o .:? "size" <*> o .:? "updated_at" <*> o .:? "watchers" <*> o .: "owner" <*> o .: "name" <*> o .:? "language" <*> o .:? "default_branch" <*> o .:? "pushed_at" <*> o .: "id" <*> o .: "url" <*> o .:? "open_issues" <*> o .:? "has_wiki" <*> o .:? "has_issues" <*> o .:? "has_downloads" <*> o .:? "parent" <*> o .:? "source" <*> o .: "hooks_url" <*> o .: "stargazers_count" instance ToJSON NewRepo where toJSON (NewRepo { newRepoName = name , newRepoDescription = description , newRepoHomepage = homepage , newRepoPrivate = private , newRepoHasIssues = hasIssues , newRepoHasWiki = hasWiki , newRepoAutoInit = autoInit }) = object [ "name" .= name , "description" .= description , "homepage" .= homepage , "private" .= private , "has_issues" .= hasIssues , "has_wiki" .= hasWiki , "auto_init" .= autoInit ] instance ToJSON EditRepo where toJSON (EditRepo { editName = name , editDescription = description , editHomepage = homepage , editPublic = public , editHasIssues = hasIssues , editHasWiki = hasWiki , editHasDownloads = hasDownloads }) = object [ "name" .= name , "description" .= description , "homepage" .= homepage , "public" .= public , "has_issues" .= hasIssues , "has_wiki" .= hasWiki , "has_downloads" .= hasDownloads ] instance FromJSON RepoRef where parseJSON = withObject "RepoRef" $ \o -> RepoRef <$> o .: "owner" <*> o .: "name" instance FromJSON Contributor where parseJSON = withObject "Contributor" $ \o -> do t <- o .: "type" case (t :: Text) of "Anonymous" -> AnonymousContributor <$> o .: "contributions" <*> o .: "name" _ -> KnownContributor <$> o .: "contributions" <*> o .: "avatar_url" <*> o .: "login" <*> o .: "url" <*> o .: "id" <*> o .: "gravatar_id" instance FromJSON Language where parseJSON = withText "Language" (pure . Language) instance ToJSON Language where toJSON = toJSON . getLanguage #if MIN_VERSION_aeson(1,0,0) instance FromJSONKey Language where fromJSONKey = fromJSONKeyCoerce #else instance FromJSON a => FromJSON (HM.HashMap Language a) where parseJSON = fmap mapKeyLanguage . parseJSON where mapKeyLanguage :: HM.HashMap Text a -> HM.HashMap Language a #ifdef UNSAFE mapKeyLanguage = unsafeCoerce #else mapKeyLanguage = mapKey Language mapKey :: (Eq k2, Hashable k2) => (k1 -> k2) -> HM.HashMap k1 a -> HM.HashMap k2 a mapKey f = HM.fromList . map (first f) . HM.toList #endif #endif data ArchiveFormat = ArchiveFormatTarball -- ^ ".tar.gz" format | ArchiveFormatZipball -- ^ ".zip" format deriving (Show, Eq, Ord, Enum, Bounded, Typeable, Data, Generic) instance IsPathPart ArchiveFormat where toPathPart af = case af of ArchiveFormatTarball -> "tarball" ArchiveFormatZipball -> "zipball" github-0.23/src/GitHub/Data/Request.hs0000644000000000000000000001625407346545000015727 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE KindSignatures #-} {-# LANGUAGE StandaloneDeriving #-} ----------------------------------------------------------------------------- -- | -- License : BSD-3-Clause -- Maintainer : Oleg Grenrus -- module GitHub.Data.Request ( -- * Request Request, GenRequest (..), -- * Smart constructors query, pagedQuery, command, -- * Auxiliary types RW(..), CommandMethod(..), toMethod, FetchCount(..), MediaType (..), Paths, IsPathPart(..), QueryString, Count, ) where import GitHub.Data.Definitions (Count, IssueNumber, QueryString, unIssueNumber) import GitHub.Data.Id (Id, untagId) import GitHub.Data.Name (Name, untagName) import GitHub.Internal.Prelude import qualified Data.ByteString.Lazy as LBS import qualified Data.Text as T import qualified Network.HTTP.Types.Method as Method ------------------------------------------------------------------------------ -- Path parts ------------------------------------------------------------------------------ type Paths = [Text] class IsPathPart a where toPathPart :: a -> Text instance IsPathPart (Name a) where toPathPart = untagName instance IsPathPart (Id a) where toPathPart = T.pack . show . untagId instance IsPathPart IssueNumber where toPathPart = T.pack . show . unIssueNumber ------------------------------------------------------------------------------- -- Command Method ------------------------------------------------------------------------------- -- | Http method of requests with body. data CommandMethod = Post | Patch | Put | Delete deriving (Eq, Ord, Read, Show, Enum, Bounded, Typeable, Data, Generic) instance Hashable CommandMethod toMethod :: CommandMethod -> Method.Method toMethod Post = Method.methodPost toMethod Patch = Method.methodPatch toMethod Put = Method.methodPut toMethod Delete = Method.methodDelete ------------------------------------------------------------------------------- -- Fetch count ------------------------------------------------------------------------------- -- | 'PagedQuery' returns just some results, using this data we can specify how -- many pages we want to fetch. data FetchCount = FetchAtLeast !Word | FetchAll deriving (Eq, Ord, Read, Show, Generic, Typeable) -- | This instance is there mostly for 'fromInteger'. instance Num FetchCount where fromInteger = FetchAtLeast . fromInteger FetchAtLeast a + FetchAtLeast b = FetchAtLeast (a * b) _ + _ = FetchAll FetchAtLeast a * FetchAtLeast b = FetchAtLeast (a * b) _ * _ = FetchAll abs = error "abs @FetchCount: not implemented" signum = error "signum @FetchCount: not implemented" negate = error "negate @FetchCount: not implemented" instance Hashable FetchCount instance Binary FetchCount instance NFData FetchCount where rnf = genericRnf ------------------------------------------------------------------------------- -- MediaType ------------------------------------------------------------------------------- data MediaType a = MtJSON -- ^ @application/vnd.github.v3+json@ | MtRaw -- ^ @application/vnd.github.v3.raw@ | MtDiff -- ^ @application/vnd.github.v3.diff@ | MtPatch -- ^ @application/vnd.github.v3.patch@ | MtSha -- ^ @application/vnd.github.v3.sha@ | MtStar -- ^ @application/vnd.github.v3.star+json@ | MtRedirect -- ^ | MtStatus -- ^ Parse status | MtUnit -- ^ Always succeeds | MtPreview a -- ^ Some other (preview) type; this is an extension point. deriving (Eq, Ord, Read, Show, Typeable, Data, Generic) ------------------------------------------------------------------------------ -- RW ------------------------------------------------------------------------------ -- | Type used as with @DataKinds@ to tag whether requests need authentication -- or aren't read-only. data RW = RO -- ^ /Read-only/, doesn't necessarily requires authentication | RA -- ^ /Read authenticated/ | RW -- ^ /Read-write/, requires authentication deriving (Eq, Ord, Read, Show, Enum, Bounded, Typeable, Data, Generic) {- data SRO (rw :: RW) where ROO :: SRO 'RO ROA :: SRO 'RA -- | This class is used to describe read-only (but pontentially class IReadOnly (rw :: RW) where iro :: SRO rw instance IReadOnly 'RO where iro = ROO instance IReadOnly 'RA where iro = ROA -} ------------------------------------------------------------------------------- -- GitHub Request ------------------------------------------------------------------------------- -- | Github request data type. -- -- * @rw@ describes whether authentication is required. It's required for non-@GET@ requests. -- * @mt@ describes the media type, i.e. how the response should be interpreted. -- * @a@ is the result type -- -- /Note:/ 'Request' is not 'Functor' on purpose. data GenRequest (mt :: MediaType *) (rw :: RW) a where Query :: Paths -> QueryString -> GenRequest mt rw a PagedQuery :: Paths -> QueryString -> FetchCount -> GenRequest mt rw (Vector a) -- | Command Command :: CommandMethod -- ^ command -> Paths -- ^ path -> LBS.ByteString -- ^ body -> GenRequest mt 'RW a deriving (Typeable) -- | Most requests ask for @JSON@. type Request = GenRequest 'MtJSON ------------------------------------------------------------------------------- -- Smart constructors ------------------------------------------------------------------------------- query :: Paths -> QueryString -> Request mt a query ps qs = Query ps qs pagedQuery :: FromJSON a => Paths -> QueryString -> FetchCount -> Request mt (Vector a) pagedQuery ps qs fc = PagedQuery ps qs fc command :: CommandMethod -> Paths -> LBS.ByteString -> Request 'RW a command m ps body = Command m ps body ------------------------------------------------------------------------------- -- Instances ------------------------------------------------------------------------------- deriving instance Eq (GenRequest rw mt a) deriving instance Ord (GenRequest rw mt a) deriving instance Show (GenRequest rw mt a) instance Hashable (GenRequest rw mt a) where hashWithSalt salt (Query ps qs) = salt `hashWithSalt` (0 :: Int) `hashWithSalt` ps `hashWithSalt` qs hashWithSalt salt (PagedQuery ps qs l) = salt `hashWithSalt` (1 :: Int) `hashWithSalt` ps `hashWithSalt` qs `hashWithSalt` l hashWithSalt salt (Command m ps body) = salt `hashWithSalt` (2 :: Int) `hashWithSalt` m `hashWithSalt` ps `hashWithSalt` body -- TODO: Binary github-0.23/src/GitHub/Data/Reviews.hs0000644000000000000000000000577507346545000015731 0ustar0000000000000000module GitHub.Data.Reviews where import GitHub.Data.Definitions (SimpleUser) import GitHub.Data.Id (Id) import GitHub.Data.URL (URL) import GitHub.Internal.Prelude import Prelude () import Data.Text (Text) import qualified Data.Text as T data ReviewState = ReviewStatePending | ReviewStateApproved | ReviewStateDismissed | ReviewStateCommented | ReviewStateChangesRequested deriving (Show, Enum, Bounded, Eq, Ord, Generic) instance NFData ReviewState where rnf = genericRnf instance Binary ReviewState instance FromJSON ReviewState where parseJSON = withText "ReviewState" $ \t -> case T.toLower t of "approved" -> pure ReviewStateApproved "pending" -> pure ReviewStatePending "dismissed" -> pure ReviewStateDismissed "commented" -> pure ReviewStateCommented "changes_requested" -> pure ReviewStateChangesRequested _ -> fail $ "Unknown ReviewState: " <> T.unpack t data Review = Review { reviewBody :: !Text , reviewCommitId :: !Text , reviewState :: ReviewState , reviewSubmittedAt :: !UTCTime , reviewPullRequestUrl :: !URL , reviewHtmlUrl :: !Text , reviewUser :: !SimpleUser , reviewId :: !(Id Review) } deriving (Show, Generic) instance NFData Review where rnf = genericRnf instance Binary Review instance FromJSON Review where parseJSON = withObject "Review" $ \o -> Review <$> o .: "body" <*> o .: "commit_id" <*> o .: "state" <*> o .: "submitted_at" <*> o .: "pull_request_url" <*> o .: "html_url" <*> o .: "user" <*> o .: "id" data ReviewComment = ReviewComment { reviewCommentId :: !(Id ReviewComment) , reviewCommentUser :: !SimpleUser , reviewCommentBody :: !Text , reviewCommentUrl :: !URL , reviewCommentPullRequestReviewId :: !(Id Review) , reviewCommentDiffHunk :: !Text , reviewCommentPath :: !Text , reviewCommentPosition :: !Int , reviewCommentOriginalPosition :: !Int , reviewCommentCommitId :: !Text , reviewCommentOriginalCommitId :: !Text , reviewCommentCreatedAt :: !UTCTime , reviewCommentUpdatedAt :: !UTCTime , reviewCommentHtmlUrl :: !URL , reviewCommentPullRequestUrl :: !URL } deriving (Show, Generic) instance NFData ReviewComment where rnf = genericRnf instance Binary ReviewComment instance FromJSON ReviewComment where parseJSON = withObject "ReviewComment" $ \o -> ReviewComment <$> o .: "id" <*> o .: "user" <*> o .: "body" <*> o .: "url" <*> o .: "pull_request_review_id" <*> o .: "diff_hunk" <*> o .: "path" <*> o .: "position" <*> o .: "original_position" <*> o .: "commit_id" <*> o .: "original_commit_id" <*> o .: "created_at" <*> o .: "updated_at" <*> o .: "html_url" <*> o .: "pull_request_url" github-0.23/src/GitHub/Data/Search.hs0000644000000000000000000000266707346545000015507 0ustar0000000000000000----------------------------------------------------------------------------- -- | -- License : BSD-3-Clause -- Maintainer : Oleg Grenrus -- module GitHub.Data.Search where import GitHub.Data.Repos (Repo) import GitHub.Data.URL (URL) import GitHub.Internal.Prelude import Prelude () import qualified Data.Vector as V data SearchResult entity = SearchResult { searchResultTotalCount :: !Int , searchResultResults :: !(Vector entity) } deriving (Show, Data, Typeable, Eq, Ord, Generic) instance NFData entity => NFData (SearchResult entity) where rnf = genericRnf instance Binary entity => Binary (SearchResult entity) instance FromJSON entity => FromJSON (SearchResult entity) where parseJSON = withObject "SearchResult" $ \o -> SearchResult <$> o .: "total_count" <*> o .:? "items" .!= V.empty data Code = Code { codeName :: !Text , codePath :: !Text , codeSha :: !Text , codeUrl :: !URL , codeGitUrl :: !URL , codeHtmlUrl :: !URL , codeRepo :: !Repo } deriving (Show, Data, Typeable, Eq, Ord, Generic) instance NFData Code where rnf = genericRnf instance Binary Code instance FromJSON Code where parseJSON = withObject "Code" $ \o -> Code <$> o .: "name" <*> o .: "path" <*> o .: "sha" <*> o .: "url" <*> o .: "git_url" <*> o .: "html_url" <*> o .: "repository" github-0.23/src/GitHub/Data/Statuses.hs0000644000000000000000000000640207346545000016104 0ustar0000000000000000{-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE NoImplicitPrelude #-} {-# LANGUAGE OverloadedStrings #-} module GitHub.Data.Statuses where import GitHub.Data.Definitions import GitHub.Data.Name (Name) import GitHub.Data.Id (Id) import GitHub.Data.URL (URL) import GitHub.Internal.Prelude import Prelude () import GitHub.Data.GitData (Commit) import GitHub.Data.Repos (RepoRef) import qualified Data.Text as T data StatusState = StatusPending | StatusSuccess | StatusError | StatusFailure deriving (Show, Data, Enum, Bounded, Typeable, Eq, Ord, Generic) instance NFData StatusState where rnf = genericRnf instance Binary StatusState instance FromJSON StatusState where parseJSON = withText "StatusState" $ \t -> case T.toLower t of "pending" -> pure StatusPending "success" -> pure StatusSuccess "error" -> pure StatusError "failure" -> pure StatusFailure _ -> fail $ "Unknown StatusState: " <> T.unpack t instance ToJSON StatusState where toJSON StatusPending = String "pending" toJSON StatusSuccess = String "success" toJSON StatusError = String "error" toJSON StatusFailure = String "failure" data Status = Status { statusCreatedAt :: !UTCTime , statusUpdatedAt :: !UTCTime , statusState :: !StatusState , statusTargetUrl :: !(Maybe URL) , statusDescription :: !(Maybe Text) , statusId :: !(Id Status) , statusUrl :: !URL , statusContext :: !(Maybe Text) , statusCreator :: !(Maybe SimpleUser) } deriving (Show, Data, Typeable, Eq, Ord, Generic) instance FromJSON Status where parseJSON = withObject "Status" $ \o -> Status <$> o .: "created_at" <*> o .: "updated_at" <*> o .: "state" <*> o .:? "target_url" <*> o .:? "description" <*> o .: "id" <*> o .: "url" <*> o .:? "context" <*> o .:? "creator" data NewStatus = NewStatus { newStatusState :: !StatusState , newStatusTargetUrl :: !(Maybe URL) , newStatusDescription :: !(Maybe Text) , newStatusContext :: !(Maybe Text) } deriving (Show, Data, Typeable, Eq, Ord, Generic) instance NFData NewStatus where rnf = genericRnf instance Binary NewStatus instance ToJSON NewStatus where toJSON (NewStatus s t d c) = object $ filter notNull $ [ "state" .= s , "target_url" .= t , "description" .= d , "context" .= c ] where notNull (_, Null) = False notNull (_, _) = True data CombinedStatus = CombinedStatus { combinedStatusState :: !StatusState , combinedStatusSha :: !(Name Commit) , combinedStatusTotalCount :: !Int , combinedStatusStatuses :: !(Vector Status) , combinedStatusRepository :: !RepoRef , combinedStatusCommitUrl :: !URL , combinedStatusUrl :: !URL } deriving (Show, Data, Typeable, Eq, Ord, Generic) instance FromJSON CombinedStatus where parseJSON = withObject "CombinedStatus" $ \o -> CombinedStatus <$> o .: "state" <*> o .: "sha" <*> o .: "total_count" <*> o .: "statuses" <*> o .: "repository" <*> o .: "commit_url" <*> o .: "url" github-0.23/src/GitHub/Data/Teams.hs0000644000000000000000000001764307346545000015353 0ustar0000000000000000{-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE NoImplicitPrelude #-} {-# LANGUAGE OverloadedStrings #-} ----------------------------------------------------------------------------- -- | -- License : BSD-3-Clause -- Maintainer : Oleg Grenrus -- module GitHub.Data.Teams where import GitHub.Data.Definitions import GitHub.Data.Id (Id) import GitHub.Data.Name (Name) import GitHub.Data.Repos (Repo) import GitHub.Data.URL (URL) import GitHub.Internal.Prelude import Prelude () import qualified Data.Text as T data Privacy = PrivacyClosed | PrivacySecret deriving (Show, Data, Enum, Bounded, Typeable, Eq, Ord, Generic) instance NFData Privacy where rnf = genericRnf instance Binary Privacy data Permission = PermissionPull | PermissionPush | PermissionAdmin deriving (Show, Data, Enum, Bounded, Typeable, Eq, Ord, Generic) instance NFData Permission where rnf = genericRnf instance Binary Permission data AddTeamRepoPermission = AddTeamRepoPermission { addTeamRepoPermission :: !Permission } deriving (Show, Data, Typeable, Eq, Ord, Generic) instance NFData AddTeamRepoPermission where rnf = genericRnf instance Binary AddTeamRepoPermission data SimpleTeam = SimpleTeam { simpleTeamId :: !(Id Team) , simpleTeamUrl :: !URL , simpleTeamName :: !Text -- TODO (0.15.0): unify this and 'simpleTeamSlug' as in 'Team'. , simpleTeamSlug :: !(Name Team) , simpleTeamDescription :: !(Maybe Text) , simpleTeamPrivacy :: !(Maybe Privacy) , simpleTeamPermission :: !Permission , simpleTeamMembersUrl :: !URL , simpleTeamRepositoriesUrl :: !URL } deriving (Show, Data, Typeable, Eq, Ord, Generic) instance NFData SimpleTeam where rnf = genericRnf instance Binary SimpleTeam data Team = Team { teamId :: !(Id Team) , teamUrl :: !URL , teamName :: !Text , teamSlug :: !(Name Team) , teamDescription :: !(Maybe Text) , teamPrivacy :: !(Maybe Privacy) , teamPermission :: !Permission , teamMembersUrl :: !URL , teamRepositoriesUrl :: !URL , teamMembersCount :: !Int , teamReposCount :: !Int , teamOrganization :: !SimpleOrganization } deriving (Show, Data, Typeable, Eq, Ord, Generic) instance NFData Team where rnf = genericRnf instance Binary Team data CreateTeam = CreateTeam { createTeamName :: !(Name Team) , createTeamDescription :: !(Maybe Text) , createTeamRepoNames :: !(Vector (Name Repo)) -- , createTeamPrivacy :: Privacy , createTeamPermission :: Permission } deriving (Show, Data, Typeable, Eq, Ord, Generic) instance NFData CreateTeam where rnf = genericRnf instance Binary CreateTeam data EditTeam = EditTeam { editTeamName :: !(Name Team) , editTeamDescription :: !(Maybe Text) -- , editTeamPrivacy :: Privacy , editTeamPermission :: !Permission } deriving (Show, Data, Typeable, Eq, Ord, Generic) instance NFData EditTeam where rnf = genericRnf instance Binary EditTeam data Role = RoleMaintainer | RoleMember deriving (Show, Data, Typeable, Eq, Ord, Generic) instance NFData Role instance Binary Role data ReqState = StatePending | StateActive deriving (Show, Data, Typeable, Eq, Ord, Generic) instance NFData ReqState where rnf = genericRnf instance Binary ReqState data TeamMembership = TeamMembership { teamMembershipUrl :: !URL , teamMembershipRole :: !Role , teamMembershipReqState :: !ReqState } deriving (Show, Data, Typeable, Eq, Ord, Generic) instance NFData TeamMembership where rnf = genericRnf instance Binary TeamMembership data CreateTeamMembership = CreateTeamMembership { createTeamMembershipRole :: !Role } deriving (Show, Data, Typeable, Eq, Ord, Generic) instance NFData CreateTeamMembership where rnf = genericRnf instance Binary CreateTeamMembership -- JSON Instances instance FromJSON SimpleTeam where parseJSON = withObject "SimpleTeam" $ \o -> SimpleTeam <$> o .: "id" <*> o .: "url" <*> o .: "name" <*> o .: "slug" <*> o .:?"description" .!= Nothing <*> o .:?"privacy" .!= Nothing <*> o .: "permission" <*> o .: "members_url" <*> o .: "repositories_url" instance FromJSON Team where parseJSON = withObject "Team" $ \o -> Team <$> o .: "id" <*> o .: "url" <*> o .: "name" <*> o .: "slug" <*> o .:?"description" .!= Nothing <*> o .:?"privacy" .!= Nothing <*> o .: "permission" <*> o .: "members_url" <*> o .: "repositories_url" <*> o .: "members_count" <*> o .: "repos_count" <*> o .: "organization" instance ToJSON CreateTeam where toJSON (CreateTeam name desc repo_names {-privacy-} permissions) = object [ "name" .= name , "description" .= desc , "repo_names" .= repo_names {-, "privacy" .= privacy-} , "permissions" .= permissions ] instance ToJSON EditTeam where toJSON (EditTeam name desc {-privacy-} permissions) = object [ "name" .= name , "description" .= desc {-, "privacy" .= privacy-} , "permissions" .= permissions ] instance FromJSON TeamMembership where parseJSON = withObject "TeamMembership" $ \o -> TeamMembership <$> o .: "url" <*> o .: "role" <*> o .: "state" instance FromJSON CreateTeamMembership where parseJSON = withObject "CreateTeamMembership" $ \o -> CreateTeamMembership <$> o .: "role" instance ToJSON CreateTeamMembership where toJSON (CreateTeamMembership { createTeamMembershipRole = role }) = object [ "role" .= role ] instance FromJSON AddTeamRepoPermission where parseJSON = withObject "AddTeamRepoPermission" $ \o -> AddTeamRepoPermission <$> o .: "permission" instance ToJSON AddTeamRepoPermission where toJSON (AddTeamRepoPermission { addTeamRepoPermission = permission}) = object [ "permission" .= permission ] instance FromJSON Role where parseJSON = withText "Role" $ \t -> case T.toLower t of "maintainer" -> pure RoleMaintainer "member" -> pure RoleMember _ -> fail $ "Unknown Role: " <> T.unpack t instance ToJSON Role where toJSON RoleMaintainer = String "maintainer" toJSON RoleMember = String "member" instance FromJSON Permission where parseJSON = withText "Permission" $ \t -> case T.toLower t of "pull" -> pure PermissionPull "push" -> pure PermissionPush "admin" -> pure PermissionAdmin _ -> fail $ "Unknown Permission: " <> T.unpack t instance ToJSON Permission where toJSON PermissionPull = "pull" toJSON PermissionPush = "push" toJSON PermissionAdmin = "admin" instance FromJSON Privacy where parseJSON = withText "Privacy" $ \t -> case T.toLower t of "secret" -> pure PrivacySecret "closed" -> pure PrivacyClosed _ -> fail $ "Unknown Privacy: " <> T.unpack t instance ToJSON Privacy where toJSON PrivacySecret = String "secret" toJSON PrivacyClosed = String "closed" instance FromJSON ReqState where parseJSON = withText "ReqState" $ \t -> case T.toLower t of "active" -> pure StateActive "pending" -> pure StatePending _ -> fail $ "Unknown ReqState: " <> T.unpack t instance ToJSON ReqState where toJSON StateActive = String "active" toJSON StatePending = String "pending" -- | Filters members returned by their role in the team. data TeamMemberRole = TeamMemberRoleAll -- ^ all members of the team. | TeamMemberRoleMaintainer -- ^ team maintainers | TeamMemberRoleMember -- ^ normal members of the team. deriving (Show, Eq, Ord, Enum, Bounded, Typeable, Data, Generic) github-0.23/src/GitHub/Data/URL.hs0000644000000000000000000000127107346545000014732 0ustar0000000000000000----------------------------------------------------------------------------- -- | -- License : BSD-3-Clause -- Maintainer : Oleg Grenrus -- module GitHub.Data.URL ( URL(..), getUrl, ) where import GitHub.Internal.Prelude import Prelude () -- | Data representing URLs in responses. -- -- /N.B./ syntactical validity is not verified. newtype URL = URL Text deriving (Eq, Ord, Show, Generic, Typeable, Data) getUrl :: URL -> Text getUrl (URL url) = url instance NFData URL where rnf = genericRnf instance Binary URL instance ToJSON URL where toJSON (URL url) = toJSON url instance FromJSON URL where parseJSON = withText "URL" (pure . URL) github-0.23/src/GitHub/Data/Webhooks.hs0000644000000000000000000003240307346545000016052 0ustar0000000000000000----------------------------------------------------------------------------- -- | -- License : BSD-3-Clause -- Maintainer : Oleg Grenrus -- module GitHub.Data.Webhooks where import GitHub.Data.Id (Id) import GitHub.Data.URL (URL) import GitHub.Internal.Prelude import Prelude () import qualified Data.Map as M import qualified Data.Text as T data RepoWebhook = RepoWebhook { repoWebhookUrl :: !URL , repoWebhookTestUrl :: !URL , repoWebhookId :: !(Id RepoWebhook) , repoWebhookName :: !Text , repoWebhookActive :: !Bool , repoWebhookEvents :: !(Vector RepoWebhookEvent) , repoWebhookConfig :: !(M.Map Text Text) , repoWebhookLastResponse :: !RepoWebhookResponse , repoWebhookUpdatedAt :: !UTCTime , repoWebhookCreatedAt :: !UTCTime } deriving (Show, Data, Typeable, Eq, Ord, Generic) instance NFData RepoWebhook where rnf = genericRnf instance Binary RepoWebhook -- | See . data RepoWebhookEvent = WebhookWildcardEvent | WebhookCheckRunEvent | WebhookCheckSuiteEvent | WebhookCommitCommentEvent | WebhookContentReferenceEvent | WebhookCreateEvent | WebhookDeleteEvent | WebhookDeployKeyEvent | WebhookDeploymentEvent | WebhookDeploymentStatusEvent | WebhookDownloadEvent | WebhookFollowEvent | WebhookForkEvent | WebhookForkApplyEvent | WebhookGitHubAppAuthorizationEvent | WebhookGistEvent | WebhookGollumEvent | WebhookInstallationEvent | WebhookInstallationRepositoriesEvent | WebhookIssueCommentEvent | WebhookIssuesEvent | WebhookLabelEvent | WebhookMarketplacePurchaseEvent | WebhookMemberEvent | WebhookMembershipEvent | WebhookMetaEvent | WebhookMilestoneEvent | WebhookOrganizationEvent | WebhookOrgBlockEvent | WebhookPageBuildEvent | WebhookPingEvent | WebhookProjectCardEvent | WebhookProjectColumnEvent | WebhookProjectEvent | WebhookPublicEvent | WebhookPullRequestEvent | WebhookPullRequestReviewEvent | WebhookPullRequestReviewCommentEvent | WebhookPushEvent | WebhookRegistryPackageEvent | WebhookReleaseEvent | WebhookRepositoryEvent | WebhookRepositoryImportEvent | WebhookRepositoryVulnerabilityAlertEvent | WebhookSecurityAdvisoryEvent | WebhookStarEvent | WebhookStatusEvent | WebhookTeamEvent | WebhookTeamAddEvent | WebhookWatchEvent deriving (Show, Data, Typeable, Eq, Ord, Generic) instance NFData RepoWebhookEvent where rnf = genericRnf instance Binary RepoWebhookEvent data RepoWebhookResponse = RepoWebhookResponse { repoWebhookResponseCode :: !(Maybe Int) , repoWebhookResponseStatus :: !Text , repoWebhookResponseMessage :: !(Maybe Text) } deriving (Show, Data, Typeable, Eq, Ord, Generic) instance NFData RepoWebhookResponse where rnf = genericRnf instance Binary RepoWebhookResponse data PingEvent = PingEvent { pingEventZen :: !Text , pingEventHook :: !RepoWebhook , pingEventHookId :: !(Id RepoWebhook) } deriving (Show, Data, Typeable, Eq, Ord, Generic) instance NFData PingEvent where rnf = genericRnf instance Binary PingEvent data NewRepoWebhook = NewRepoWebhook { newRepoWebhookName :: !Text , newRepoWebhookConfig :: !(M.Map Text Text) , newRepoWebhookEvents :: !(Maybe (Vector RepoWebhookEvent)) , newRepoWebhookActive :: !(Maybe Bool) } deriving (Eq, Ord, Show, Typeable, Data, Generic) instance NFData NewRepoWebhook where rnf = genericRnf instance Binary NewRepoWebhook data EditRepoWebhook = EditRepoWebhook { editRepoWebhookConfig :: !(Maybe (M.Map Text Text)) , editRepoWebhookEvents :: !(Maybe (Vector RepoWebhookEvent)) , editRepoWebhookAddEvents :: !(Maybe (Vector RepoWebhookEvent)) , editRepoWebhookRemoveEvents :: !(Maybe (Vector RepoWebhookEvent)) , editRepoWebhookActive :: !(Maybe Bool) } deriving (Eq, Ord, Show, Typeable, Data, Generic) instance NFData EditRepoWebhook where rnf = genericRnf instance Binary EditRepoWebhook -- JSON instances instance FromJSON RepoWebhookEvent where parseJSON = withText "RepoWebhookEvent" $ \t -> case T.toLower t of "*" -> pure WebhookWildcardEvent "check_run" -> pure WebhookCheckRunEvent "check_suite" -> pure WebhookCheckSuiteEvent "commit_comment" -> pure WebhookCommitCommentEvent "content_reference" -> pure WebhookContentReferenceEvent "create" -> pure WebhookCreateEvent "delete" -> pure WebhookDeleteEvent "deploy_key" -> pure WebhookDeployKeyEvent "deployment" -> pure WebhookDeploymentEvent "deployment_status" -> pure WebhookDeploymentStatusEvent "download" -> pure WebhookDownloadEvent "follow" -> pure WebhookFollowEvent "fork" -> pure WebhookForkEvent "fork_apply" -> pure WebhookForkApplyEvent "github_app_authorization" -> pure WebhookGitHubAppAuthorizationEvent "gist" -> pure WebhookGistEvent "gollum" -> pure WebhookGollumEvent "installation" -> pure WebhookInstallationEvent "installation_repositories" -> pure WebhookInstallationRepositoriesEvent "issue_comment" -> pure WebhookIssueCommentEvent "issues" -> pure WebhookIssuesEvent "label" -> pure WebhookLabelEvent "marketplace_purchase" -> pure WebhookMarketplacePurchaseEvent "member" -> pure WebhookMemberEvent "membership" -> pure WebhookMembershipEvent "meta" -> pure WebhookMetaEvent "milestone" -> pure WebhookMilestoneEvent "organization" -> pure WebhookOrganizationEvent "org_block" -> pure WebhookOrgBlockEvent "page_build" -> pure WebhookPageBuildEvent "ping" -> pure WebhookPingEvent "project_card" -> pure WebhookProjectCardEvent "project_column" -> pure WebhookProjectColumnEvent "project" -> pure WebhookProjectEvent "public" -> pure WebhookPublicEvent "pull_request" -> pure WebhookPullRequestEvent "pull_request_review" -> pure WebhookPullRequestReviewEvent "pull_request_review_comment" -> pure WebhookPullRequestReviewCommentEvent "push" -> pure WebhookPushEvent "registry_package" -> pure WebhookRegistryPackageEvent "release" -> pure WebhookReleaseEvent "repository" -> pure WebhookRepositoryEvent "repository_import" -> pure WebhookRepositoryImportEvent "repository_vulnerability_alert" -> pure WebhookRepositoryVulnerabilityAlertEvent "security_advisory" -> pure WebhookSecurityAdvisoryEvent "star" -> pure WebhookStarEvent "status" -> pure WebhookStatusEvent "team" -> pure WebhookTeamEvent "team_add" -> pure WebhookTeamAddEvent "watch" -> pure WebhookWatchEvent _ -> fail $ "Unknown RepoWebhookEvent: " <> T.unpack t instance ToJSON RepoWebhookEvent where toJSON WebhookWildcardEvent = String "*" toJSON WebhookCheckRunEvent = String "check_run" toJSON WebhookCheckSuiteEvent = String "check_suite" toJSON WebhookCommitCommentEvent = String "commit_comment" toJSON WebhookContentReferenceEvent = String "content_reference" toJSON WebhookCreateEvent = String "create" toJSON WebhookDeleteEvent = String "delete" toJSON WebhookDeployKeyEvent = String "deploy_key" toJSON WebhookDeploymentEvent = String "deployment" toJSON WebhookDeploymentStatusEvent = String "deployment_status" toJSON WebhookDownloadEvent = String "download" toJSON WebhookFollowEvent = String "follow" toJSON WebhookForkEvent = String "fork" toJSON WebhookForkApplyEvent = String "fork_apply" toJSON WebhookGitHubAppAuthorizationEvent = String "github_app_authorization" toJSON WebhookGistEvent = String "gist" toJSON WebhookGollumEvent = String "gollum" toJSON WebhookInstallationEvent = String "installation" toJSON WebhookInstallationRepositoriesEvent = String "installation_repositories" toJSON WebhookIssueCommentEvent = String "issue_comment" toJSON WebhookIssuesEvent = String "issues" toJSON WebhookLabelEvent = String "label" toJSON WebhookMarketplacePurchaseEvent = String "marketplace_purchase" toJSON WebhookMemberEvent = String "member" toJSON WebhookMembershipEvent = String "membership" toJSON WebhookMetaEvent = String "meta" toJSON WebhookMilestoneEvent = String "milestone" toJSON WebhookOrganizationEvent = String "organization" toJSON WebhookOrgBlockEvent = String "org_block" toJSON WebhookPageBuildEvent = String "page_build" toJSON WebhookPingEvent = String "ping" toJSON WebhookProjectCardEvent = String "project_card" toJSON WebhookProjectColumnEvent = String "project_column" toJSON WebhookProjectEvent = String "project" toJSON WebhookPublicEvent = String "public" toJSON WebhookPullRequestEvent = String "pull_request" toJSON WebhookPullRequestReviewEvent = String "pull_request_review" toJSON WebhookPullRequestReviewCommentEvent = String "pull_request_review_comment" toJSON WebhookPushEvent = String "push" toJSON WebhookRegistryPackageEvent = String "registry_package" toJSON WebhookReleaseEvent = String "release" toJSON WebhookRepositoryEvent = String "repository" toJSON WebhookRepositoryImportEvent = String "repository_import" toJSON WebhookRepositoryVulnerabilityAlertEvent = String "repository_vulnerability_alert" toJSON WebhookSecurityAdvisoryEvent = String "security_advisory" toJSON WebhookStarEvent = String "star" toJSON WebhookStatusEvent = String "status" toJSON WebhookTeamEvent = String "team" toJSON WebhookTeamAddEvent = String "team_add" toJSON WebhookWatchEvent = String "watch" instance FromJSON RepoWebhook where parseJSON = withObject "RepoWebhook" $ \o -> RepoWebhook <$> o .: "url" <*> o .: "test_url" <*> o .: "id" <*> o .: "name" <*> o .: "active" <*> o .: "events" <*> o .: "config" <*> o .: "last_response" <*> o .: "updated_at" <*> o .: "created_at" instance FromJSON RepoWebhookResponse where parseJSON = withObject "RepoWebhookResponse" $ \o -> RepoWebhookResponse <$> o .: "code" <*> o .: "status" <*> o .: "message" instance ToJSON NewRepoWebhook where toJSON (NewRepoWebhook { newRepoWebhookName = name , newRepoWebhookConfig = config , newRepoWebhookEvents = events , newRepoWebhookActive = active }) = object [ "name" .= name , "config" .= config , "events" .= events , "active" .= active ] instance ToJSON EditRepoWebhook where toJSON (EditRepoWebhook { editRepoWebhookConfig = config , editRepoWebhookEvents = events , editRepoWebhookAddEvents = addEvents , editRepoWebhookRemoveEvents = removeEvents , editRepoWebhookActive = active }) = object [ "config" .= config , "events" .= events , "add_events" .= addEvents , "remove_events" .= removeEvents , "active" .= active ] instance FromJSON PingEvent where parseJSON = withObject "PingEvent" $ \o -> PingEvent <$> o .: "zen" <*> o .: "hook" <*> o .: "hook_id" github-0.23/src/GitHub/Data/Webhooks/0000755000000000000000000000000007346545000015514 5ustar0000000000000000github-0.23/src/GitHub/Data/Webhooks/Validate.hs0000644000000000000000000000232707346545000017605 0ustar0000000000000000----------------------------------------------------------------------------- -- | -- License : BSD-3-Clause -- Maintainer : Oleg Grenrus -- -- Verification of incomming webhook payloads, as described at -- module GitHub.Data.Webhooks.Validate ( isValidPayload ) where import GitHub.Internal.Prelude import Prelude () import Crypto.Hash.SHA1 (hmac) import Data.ByteString (ByteString) import qualified Data.ByteString.Base16 as Hex import qualified Data.Text.Encoding as TE -- | Validates a given payload against a given HMAC hexdigest using a given -- secret. -- Returns 'True' iff the given hash is non-empty and it's a valid signature of -- the payload. isValidPayload :: Text -- ^ the secret -> Maybe Text -- ^ the hash provided by the remote party -- in @X-Hub-Signature@ (if any), -- including the 'sha1=...' prefix -> ByteString -- ^ the body -> Bool isValidPayload secret shaOpt payload = maybe False (sign ==) shaOptBS where shaOptBS = TE.encodeUtf8 <$> shaOpt hexDigest = Hex.encode hm = hmac (TE.encodeUtf8 secret) payload sign = "sha1=" <> hexDigest hm github-0.23/src/GitHub/Endpoints/Activity/0000755000000000000000000000000007346545000016621 5ustar0000000000000000github-0.23/src/GitHub/Endpoints/Activity/Events.hs0000644000000000000000000000202307346545000020416 0ustar0000000000000000----------------------------------------------------------------------------- -- | -- License : BSD-3-Clause -- Maintainer : Oleg Grenrus -- -- The events API as described on . module GitHub.Endpoints.Activity.Events ( -- * Events repositoryEventsR, userEventsR, module GitHub.Data, ) where import GitHub.Data import GitHub.Internal.Prelude import Prelude () -- | List repository events. -- See repositoryEventsR :: Name Owner -> Name Repo -> FetchCount -> Request 'RO (Vector Event) repositoryEventsR user repo = pagedQuery ["repos", toPathPart user, toPathPart repo, "events"] [] -- | List user public events. -- See userEventsR :: Name User -> FetchCount -> Request 'RO (Vector Event) userEventsR user = pagedQuery ["users", toPathPart user, "events", "public"] [] github-0.23/src/GitHub/Endpoints/Activity/Notifications.hs0000644000000000000000000000315707346545000021774 0ustar0000000000000000----------------------------------------------------------------------------- -- | -- License : BSD-3-Clause -- Maintainer : Oleg Grenrus -- -- The repo watching API as described on -- . module GitHub.Endpoints.Activity.Notifications where import GitHub.Data import GitHub.Internal.Prelude import GitHub.Request import Prelude () getNotifications :: Auth -> IO (Either Error (Vector Notification)) getNotifications auth = executeRequest auth $ getNotificationsR FetchAll -- | List your notifications. -- See getNotificationsR :: FetchCount -> Request 'RA (Vector Notification) getNotificationsR = pagedQuery ["notifications"] [] markNotificationAsRead :: Auth -> Id Notification -> IO (Either Error ()) markNotificationAsRead auth nid = executeRequest auth $ markNotificationAsReadR nid -- | Mark a thread as read. -- See markNotificationAsReadR :: Id Notification -> GenRequest 'MtUnit 'RW () markNotificationAsReadR nid = Command Patch ["notifications", "threads", toPathPart nid] (encode ()) markNotificationsAsRead :: Auth -> IO (Either Error ()) markNotificationsAsRead auth = executeRequest auth markAllNotificationsAsReadR -- | Mark as read. -- See markAllNotificationsAsReadR :: GenRequest 'MtUnit 'RW () markAllNotificationsAsReadR = Command Put ["notifications"] $ encode emptyObject github-0.23/src/GitHub/Endpoints/Activity/Starring.hs0000644000000000000000000000725507346545000020757 0ustar0000000000000000----------------------------------------------------------------------------- -- | -- License : BSD-3-Clause -- Maintainer : Oleg Grenrus -- -- The repo starring API as described on -- . module GitHub.Endpoints.Activity.Starring ( stargazersFor, stargazersForR, reposStarredBy, reposStarredByR, myStarred, myStarredR, myStarredAcceptStar, myStarredAcceptStarR, starRepo, starRepoR, unstarRepo, unstarRepoR, module GitHub.Data, ) where import GitHub.Auth import GitHub.Data import GitHub.Internal.Prelude import GitHub.Request import Prelude () -- | The list of users that have starred the specified Github repo. -- -- > userInfoFor' Nothing "mike-burns" stargazersFor :: Maybe Auth -> Name Owner -> Name Repo -> IO (Either Error (Vector SimpleUser)) stargazersFor auth user repo = executeRequestMaybe auth $ stargazersForR user repo FetchAll -- | List Stargazers. -- See stargazersForR :: Name Owner -> Name Repo -> FetchCount -> Request k (Vector SimpleUser) stargazersForR user repo = pagedQuery ["repos", toPathPart user, toPathPart repo, "stargazers"] [] -- | All the public repos starred by the specified user. -- -- > reposStarredBy Nothing "croaky" reposStarredBy :: Maybe Auth -> Name Owner -> IO (Either Error (Vector Repo)) reposStarredBy auth user = executeRequestMaybe auth $ reposStarredByR user FetchAll -- | List repositories being starred. -- See reposStarredByR :: Name Owner -> FetchCount -> Request k (Vector Repo) reposStarredByR user = pagedQuery ["users", toPathPart user, "starred"] [] -- | All the repos starred by the authenticated user. myStarred :: Auth -> IO (Either Error (Vector Repo)) myStarred auth = executeRequest auth $ myStarredR FetchAll -- | All the repos starred by the authenticated user. -- See myStarredR :: FetchCount -> Request 'RA (Vector Repo) myStarredR = pagedQuery ["user", "starred"] [] -- | All the repos starred by the authenticated user. myStarredAcceptStar :: Auth -> IO (Either Error (Vector RepoStarred)) myStarredAcceptStar auth = executeRequest auth $ myStarredAcceptStarR FetchAll -- | All the repos starred by the authenticated user. -- See myStarredAcceptStarR :: FetchCount -> GenRequest 'MtStar 'RA (Vector RepoStarred) myStarredAcceptStarR = PagedQuery ["user", "starred"] [] -- | Star a repo by the authenticated user. starRepo :: Auth -> Name Owner -> Name Repo -> IO (Either Error ()) starRepo auth user repo = executeRequest auth $ starRepoR user repo -- | Star a repo by the authenticated user. -- See starRepoR :: Name Owner -> Name Repo -> GenRequest 'MtUnit 'RW () starRepoR user repo = Command Put paths mempty where paths = ["user", "starred", toPathPart user, toPathPart repo] -- | Unstar a repo by the authenticated user. unstarRepo :: Auth -> Name Owner -> Name Repo -> IO (Either Error ()) unstarRepo auth user repo = executeRequest auth $ unstarRepoR user repo -- | Unstar a repo by the authenticated user. -- See unstarRepoR :: Name Owner -> Name Repo -> GenRequest 'MtUnit 'RW () unstarRepoR user repo = Command Delete paths mempty where paths = ["user", "starred", toPathPart user, toPathPart repo] github-0.23/src/GitHub/Endpoints/Activity/Watching.hs0000644000000000000000000000436307346545000020727 0ustar0000000000000000----------------------------------------------------------------------------- -- | -- License : BSD-3-Clause -- Maintainer : Oleg Grenrus -- -- The repo watching API as described on -- . module GitHub.Endpoints.Activity.Watching ( watchersFor, watchersFor', watchersForR, reposWatchedBy, reposWatchedBy', reposWatchedByR, module GitHub.Data, ) where import GitHub.Auth import GitHub.Data import GitHub.Internal.Prelude import GitHub.Request import Prelude () -- | The list of users that are watching the specified Github repo. -- -- > watchersFor "thoughtbot" "paperclip" watchersFor :: Name Owner -> Name Repo -> IO (Either Error (Vector SimpleUser)) watchersFor = watchersFor' Nothing -- | The list of users that are watching the specified Github repo. -- With authentication -- -- > watchersFor' (Just $ BasicAuth "github-username" "github-password") "thoughtbot" "paperclip" watchersFor' :: Maybe Auth -> Name Owner -> Name Repo -> IO (Either Error (Vector SimpleUser)) watchersFor' auth user repo = executeRequestMaybe auth $ watchersForR user repo FetchAll -- | List watchers. -- See watchersForR :: Name Owner -> Name Repo -> FetchCount -> Request k (Vector SimpleUser) watchersForR user repo limit = pagedQuery ["repos", toPathPart user, toPathPart repo, "watchers"] [] limit -- | All the public repos watched by the specified user. -- -- > reposWatchedBy "croaky" reposWatchedBy :: Name Owner -> IO (Either Error (Vector Repo)) reposWatchedBy = reposWatchedBy' Nothing -- | All the public repos watched by the specified user. -- With authentication -- -- > reposWatchedBy' (Just $ BasicAuth "github-username" "github-password") "croaky" reposWatchedBy' :: Maybe Auth -> Name Owner -> IO (Either Error (Vector Repo)) reposWatchedBy' auth user = executeRequestMaybe auth $ reposWatchedByR user FetchAll -- | List repositories being watched. -- See reposWatchedByR :: Name Owner -> FetchCount -> Request k (Vector Repo) reposWatchedByR user = pagedQuery ["users", toPathPart user, "subscriptions"] [] github-0.23/src/GitHub/Endpoints/0000755000000000000000000000000007346545000015025 5ustar0000000000000000github-0.23/src/GitHub/Endpoints/Gists.hs0000644000000000000000000000614107346545000016454 0ustar0000000000000000----------------------------------------------------------------------------- -- | -- License : BSD-3-Clause -- Maintainer : Oleg Grenrus -- -- The gists API as described at . module GitHub.Endpoints.Gists ( gists, gists', gistsR, gist, gist', gistR, starGist, starGistR, unstarGist, unstarGistR, deleteGist, deleteGistR, module GitHub.Data, ) where import GitHub.Data import GitHub.Internal.Prelude import GitHub.Request import Prelude () -- | The list of all gists created by the user -- -- > gists' (Just $ BasicAuth "github-username" "github-password") "mike-burns" gists' :: Maybe Auth -> Name Owner -> IO (Either Error (Vector Gist)) gists' auth user = executeRequestMaybe auth $ gistsR user FetchAll -- | The list of all public gists created by the user. -- -- > gists "mike-burns" gists :: Name Owner -> IO (Either Error (Vector Gist)) gists = gists' Nothing -- | List gists. -- See gistsR :: Name Owner -> FetchCount -> Request k (Vector Gist) gistsR user = pagedQuery ["users", toPathPart user, "gists"] [] -- | A specific gist, given its id, with authentication credentials -- -- > gist' (Just $ BasicAuth "github-username" "github-password") "225074" gist' :: Maybe Auth -> Name Gist -> IO (Either Error Gist) gist' auth gid = executeRequestMaybe auth $ gistR gid -- | A specific gist, given its id. -- -- > gist "225074" gist :: Name Gist -> IO (Either Error Gist) gist = gist' Nothing -- | Query a single gist. -- See gistR :: Name Gist -> Request k Gist gistR gid = query ["gists", toPathPart gid] [] -- | Star a gist by the authenticated user. -- -- > starGist (BasicAuth "github-username" "github-password") "225074" starGist :: Auth -> Name Gist -> IO (Either Error ()) starGist auth gid = executeRequest auth $ starGistR gid -- | Star a gist by the authenticated user. -- See starGistR :: Name Gist -> GenRequest 'MtUnit 'RW () starGistR gid = Command Put ["gists", toPathPart gid, "star"] mempty -- | Unstar a gist by the authenticated user. -- -- > unstarGist (BasicAuth "github-username" "github-password") "225074" unstarGist :: Auth -> Name Gist -> IO (Either Error ()) unstarGist auth gid = executeRequest auth $ unstarGistR gid -- | Unstar a gist by the authenticated user. -- See unstarGistR :: Name Gist -> GenRequest 'MtUnit 'RW () unstarGistR gid = Command Delete ["gists", toPathPart gid, "star"] mempty -- | Delete a gist by the authenticated user. -- -- > deleteGist (BasicAuth "github-username" "github-password") "225074" deleteGist :: Auth -> Name Gist -> IO (Either Error ()) deleteGist auth gid = executeRequest auth $ deleteGistR gid -- | Delete a gist by the authenticated user. -- See deleteGistR :: Name Gist -> GenRequest 'MtUnit 'RW () deleteGistR gid = Command Delete ["gists", toPathPart gid] mempty github-0.23/src/GitHub/Endpoints/Gists/0000755000000000000000000000000007346545000016116 5ustar0000000000000000github-0.23/src/GitHub/Endpoints/Gists/Comments.hs0000644000000000000000000000257707346545000020252 0ustar0000000000000000----------------------------------------------------------------------------- -- | -- License : BSD-3-Clause -- Maintainer : Oleg Grenrus -- -- The loving comments people have left on Gists, described on -- . module GitHub.Endpoints.Gists.Comments ( commentsOn, commentsOnR, comment, gistCommentR, module GitHub.Data, ) where import GitHub.Data import GitHub.Internal.Prelude import GitHub.Request import Prelude () -- | All the comments on a Gist, given the Gist ID. -- -- > commentsOn "1174060" commentsOn :: Name Gist -> IO (Either Error (Vector GistComment)) commentsOn gid = executeRequest' $ commentsOnR gid FetchAll -- | List comments on a gist. -- See commentsOnR :: Name Gist -> FetchCount -> Request k (Vector GistComment) commentsOnR gid = pagedQuery ["gists", toPathPart gid, "comments"] [] -- | A specific comment, by the comment ID. -- -- > comment (Id 62449) comment :: Id GistComment -> IO (Either Error GistComment) comment cid = executeRequest' $ gistCommentR cid -- | Query a single comment. -- See gistCommentR :: Id GistComment -> Request k GistComment gistCommentR cid = query ["gists", "comments", toPathPart cid] [] github-0.23/src/GitHub/Endpoints/GitData/0000755000000000000000000000000007346545000016342 5ustar0000000000000000github-0.23/src/GitHub/Endpoints/GitData/Blobs.hs0000644000000000000000000000237607346545000017747 0ustar0000000000000000----------------------------------------------------------------------------- -- | -- License : BSD-3-Clause -- Maintainer : Oleg Grenrus -- -- The API for dealing with git blobs from Github repos, as described in -- . module GitHub.Endpoints.GitData.Blobs ( blob, blob', blobR, module GitHub.Data, ) where import GitHub.Data import GitHub.Internal.Prelude import GitHub.Request import Prelude () -- | Query a blob by SHA1. -- -- > blob' (Just $ BasicAuth "github-username" "github-password") "thoughtbot" "paperclip" "bc5c51d1ece1ee45f94b056a0f5a1674d7e8cba9" blob' :: Maybe Auth -> Name Owner -> Name Repo -> Name Blob -> IO (Either Error Blob) blob' auth user repo sha = executeRequestMaybe auth $ blobR user repo sha -- | Query a blob by SHA1. -- -- > blob "thoughtbot" "paperclip" "bc5c51d1ece1ee45f94b056a0f5a1674d7e8cba9" blob :: Name Owner -> Name Repo -> Name Blob -> IO (Either Error Blob) blob = blob' Nothing -- | Query a blob. -- See blobR :: Name Owner -> Name Repo -> Name Blob -> Request k Blob blobR user repo sha = query ["repos", toPathPart user, toPathPart repo, "git", "blobs", toPathPart sha] [] github-0.23/src/GitHub/Endpoints/GitData/Commits.hs0000644000000000000000000000201707346545000020311 0ustar0000000000000000----------------------------------------------------------------------------- -- | -- License : BSD-3-Clause -- Maintainer : Oleg Grenrus -- -- The API for underlying git commits of a Github repo, as described on -- . module GitHub.Endpoints.GitData.Commits ( commit, gitCommitR, module GitHub.Data, ) where import GitHub.Data import GitHub.Internal.Prelude import GitHub.Request import Prelude () -- | A single commit, by SHA1. -- -- > commit "thoughtbot" "paperclip" "bc5c51d1ece1ee45f94b056a0f5a1674d7e8cba9" commit :: Name Owner -> Name Repo -> Name GitCommit -> IO (Either Error GitCommit) commit user repo sha = executeRequest' $ gitCommitR user repo sha -- | Query a commit. -- See gitCommitR :: Name Owner -> Name Repo -> Name GitCommit -> Request k GitCommit gitCommitR user repo sha = query ["repos", toPathPart user, toPathPart repo, "git", "commits", toPathPart sha] [] github-0.23/src/GitHub/Endpoints/GitData/References.hs0000644000000000000000000000670307346545000020765 0ustar0000000000000000----------------------------------------------------------------------------- -- | -- License : BSD-3-Clause -- Maintainer : Oleg Grenrus -- -- The underlying git references on a Github repo, exposed for the world to -- see. The git internals documentation will also prove handy for understanding -- these. API documentation at . module GitHub.Endpoints.GitData.References ( reference, reference', referenceR, references, references', referencesR, createReference, createReferenceR, namespacedReferences, module GitHub.Data, ) where import GitHub.Data import GitHub.Internal.Prelude import GitHub.Request import Prelude () -- | A single reference by the ref name. -- -- > reference' (Just $ BasicAuth "github-username" "github-password") "mike-burns" "github" "heads/master" reference' :: Maybe Auth -> Name Owner -> Name Repo -> Name GitReference -> IO (Either Error GitReference) reference' auth user repo ref = executeRequestMaybe auth $ referenceR user repo ref -- | A single reference by the ref name. -- -- > reference "mike-burns" "github" "heads/master" reference :: Name Owner -> Name Repo -> Name GitReference -> IO (Either Error GitReference) reference = reference' Nothing -- | Query a reference. -- See referenceR :: Name Owner -> Name Repo -> Name GitReference -> Request k GitReference referenceR user repo ref = query ["repos", toPathPart user, toPathPart repo, "git", "refs", toPathPart ref] [] -- | The history of references for a repo. -- -- > references "mike-burns" "github" references' :: Maybe Auth -> Name Owner -> Name Repo -> IO (Either Error (Vector GitReference)) references' auth user repo = executeRequestMaybe auth $ referencesR user repo FetchAll -- | The history of references for a repo. -- -- > references "mike-burns" "github" references :: Name Owner -> Name Repo -> IO (Either Error (Vector GitReference)) references = references' Nothing -- | Query all References. -- See referencesR :: Name Owner -> Name Repo -> FetchCount -> Request k (Vector GitReference) referencesR user repo = pagedQuery ["repos", toPathPart user, toPathPart repo, "git", "refs"] [] -- | Create a reference. createReference :: Auth -> Name Owner -> Name Repo -> NewGitReference -> IO (Either Error GitReference) createReference auth user repo newRef = executeRequest auth $ createReferenceR user repo newRef -- | Create a reference. -- See createReferenceR :: Name Owner -> Name Repo -> NewGitReference -> Request 'RW GitReference createReferenceR user repo newRef = command Post ["repos", toPathPart user, toPathPart repo , "git", "refs"] (encode newRef) -- | Limited references by a namespace. -- -- > namespacedReferences "thoughtbot" "paperclip" "tags" namespacedReferences :: Name Owner -> Name Repo -> Text -> IO (Either Error [GitReference]) namespacedReferences user repo namespace = executeRequest' $ namespacedReferencesR user repo namespace -- | Query namespaced references. -- See namespacedReferencesR :: Name Owner -> Name Repo -> Text -> Request k [GitReference] namespacedReferencesR user repo namespace = query ["repos", toPathPart user, toPathPart repo, "git", "refs", namespace] [] github-0.23/src/GitHub/Endpoints/GitData/Trees.hs0000644000000000000000000000433407346545000017764 0ustar0000000000000000----------------------------------------------------------------------------- -- | -- License : BSD-3-Clause -- Maintainer : Oleg Grenrus -- -- The underlying tree of SHA1s and files that make up a git repo. The API is -- described on . module GitHub.Endpoints.GitData.Trees ( tree, tree', treeR, nestedTree, nestedTree', nestedTreeR, module GitHub.Data, ) where import GitHub.Data import GitHub.Internal.Prelude import GitHub.Request import Prelude () -- | A tree for a SHA1. -- -- > tree (Just $ BasicAuth "github-username" "github-password") "thoughtbot" "paperclip" "fe114451f7d066d367a1646ca7ac10e689b46844" tree' :: Maybe Auth -> Name Owner -> Name Repo -> Name Tree -> IO (Either Error Tree) tree' auth user repo sha = executeRequestMaybe auth $ treeR user repo sha -- | A tree for a SHA1. -- -- > tree "thoughtbot" "paperclip" "fe114451f7d066d367a1646ca7ac10e689b46844" tree :: Name Owner -> Name Repo -> Name Tree -> IO (Either Error Tree) tree = tree' Nothing -- | Query a Tree. -- See treeR :: Name Owner -> Name Repo -> Name Tree -> Request k Tree treeR user repo sha = query ["repos", toPathPart user, toPathPart repo, "git", "trees", toPathPart sha] [] -- | A recursively-nested tree for a SHA1. -- -- > nestedTree' (Just $ BasicAuth "github-username" "github-password") "thoughtbot" "paperclip" "fe114451f7d066d367a1646ca7ac10e689b46844" nestedTree' :: Maybe Auth -> Name Owner -> Name Repo -> Name Tree -> IO (Either Error Tree) nestedTree' auth user repo sha = executeRequestMaybe auth $ nestedTreeR user repo sha -- | A recursively-nested tree for a SHA1. -- -- > nestedTree "thoughtbot" "paperclip" "fe114451f7d066d367a1646ca7ac10e689b46844" nestedTree :: Name Owner -> Name Repo -> Name Tree -> IO (Either Error Tree) nestedTree = nestedTree' Nothing -- | Query a Tree Recursively. -- See nestedTreeR :: Name Owner -> Name Repo -> Name Tree -> Request k Tree nestedTreeR user repo sha = query ["repos", toPathPart user, toPathPart repo, "git", "trees", toPathPart sha] [("recursive", Just "1")] github-0.23/src/GitHub/Endpoints/Issues.hs0000644000000000000000000001133007346545000016632 0ustar0000000000000000{-# LANGUAGE CPP #-} ----------------------------------------------------------------------------- -- | -- License : BSD-3-Clause -- Maintainer : Oleg Grenrus -- -- The issues API as described on . module GitHub.Endpoints.Issues ( currentUserIssuesR, organizationIssuesR, issue, issue', issueR, issuesForRepo, issuesForRepo', issuesForRepoR, createIssue, createIssueR, newIssue, editIssue, editIssueR, editOfIssue, module GitHub.Data, ) where import GitHub.Data import GitHub.Internal.Prelude import GitHub.Request import Prelude () -- | See . currentUserIssuesR :: IssueMod -> FetchCount -> Request 'RA (Vector Issue) currentUserIssuesR opts = pagedQuery ["user", "issues"] (issueModToQueryString opts) -- | See . organizationIssuesR :: Name Organization -> IssueMod -> FetchCount -> Request k (Vector Issue) organizationIssuesR org opts = pagedQuery ["orgs", toPathPart org, "issues"] (issueModToQueryString opts) -- | Details on a specific issue, given the repo owner and name, and the issue -- number.' -- -- > issue' (Just $ BasicAuth "github-username" "github-password") "thoughtbot" "paperclip" "462" issue' :: Maybe Auth -> Name Owner -> Name Repo -> Id Issue -> IO (Either Error Issue) issue' auth user reqRepoName reqIssueNumber = executeRequestMaybe auth $ issueR user reqRepoName reqIssueNumber -- | Details on a specific issue, given the repo owner and name, and the issue -- number. -- -- > issue "thoughtbot" "paperclip" (Id "462") issue :: Name Owner -> Name Repo -> Id Issue -> IO (Either Error Issue) issue = issue' Nothing -- | Query a single issue. -- See issueR :: Name Owner -> Name Repo -> Id Issue -> Request k Issue issueR user reqRepoName reqIssueNumber = query ["repos", toPathPart user, toPathPart reqRepoName, "issues", toPathPart reqIssueNumber] [] -- | All issues for a repo (given the repo owner and name), with optional -- restrictions as described in the 'IssueRepoMod' data type. -- -- > issuesForRepo' (Just $ BasicAuth "github-username" "github-password") "thoughtbot" "paperclip" [NoMilestone, OnlyClosed, Mentions "jyurek", Ascending] issuesForRepo' :: Maybe Auth -> Name Owner -> Name Repo -> IssueRepoMod -> IO (Either Error (Vector Issue)) issuesForRepo' auth user reqRepoName opts = executeRequestMaybe auth $ issuesForRepoR user reqRepoName opts FetchAll -- | All issues for a repo (given the repo owner and name), with optional -- restrictions as described in the 'IssueRepoMod' data type. -- -- > issuesForRepo "thoughtbot" "paperclip" [NoMilestone, OnlyClosed, Mentions "jyurek", Ascending] issuesForRepo :: Name Owner -> Name Repo -> IssueRepoMod -> IO (Either Error (Vector Issue)) issuesForRepo = issuesForRepo' Nothing -- | List issues for a repository. -- See issuesForRepoR :: Name Owner -> Name Repo -> IssueRepoMod -> FetchCount -> Request k (Vector Issue) issuesForRepoR user reqRepoName opts = pagedQuery ["repos", toPathPart user, toPathPart reqRepoName, "issues"] qs where qs = issueRepoModToQueryString opts -- Creating new issues. newIssue :: Text -> NewIssue newIssue title = NewIssue title Nothing mempty Nothing Nothing -- | Create a new issue. -- -- > createIssue (BasicAuth "github-username" "github-password") user repo -- > (newIssue "some_repo") {...} createIssue :: Auth -> Name Owner -> Name Repo -> NewIssue -> IO (Either Error Issue) createIssue auth user repo ni = executeRequest auth $ createIssueR user repo ni -- | Create an issue. -- See createIssueR :: Name Owner -> Name Repo -> NewIssue -> Request 'RW Issue createIssueR user repo = command Post ["repos", toPathPart user, toPathPart repo, "issues"] . encode -- Editing issues. editOfIssue :: EditIssue editOfIssue = EditIssue Nothing Nothing Nothing Nothing Nothing Nothing -- | Edit an issue. -- -- > editIssue (BasicAuth "github-username" "github-password") user repo issue -- > editOfIssue {...} editIssue :: Auth -> Name Owner -> Name Repo -> Id Issue -> EditIssue -> IO (Either Error Issue) editIssue auth user repo iss edit = executeRequest auth $ editIssueR user repo iss edit -- | Edit an issue. -- See editIssueR :: Name Owner -> Name Repo -> Id Issue -> EditIssue -> Request 'RW Issue editIssueR user repo iss = command Patch ["repos", toPathPart user, toPathPart repo, "issues", toPathPart iss] . encode github-0.23/src/GitHub/Endpoints/Issues/0000755000000000000000000000000007346545000016300 5ustar0000000000000000github-0.23/src/GitHub/Endpoints/Issues/Comments.hs0000644000000000000000000001015607346545000020424 0ustar0000000000000000----------------------------------------------------------------------------- -- | -- License : BSD-3-Clause -- Maintainer : Oleg Grenrus -- -- The Github issue comments API from -- . module GitHub.Endpoints.Issues.Comments ( comment, commentR, comments, commentsR, comments', createComment, createCommentR, deleteComment, deleteCommentR, editComment, editCommentR, module GitHub.Data, ) where import GitHub.Data import GitHub.Internal.Prelude import GitHub.Request import Prelude () -- | A specific comment, by ID. -- -- > comment "thoughtbot" "paperclip" 1468184 comment :: Name Owner -> Name Repo -> Id Comment -> IO (Either Error IssueComment) comment user repo cid = executeRequest' $ commentR user repo cid -- | Query a single comment. -- See commentR :: Name Owner -> Name Repo -> Id Comment -> Request k IssueComment commentR user repo cid = query ["repos", toPathPart user, toPathPart repo, "issues", "comments", toPathPart cid] [] -- | All comments on an issue, by the issue's number. -- -- > comments "thoughtbot" "paperclip" 635 comments :: Name Owner -> Name Repo -> IssueNumber -> IO (Either Error (Vector IssueComment)) comments = comments' Nothing -- | All comments on an issue, by the issue's number, using authentication. -- -- > comments' (Just $ BasicAuth "github-username" "github-password") "thoughtbot" "paperclip" 635 comments' :: Maybe Auth -> Name Owner -> Name Repo -> IssueNumber -> IO (Either Error (Vector IssueComment)) comments' auth user repo iid = executeRequestMaybe auth $ commentsR user repo iid FetchAll -- | List comments on an issue. -- See commentsR :: Name Owner -> Name Repo -> IssueNumber -> FetchCount -> Request k (Vector IssueComment) commentsR user repo iid = pagedQuery ["repos", toPathPart user, toPathPart repo, "issues", toPathPart iid, "comments"] [] -- | Create a new comment. -- -- > createComment (BasicAuth "github-username" "github-password") user repo issue -- > "some words" createComment :: Auth -> Name Owner -> Name Repo -> IssueNumber -> Text -> IO (Either Error Comment) createComment auth user repo iss body = executeRequest auth $ createCommentR user repo iss body -- | Create a comment. -- See createCommentR :: Name Owner -> Name Repo -> IssueNumber -> Text -> Request 'RW Comment createCommentR user repo iss body = command Post parts (encode $ NewComment body) where parts = ["repos", toPathPart user, toPathPart repo, "issues", toPathPart iss, "comments"] -- | Edit a comment. -- -- > editComment (BasicAuth "github-username" "github-password") user repo commentid -- > "new words" editComment :: Auth -> Name Owner -> Name Repo -> Id Comment -> Text -> IO (Either Error Comment) editComment auth user repo commid body = executeRequest auth $ editCommentR user repo commid body -- | Edit a comment. -- See editCommentR :: Name Owner -> Name Repo -> Id Comment -> Text -> Request 'RW Comment editCommentR user repo commid body = command Patch parts (encode $ EditComment body) where parts = ["repos", toPathPart user, toPathPart repo, "issues", "comments", toPathPart commid] -- | Delete a comment. -- -- > deleteComment (BasicAuth "github-username" "github-password") user repo commentid deleteComment :: Auth -> Name Owner -> Name Repo -> Id Comment -> IO (Either Error ()) deleteComment auth user repo commid = executeRequest auth $ deleteCommentR user repo commid -- | Delete a comment. -- See deleteCommentR :: Name Owner -> Name Repo -> Id Comment -> GenRequest 'MtUnit 'RW () deleteCommentR user repo commid = Command Delete parts mempty where parts = ["repos", toPathPart user, toPathPart repo, "issues", "comments", toPathPart commid] github-0.23/src/GitHub/Endpoints/Issues/Events.hs0000644000000000000000000000640207346545000020102 0ustar0000000000000000----------------------------------------------------------------------------- -- | -- License : BSD-3-Clause -- Maintainer : Oleg Grenrus -- -- The Github issue events API, which is described on -- module GitHub.Endpoints.Issues.Events ( eventsForIssue, eventsForIssue', eventsForIssueR, eventsForRepo, eventsForRepo', eventsForRepoR, event, event', eventR, module GitHub.Data, ) where import GitHub.Data import GitHub.Internal.Prelude import GitHub.Request import Prelude () -- | All events that have happened on an issue. -- -- > eventsForIssue "thoughtbot" "paperclip" 49 eventsForIssue :: Name Owner -> Name Repo -> Id Issue -> IO (Either Error (Vector IssueEvent)) eventsForIssue = eventsForIssue' Nothing -- | All events that have happened on an issue, using authentication. -- -- > eventsForIssue' (Just $ BasicAuth "github-username" "github-password") "thoughtbot" "paperclip" 49 eventsForIssue' :: Maybe Auth -> Name Owner -> Name Repo -> Id Issue -> IO (Either Error (Vector IssueEvent)) eventsForIssue' auth user repo iid = executeRequestMaybe auth $ eventsForIssueR user repo iid FetchAll -- | List events for an issue. -- See eventsForIssueR :: Name Owner -> Name Repo -> Id Issue -> FetchCount -> Request k (Vector IssueEvent) eventsForIssueR user repo iid = pagedQuery ["repos", toPathPart user, toPathPart repo, "issues", toPathPart iid, "events"] [] -- | All the events for all issues in a repo. -- -- > eventsForRepo "thoughtbot" "paperclip" eventsForRepo :: Name Owner -> Name Repo -> IO (Either Error (Vector IssueEvent)) eventsForRepo = eventsForRepo' Nothing -- | All the events for all issues in a repo, using authentication. -- -- > eventsForRepo' (Just $ BasicAuth "github-username" "github-password") "thoughtbot" "paperclip" eventsForRepo' :: Maybe Auth -> Name Owner -> Name Repo -> IO (Either Error (Vector IssueEvent)) eventsForRepo' auth user repo = executeRequestMaybe auth $ eventsForRepoR user repo FetchAll -- | List events for a repository. -- See eventsForRepoR :: Name Owner -> Name Repo -> FetchCount -> Request k (Vector IssueEvent) eventsForRepoR user repo = pagedQuery ["repos", toPathPart user, toPathPart repo, "issues", "events"] [] -- | Details on a specific event, by the event's ID. -- -- > event "thoughtbot" "paperclip" 5335772 event :: Name Owner -> Name Repo -> Id IssueEvent -> IO (Either Error IssueEvent) event = event' Nothing -- | Details on a specific event, by the event's ID, using authentication. -- -- > event' (Just $ BasicAuth "github-username" "github-password") "thoughtbot" "paperclip" 5335772 event' :: Maybe Auth -> Name Owner -> Name Repo -> Id IssueEvent -> IO (Either Error IssueEvent) event' auth user repo eid = executeRequestMaybe auth $ eventR user repo eid -- | Query a single event. -- See eventR :: Name Owner -> Name Repo -> Id IssueEvent -> Request k IssueEvent eventR user repo eid = query ["repos", toPathPart user, toPathPart repo, "issues", "events", toPathPart eid] [] github-0.23/src/GitHub/Endpoints/Issues/Labels.hs0000644000000000000000000002543707346545000020051 0ustar0000000000000000----------------------------------------------------------------------------- -- | -- License : BSD-3-Clause -- Maintainer : Oleg Grenrus -- -- The API for dealing with labels on Github issues as described on -- . module GitHub.Endpoints.Issues.Labels ( labelsOnRepo, labelsOnRepo', labelsOnRepoR, label, label', labelR, createLabel, createLabelR, updateLabel, updateLabelR, deleteLabel, deleteLabelR, labelsOnIssue, labelsOnIssue', labelsOnIssueR, addLabelsToIssue, addLabelsToIssueR, removeLabelFromIssue, removeLabelFromIssueR, replaceAllLabelsForIssue, replaceAllLabelsForIssueR, removeAllLabelsFromIssue, removeAllLabelsFromIssueR, labelsOnMilestone, labelsOnMilestone', labelsOnMilestoneR, module GitHub.Data, ) where import GitHub.Data import GitHub.Internal.Prelude import GitHub.Request import Prelude () -- | All the labels available to use on any issue in the repo. -- -- > labelsOnRepo "thoughtbot" "paperclip" labelsOnRepo :: Name Owner -> Name Repo -> IO (Either Error (Vector IssueLabel)) labelsOnRepo = labelsOnRepo' Nothing -- | All the labels available to use on any issue in the repo using authentication. -- -- > labelsOnRepo' (Just $ BasicAuth "github-username" "github-password") "thoughtbot" "paperclip" labelsOnRepo' :: Maybe Auth -> Name Owner -> Name Repo -> IO (Either Error (Vector IssueLabel)) labelsOnRepo' auth user repo = executeRequestMaybe auth $ labelsOnRepoR user repo FetchAll -- | List all labels for this repository. -- See labelsOnRepoR :: Name Owner -> Name Repo -> FetchCount -> Request k (Vector IssueLabel) labelsOnRepoR user repo = pagedQuery ["repos", toPathPart user, toPathPart repo, "labels"] [] -- | A label by name. -- -- > label "thoughtbot" "paperclip" "bug" label :: Name Owner -> Name Repo -> Name IssueLabel -> IO (Either Error IssueLabel) label = label' Nothing -- | A label by name using authentication. -- -- > label' (Just $ BasicAuth "github-username" "github-password") "thoughtbot" "paperclip" "bug" label' :: Maybe Auth -> Name Owner -> Name Repo -> Name IssueLabel -> IO (Either Error IssueLabel) label' auth user repo lbl = executeRequestMaybe auth $ labelR user repo lbl -- | Query a single label. -- See labelR :: Name Owner -> Name Repo -> Name IssueLabel -> Request k IssueLabel labelR user repo lbl = query ["repos", toPathPart user, toPathPart repo, "labels", toPathPart lbl] [] -- | Create a label -- -- > createLabel (BasicAuth "github-username" "github-password") "thoughtbot" "paperclip" "bug" "f29513" createLabel :: Auth -> Name Owner -> Name Repo -> Name IssueLabel -> String -> IO (Either Error IssueLabel) createLabel auth user repo lbl color = executeRequest auth $ createLabelR user repo lbl color -- | Create a label. -- See createLabelR :: Name Owner -> Name Repo -> Name IssueLabel -> String -> Request 'RW IssueLabel createLabelR user repo lbl color = command Post paths $ encode body where paths = ["repos", toPathPart user, toPathPart repo, "labels"] body = object ["name" .= untagName lbl, "color" .= color] -- | Update a label -- -- > updateLabel (BasicAuth "github-username" "github-password") "thoughtbot" "paperclip" "bug" "new-bug" "ff1111" updateLabel :: Auth -> Name Owner -> Name Repo -> Name IssueLabel -- ^ old label name -> Name IssueLabel -- ^ new label name -> String -- ^ new color -> IO (Either Error IssueLabel) updateLabel auth user repo oldLbl newLbl color = executeRequest auth $ updateLabelR user repo oldLbl newLbl color -- | Update a label. -- See updateLabelR :: Name Owner -> Name Repo -> Name IssueLabel -- ^ old label name -> Name IssueLabel -- ^ new label name -> String -- ^ new color -> Request 'RW IssueLabel updateLabelR user repo oldLbl newLbl color = command Patch paths (encode body) where paths = ["repos", toPathPart user, toPathPart repo, "labels", toPathPart oldLbl] body = object ["name" .= untagName newLbl, "color" .= color] -- | Delete a label -- -- > deleteLabel (BasicAuth "github-username" "github-password") "thoughtbot" "paperclip" "bug" deleteLabel :: Auth -> Name Owner -> Name Repo -> Name IssueLabel -> IO (Either Error ()) deleteLabel auth user repo lbl = executeRequest auth $ deleteLabelR user repo lbl -- | Delete a label. -- See deleteLabelR :: Name Owner -> Name Repo -> Name IssueLabel -> GenRequest 'MtUnit 'RW () deleteLabelR user repo lbl = Command Delete ["repos", toPathPart user, toPathPart repo, "labels", toPathPart lbl] mempty -- | The labels on an issue in a repo. -- -- > labelsOnIssue "thoughtbot" "paperclip" 585 labelsOnIssue :: Name Owner -> Name Repo -> Id Issue -> IO (Either Error (Vector IssueLabel)) labelsOnIssue = labelsOnIssue' Nothing -- | The labels on an issue in a repo using authentication. -- -- > labelsOnIssue' (Just $ BasicAuth "github-username" "github-password") "thoughtbot" "paperclip" (Id 585) labelsOnIssue' :: Maybe Auth -> Name Owner -> Name Repo -> Id Issue -> IO (Either Error (Vector IssueLabel)) labelsOnIssue' auth user repo iid = executeRequestMaybe auth $ labelsOnIssueR user repo iid FetchAll -- | List labels on an issue. -- See labelsOnIssueR :: Name Owner -> Name Repo -> Id Issue -> FetchCount -> Request k (Vector IssueLabel) labelsOnIssueR user repo iid = pagedQuery ["repos", toPathPart user, toPathPart repo, "issues", toPathPart iid, "labels"] [] -- | Add labels to an issue. -- -- > addLabelsToIssue (BasicAuth "github-username" "github-password") "thoughtbot" "paperclip" (Id 585) ["Label1" "Label2"] addLabelsToIssue :: Foldable f => Auth -> Name Owner -> Name Repo -> Id Issue -> f (Name IssueLabel) -> IO (Either Error (Vector IssueLabel)) addLabelsToIssue auth user repo iid lbls = executeRequest auth $ addLabelsToIssueR user repo iid lbls -- | Add lables to an issue. -- See addLabelsToIssueR :: Foldable f => Name Owner -> Name Repo -> Id Issue -> f (Name IssueLabel) -> Request 'RW (Vector IssueLabel) addLabelsToIssueR user repo iid lbls = command Post paths (encode $ toList lbls) where paths = ["repos", toPathPart user, toPathPart repo, "issues", toPathPart iid, "labels"] -- | Remove a label from an issue. -- -- > removeLabelFromIssue (BasicAuth "github-username" "github-password") "thoughtbot" "paperclip" (Id 585) "bug" removeLabelFromIssue :: Auth -> Name Owner -> Name Repo -> Id Issue -> Name IssueLabel -> IO (Either Error ()) removeLabelFromIssue auth user repo iid lbl = executeRequest auth $ removeLabelFromIssueR user repo iid lbl -- | Remove a label from an issue. -- See removeLabelFromIssueR :: Name Owner -> Name Repo -> Id Issue -> Name IssueLabel -> GenRequest 'MtUnit 'RW () removeLabelFromIssueR user repo iid lbl = Command Delete ["repos", toPathPart user, toPathPart repo, "issues", toPathPart iid, "labels", toPathPart lbl] mempty -- | Replace all labels on an issue. Sending an empty list will remove all labels from the issue. -- -- > replaceAllLabelsForIssue (BasicAuth "github-username" "github-password") "thoughtbot" "paperclip" (Id 585) ["Label1" "Label2"] replaceAllLabelsForIssue :: Foldable f => Auth -> Name Owner -> Name Repo -> Id Issue -> f (Name IssueLabel) -> IO (Either Error (Vector IssueLabel)) replaceAllLabelsForIssue auth user repo iid lbls = executeRequest auth $ replaceAllLabelsForIssueR user repo iid lbls -- | Replace all labels on an issue. -- See -- -- Sending an empty list will remove all labels from the issue. replaceAllLabelsForIssueR :: Foldable f => Name Owner -> Name Repo -> Id Issue -> f (Name IssueLabel) -> Request 'RW (Vector IssueLabel) replaceAllLabelsForIssueR user repo iid lbls = command Put paths (encode $ toList lbls) where paths = ["repos", toPathPart user, toPathPart repo, "issues", toPathPart iid, "labels"] -- | Remove all labels from an issue. -- -- > removeAllLabelsFromIssue (BasicAuth "github-username" "github-password") "thoughtbot" "paperclip" (Id 585) removeAllLabelsFromIssue :: Auth -> Name Owner -> Name Repo -> Id Issue -> IO (Either Error ()) removeAllLabelsFromIssue auth user repo iid = executeRequest auth $ removeAllLabelsFromIssueR user repo iid -- | Remove all labels from an issue. -- See removeAllLabelsFromIssueR :: Name Owner -> Name Repo -> Id Issue -> GenRequest 'MtUnit 'RW () removeAllLabelsFromIssueR user repo iid = Command Delete ["repos", toPathPart user, toPathPart repo, "issues", toPathPart iid, "labels"] mempty -- | All the labels on a repo's milestone given the milestone ID. -- -- > labelsOnMilestone "thoughtbot" "paperclip" (Id 2) labelsOnMilestone :: Name Owner -> Name Repo -> Id Milestone -> IO (Either Error (Vector IssueLabel)) labelsOnMilestone = labelsOnMilestone' Nothing -- | All the labels on a repo's milestone given the milestone ID using authentication. -- -- > labelsOnMilestone' (Just $ BasicAuth "github-username" "github-password") "thoughtbot" "paperclip" (Id 2) labelsOnMilestone' :: Maybe Auth -> Name Owner -> Name Repo -> Id Milestone -> IO (Either Error (Vector IssueLabel)) labelsOnMilestone' auth user repo mid = executeRequestMaybe auth $ labelsOnMilestoneR user repo mid FetchAll -- | Query labels for every issue in a milestone. -- See labelsOnMilestoneR :: Name Owner -> Name Repo -> Id Milestone -> FetchCount -> Request k (Vector IssueLabel) labelsOnMilestoneR user repo mid = pagedQuery ["repos", toPathPart user, toPathPart repo, "milestones", toPathPart mid, "labels"] [] github-0.23/src/GitHub/Endpoints/Issues/Milestones.hs0000644000000000000000000000710207346545000020756 0ustar0000000000000000----------------------------------------------------------------------------- -- | -- License : BSD-3-Clause -- Maintainer : Oleg Grenrus -- -- The milestones API as described on -- . module GitHub.Endpoints.Issues.Milestones ( milestones, milestones', milestonesR, milestone, milestoneR, createMilestone, createMilestoneR, updateMilestone, updateMilestoneR, deleteMilestone, deleteMilestoneR, module GitHub.Data, ) where import GitHub.Data import GitHub.Internal.Prelude import GitHub.Request import Prelude () -- | All milestones in the repo. -- -- > milestones "thoughtbot" "paperclip" milestones :: Name Owner -> Name Repo -> IO (Either Error (Vector Milestone)) milestones = milestones' Nothing -- | All milestones in the repo, using authentication. -- -- > milestones' (Just $ BasicAuth "github-username" "github-password") "thoughtbot" "paperclip" milestones' :: Maybe Auth -> Name Owner -> Name Repo -> IO (Either Error (Vector Milestone)) milestones' auth user repo = executeRequestMaybe auth $ milestonesR user repo FetchAll -- | List milestones for a repository. -- See milestonesR :: Name Owner -> Name Repo -> FetchCount -> Request k (Vector Milestone) milestonesR user repo = pagedQuery ["repos", toPathPart user, toPathPart repo, "milestones"] [] -- | Details on a specific milestone, given it's milestone number. -- -- > milestone "thoughtbot" "paperclip" (Id 2) milestone :: Name Owner -> Name Repo -> Id Milestone -> IO (Either Error Milestone) milestone user repo mid = executeRequest' $ milestoneR user repo mid -- | Query a single milestone. -- See milestoneR :: Name Owner -> Name Repo -> Id Milestone -> Request k Milestone milestoneR user repo mid = query ["repos", toPathPart user, toPathPart repo, "milestones", toPathPart mid] [] createMilestone :: Auth -> Name Owner -> Name Repo -> NewMilestone -> IO (Either Error Milestone) createMilestone auth user repo mlstn = executeRequest auth $ createMilestoneR user repo mlstn -- | Create a milestone. -- See createMilestoneR :: Name Owner -> Name Repo -> NewMilestone -> Request 'RW Milestone createMilestoneR user repo = command Post ["repos", toPathPart user, toPathPart repo, "milestones"] . encode updateMilestone :: Auth -> Name Owner -> Name Repo -> Id Milestone -> UpdateMilestone -> IO (Either Error Milestone) updateMilestone auth user repo mid mlstn = executeRequest auth $ updateMilestoneR user repo mid mlstn -- | Update a milestone. -- See updateMilestoneR :: Name Owner -> Name Repo -> Id Milestone -> UpdateMilestone -> Request 'RW Milestone updateMilestoneR user repo mid = command Patch ["repos", toPathPart user, toPathPart repo, "milestones", toPathPart mid ] . encode deleteMilestone :: Auth -> Name Owner -> Name Repo -> Id Milestone -> IO (Either Error ()) deleteMilestone auth user repo mid = executeRequest auth $ deleteMilestoneR user repo mid -- | Delete a milestone. -- See deleteMilestoneR :: Name Owner -> Name Repo -> Id Milestone -> GenRequest 'MtUnit 'RW () deleteMilestoneR user repo mid = Command Delete ["repos", toPathPart user, toPathPart repo, "milestones", toPathPart mid] mempty github-0.23/src/GitHub/Endpoints/Organizations.hs0000644000000000000000000000505507346545000020215 0ustar0000000000000000----------------------------------------------------------------------------- -- | -- License : BSD-3-Clause -- Maintainer : Oleg Grenrus -- -- The orgs API as described on . module GitHub.Endpoints.Organizations ( publicOrganizationsFor, publicOrganizationsFor', publicOrganizationsForR, publicOrganization, publicOrganization', publicOrganizationR, organizationsR, module GitHub.Data, ) where import GitHub.Data import GitHub.Internal.Prelude import GitHub.Request import Prelude () -- | The public organizations for a user, given the user's login, with authorization -- -- > publicOrganizationsFor' (Just $ BasicAuth "github-username" "github-password") "mike-burns" publicOrganizationsFor' :: Maybe Auth -> Name User -> IO (Either Error (Vector SimpleOrganization)) publicOrganizationsFor' auth org = executeRequestMaybe auth $ publicOrganizationsForR org FetchAll -- | List user organizations. The public organizations for a user, given the user's login. -- -- > publicOrganizationsFor "mike-burns" publicOrganizationsFor :: Name User -> IO (Either Error (Vector SimpleOrganization)) publicOrganizationsFor = publicOrganizationsFor' Nothing -- | List all user organizations. -- See organizationsR :: FetchCount -> Request k (Vector SimpleOrganization) organizationsR = pagedQuery ["user", "orgs"] [] -- | List public user organizations. -- See publicOrganizationsForR :: Name User -> FetchCount -> Request k (Vector SimpleOrganization) publicOrganizationsForR user = pagedQuery ["users", toPathPart user, "orgs"] [] -- | Details on a public organization. Takes the organization's login. -- -- > publicOrganization' (Just $ BasicAuth "github-username" "github-password") "thoughtbot" publicOrganization' :: Maybe Auth -> Name Organization -> IO (Either Error Organization) publicOrganization' auth = executeRequestMaybe auth . publicOrganizationR -- | Query an organization. Details on a public organization. Takes the organization's login. -- -- > publicOrganization "thoughtbot" publicOrganization :: Name Organization -> IO (Either Error Organization) publicOrganization = publicOrganization' Nothing -- | Query an organization. -- See publicOrganizationR :: Name Organization -> Request k Organization publicOrganizationR reqOrganizationName = query ["orgs", toPathPart reqOrganizationName] [] github-0.23/src/GitHub/Endpoints/Organizations/0000755000000000000000000000000007346545000017654 5ustar0000000000000000github-0.23/src/GitHub/Endpoints/Organizations/Members.hs0000644000000000000000000000617407346545000021612 0ustar0000000000000000----------------------------------------------------------------------------- -- | -- License : BSD-3-Clause -- Maintainer : Oleg Grenrus -- -- The organization members API as described on -- . module GitHub.Endpoints.Organizations.Members ( membersOf, membersOf', membersOfR, membersOfWithR, isMemberOf, isMemberOf', isMemberOfR, orgInvitationsR, module GitHub.Data, ) where import GitHub.Data import GitHub.Internal.Prelude import GitHub.Request import Prelude () -- | All the users who are members of the specified organization, -- | with or without authentication. -- -- > membersOf' (Just $ OAuth "token") "thoughtbot" membersOf' :: Maybe Auth -> Name Organization -> IO (Either Error (Vector SimpleUser)) membersOf' auth org = executeRequestMaybe auth $ membersOfR org FetchAll -- | All the users who are members of the specified organization, -- | without authentication. -- -- > membersOf "thoughtbot" membersOf :: Name Organization -> IO (Either Error (Vector SimpleUser)) membersOf = membersOf' Nothing -- | All the users who are members of the specified organization. -- -- See membersOfR :: Name Organization -> FetchCount -> Request k (Vector SimpleUser) membersOfR organization = pagedQuery ["orgs", toPathPart organization, "members"] [] -- | 'membersOfR' with filters. -- -- See membersOfWithR :: Name Organization -> OrgMemberFilter -> OrgMemberRole -> FetchCount -> Request k (Vector SimpleUser) membersOfWithR org f r = pagedQuery ["orgs", toPathPart org, "members"] [("filter", Just f'), ("role", Just r')] where f' = case f of OrgMemberFilter2faDisabled -> "2fa_disabled" OrgMemberFilterAll -> "all" r' = case r of OrgMemberRoleAll -> "all" OrgMemberRoleAdmin -> "admin" OrgMemberRoleMember -> "member" -- | Check if a user is a member of an organization, -- | with or without authentication. -- -- > isMemberOf' (Just $ OAuth "token") "phadej" "haskell-infra" isMemberOf' :: Maybe Auth -> Name User -> Name Organization -> IO (Either Error Bool) isMemberOf' auth user org = executeRequestMaybe auth $ isMemberOfR user org -- | Check if a user is a member of an organization, -- | without authentication. -- -- > isMemberOf "phadej" "haskell-infra" isMemberOf :: Name User -> Name Organization -> IO (Either Error Bool) isMemberOf = isMemberOf' Nothing -- | Check if a user is a member of an organization. -- -- See isMemberOfR :: Name User -> Name Organization -> GenRequest 'MtStatus rw Bool isMemberOfR user org = Query [ "orgs", toPathPart org, "members", toPathPart user ] [] -- | List pending organization invitations -- -- See orgInvitationsR :: Name Organization -> FetchCount -> Request 'RA (Vector Invitation) orgInvitationsR org = pagedQuery ["orgs", toPathPart org, "invitations"] [] github-0.23/src/GitHub/Endpoints/Organizations/Teams.hs0000644000000000000000000002033007346545000021257 0ustar0000000000000000----------------------------------------------------------------------------- -- | -- License : BSD-3-Clause -- Maintainer : Oleg Grenrus -- -- The Owner teams API as described on -- . module GitHub.Endpoints.Organizations.Teams ( teamsOf, teamsOf', teamsOfR, teamInfoFor, teamInfoFor', teamInfoForR, createTeamFor', createTeamForR, editTeam', editTeamR, deleteTeam', deleteTeamR, listTeamMembersR, listTeamRepos, listTeamRepos', listTeamReposR, addOrUpdateTeamRepo', addOrUpdateTeamRepoR, teamMembershipInfoFor, teamMembershipInfoFor', teamMembershipInfoForR, addTeamMembershipFor', addTeamMembershipForR, deleteTeamMembershipFor', deleteTeamMembershipForR, listTeamsCurrent', listTeamsCurrentR, module GitHub.Data, ) where import GitHub.Data import GitHub.Internal.Prelude import GitHub.Request import Prelude () -- | List teams. List the teams of an Owner. -- When authenticated, lists private teams visible to the authenticated user. -- When unauthenticated, lists only public teams for an Owner. -- -- > teamsOf' (Just $ OAuth "token") "thoughtbot" teamsOf' :: Maybe Auth -> Name Organization -> IO (Either Error (Vector SimpleTeam)) teamsOf' auth org = executeRequestMaybe auth $ teamsOfR org FetchAll -- | List the public teams of an Owner. -- -- > teamsOf "thoughtbot" teamsOf :: Name Organization -> IO (Either Error (Vector SimpleTeam)) teamsOf = teamsOf' Nothing -- | List teams. -- See teamsOfR :: Name Organization -> FetchCount -> Request k (Vector SimpleTeam) teamsOfR org = pagedQuery ["orgs", toPathPart org, "teams"] [] -- | The information for a single team, by team id. -- With authentication -- -- > teamInfoFor' (Just $ OAuth "token") 1010101 teamInfoFor' :: Maybe Auth -> Id Team -> IO (Either Error Team) teamInfoFor' auth tid = executeRequestMaybe auth $ teamInfoForR tid -- | The information for a single team, by team id. -- -- > teamInfoFor' (Just $ OAuth "token") 1010101 teamInfoFor :: Id Team -> IO (Either Error Team) teamInfoFor = teamInfoFor' Nothing -- | Query team. -- See teamInfoForR :: Id Team -> Request k Team teamInfoForR tid = query ["teams", toPathPart tid] [] -- | Create a team under an Owner -- -- > createTeamFor' (OAuth "token") "Owner" (CreateTeam "newteamname" "some description" [] PermssionPull) createTeamFor' :: Auth -> Name Organization -> CreateTeam -> IO (Either Error Team) createTeamFor' auth org cteam = executeRequest auth $ createTeamForR org cteam -- | Create team. -- See createTeamForR :: Name Organization -> CreateTeam -> Request 'RW Team createTeamForR org cteam = command Post ["orgs", toPathPart org, "teams"] (encode cteam) -- | Edit a team, by id. -- -- > editTeamFor' editTeam' :: Auth -> Id Team -> EditTeam -> IO (Either Error Team) editTeam' auth tid eteam = executeRequest auth $ editTeamR tid eteam -- | Edit team. -- See editTeamR :: Id Team -> EditTeam -> Request 'RW Team editTeamR tid eteam = command Patch ["teams", toPathPart tid] (encode eteam) -- | Delete a team, by id. -- -- > deleteTeam' (OAuth "token") 1010101 deleteTeam' :: Auth -> Id Team -> IO (Either Error ()) deleteTeam' auth tid = executeRequest auth $ deleteTeamR tid -- | Delete team. -- -- See deleteTeamR :: Id Team -> GenRequest 'MtUnit 'RW () deleteTeamR tid = Command Delete ["teams", toPathPart tid] mempty -- | List team members. -- -- See listTeamMembersR :: Id Team -> TeamMemberRole -> FetchCount -> Request 'RA (Vector SimpleUser) listTeamMembersR tid r = pagedQuery ["teams", toPathPart tid, "members"] [("role", Just r')] where r' = case r of TeamMemberRoleAll -> "all" TeamMemberRoleMaintainer -> "maintainer" TeamMemberRoleMember -> "member" -- | The repositories of a single team, by team id. -- With authentication -- -- > listTeamRepos' (Just $ GitHub.OAuth token) (GitHub.mkTeamId team_id) listTeamRepos' :: Maybe Auth -> Id Team -> IO (Either Error (Vector Repo)) listTeamRepos' auth tid = executeRequestMaybe auth $ listTeamReposR tid FetchAll -- | Query team repositories. -- See listTeamReposR :: Id Team -> FetchCount -> Request k (Vector Repo) listTeamReposR tid = pagedQuery ["teams", toPathPart tid, "repos"] [] -- | Retrieve repositories for a team. -- -- > listTeamRepos (GitHub.mkTeamId team_id) listTeamRepos :: Id Team -> IO (Either Error (Vector Repo)) listTeamRepos = listTeamRepos' Nothing -- | Add a repository to a team or update the permission on the repository. -- -- > addOrUpdateTeamRepo' (OAuth "token") 1010101 "mburns" (Just PermissionPull) addOrUpdateTeamRepo' :: Auth -> Id Team -> Name Organization -> Name Repo -> Permission -> IO (Either Error ()) addOrUpdateTeamRepo' auth tid org repo permission = executeRequest auth $ addOrUpdateTeamRepoR tid org repo permission -- | Add or update a team repository. -- See addOrUpdateTeamRepoR :: Id Team -> Name Organization -> Name Repo -> Permission -> GenRequest 'MtUnit 'RW () addOrUpdateTeamRepoR tid org repo permission = Command Put ["teams", toPathPart tid, "repos", toPathPart org, toPathPart repo] (encode $ AddTeamRepoPermission permission) -- | Retrieve team mebership information for a user. -- With authentication -- -- > teamMembershipInfoFor' (Just $ OAuth "token") 1010101 "mburns" teamMembershipInfoFor' :: Maybe Auth -> Id Team -> Name Owner -> IO (Either Error TeamMembership) teamMembershipInfoFor' auth tid user = executeRequestMaybe auth $ teamMembershipInfoForR tid user -- | Query team membership. -- See Name Owner -> Request k TeamMembership teamMembershipInfoForR tid user = query ["teams", toPathPart tid, "memberships", toPathPart user] [] -- | Retrieve team mebership information for a user. -- -- > teamMembershipInfoFor 1010101 "mburns" teamMembershipInfoFor :: Id Team -> Name Owner -> IO (Either Error TeamMembership) teamMembershipInfoFor = teamMembershipInfoFor' Nothing -- | Add (or invite) a member to a team. -- -- > addTeamMembershipFor' (OAuth "token") 1010101 "mburns" RoleMember addTeamMembershipFor' :: Auth -> Id Team -> Name Owner -> Role -> IO (Either Error TeamMembership) addTeamMembershipFor' auth tid user role = executeRequest auth $ addTeamMembershipForR tid user role -- | Add team membership. -- See addTeamMembershipForR :: Id Team -> Name Owner -> Role -> Request 'RW TeamMembership addTeamMembershipForR tid user role = command Put ["teams", toPathPart tid, "memberships", toPathPart user] (encode $ CreateTeamMembership role) -- | Delete a member of a team. -- -- > deleteTeamMembershipFor' (OAuth "token") 1010101 "mburns" deleteTeamMembershipFor' :: Auth -> Id Team -> Name Owner -> IO (Either Error ()) deleteTeamMembershipFor' auth tid user = executeRequest auth $ deleteTeamMembershipForR tid user -- | Remove team membership. -- See deleteTeamMembershipForR :: Id Team -> Name Owner -> GenRequest 'MtUnit 'RW () deleteTeamMembershipForR tid user = Command Delete ["teams", toPathPart tid, "memberships", toPathPart user] mempty -- | List teams for current authenticated user -- -- > listTeamsCurrent' (OAuth "token") listTeamsCurrent' :: Auth -> IO (Either Error (Vector Team)) listTeamsCurrent' auth = executeRequest auth $ listTeamsCurrentR FetchAll -- | List user teams. -- See listTeamsCurrentR :: FetchCount -> Request 'RA (Vector Team) listTeamsCurrentR = pagedQuery ["user", "teams"] [] github-0.23/src/GitHub/Endpoints/PullRequests.hs0000644000000000000000000002356007346545000020037 0ustar0000000000000000----------------------------------------------------------------------------- -- | -- License : BSD-3-Clause -- Maintainer : Oleg Grenrus -- -- The pull requests API as documented at -- . module GitHub.Endpoints.PullRequests ( pullRequestsFor, pullRequestsFor', pullRequestsForR, pullRequest', pullRequest, pullRequestR, pullRequestDiff', pullRequestDiff, pullRequestDiffR, pullRequestPatch', pullRequestPatch, pullRequestPatchR, createPullRequest, createPullRequestR, updatePullRequest, updatePullRequestR, pullRequestCommits', pullRequestCommitsIO, pullRequestCommitsR, pullRequestFiles', pullRequestFiles, pullRequestFilesR, isPullRequestMerged, isPullRequestMergedR, mergePullRequest, mergePullRequestR, module GitHub.Data ) where 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. -- -- > pullRequestsFor "rails" "rails" pullRequestsFor :: Name Owner -> Name Repo -> IO (Either Error (Vector SimplePullRequest)) pullRequestsFor user repo = executeRequest' $ pullRequestsForR user repo mempty FetchAll -- | All open pull requests for the repo, by owner and repo name. -- -- > pullRequestsFor "rails" "rails" pullRequestsFor' :: Maybe Auth -> Name Owner -> Name Repo -> IO (Either Error (Vector SimplePullRequest)) pullRequestsFor' auth user repo = executeRequestMaybe auth $ pullRequestsForR user repo mempty FetchAll -- | List pull requests. -- See pullRequestsForR :: Name Owner -> Name Repo -> PullRequestMod -> FetchCount -> Request k (Vector SimplePullRequest) pullRequestsForR user repo opts = pagedQuery ["repos", toPathPart user, toPathPart repo, "pulls"] (prModToQueryString opts) -- | Obtain the diff of a pull request -- See 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 pullRequestDiff :: Name Owner -> Name Repo -> IssueNumber -> IO (Either Error ByteString) pullRequestDiff = pullRequestDiff' Nothing -- | Query a single pull request to obtain the diff -- See 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 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 pullRequestPatch :: Name Owner -> Name Repo -> IssueNumber -> IO (Either Error ByteString) pullRequestPatch = pullRequestPatch' Nothing -- | Query a single pull request to obtain the patch -- See 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 $ BasicAuth "github-username" "github-password") "thoughtbot" "paperclip" 562 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 -> IssueNumber -> IO (Either Error PullRequest) pullRequest = pullRequest' Nothing -- | Query a single pull request. -- See pullRequestR :: Name Owner -> Name Repo -> IssueNumber -> Request k PullRequest pullRequestR user repo prid = query ["repos", toPathPart user, toPathPart repo, "pulls", toPathPart prid] [] createPullRequest :: Auth -> Name Owner -> Name Repo -> CreatePullRequest -> IO (Either Error PullRequest) createPullRequest auth user repo cpr = executeRequest auth $ createPullRequestR user repo cpr -- | Create a pull request. -- See createPullRequestR :: Name Owner -> Name Repo -> CreatePullRequest -> Request 'RW PullRequest createPullRequestR user repo cpr = command Post ["repos", toPathPart user, toPathPart repo, "pulls"] (encode cpr) -- | Update a pull request 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 updatePullRequestR :: Name Owner -> Name Repo -> IssueNumber -> EditPullRequest -> Request 'RW PullRequest updatePullRequestR user repo prid epr = command Patch ["repos", toPathPart user, toPathPart repo, "pulls", toPathPart prid] (encode epr) -- | All the commits on a pull request, given the repo owner, repo name, and -- the number of the pull request. -- With authentification. -- -- > pullRequestCommits' (Just $ BasicAuth "github-username" "github-password") "thoughtbot" "paperclip" 688 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 -> IssueNumber -> IO (Either Error (Vector Commit)) pullRequestCommitsIO = pullRequestCommits' Nothing -- | List commits on a pull request. -- See 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"] [] -- | The individual files that a pull request patches. Takes the repo owner and -- name, plus the number assigned to the pull request. -- With authentification. -- -- > pullRequestFiles' (Just $ BasicAuth "github-username" "github-password") "thoughtbot" "paperclip" 688 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 -> IssueNumber -> IO (Either Error (Vector File)) pullRequestFiles = pullRequestFiles' Nothing -- | List pull requests files. -- See 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"] [] -- | Check if pull request has been merged. isPullRequestMerged :: Auth -> Name Owner -> Name Repo -> IssueNumber -> IO (Either Error Bool) isPullRequestMerged auth user repo prid = executeRequest auth $ isPullRequestMergedR user repo prid -- | Query if a pull request has been merged. -- See isPullRequestMergedR :: Name Owner -> Name Repo -> IssueNumber -> GenRequest 'MtStatus rw Bool isPullRequestMergedR user repo prid = Query ["repos", toPathPart user, toPathPart repo, "pulls", toPathPart prid, "merge"] [] -- | Merge a pull request. mergePullRequest :: Auth -> Name Owner -> Name Repo -> IssueNumber -> Maybe Text -> IO (Either Error MergeResult) mergePullRequest auth user repo prid commitMessage = executeRequest auth $ mergePullRequestR user repo prid commitMessage -- | Merge a pull request (Merge Button). -- https://developer.github.com/v3/pulls/#merge-a-pull-request-merge-button mergePullRequestR :: Name Owner -> Name Repo -> IssueNumber -> Maybe Text -> GenRequest 'MtStatus 'RW MergeResult mergePullRequestR user repo prid commitMessage = Command Put paths (encode $ buildCommitMessageMap commitMessage) where paths = ["repos", toPathPart user, toPathPart repo, "pulls", toPathPart prid, "merge"] buildCommitMessageMap :: Maybe Text -> Value buildCommitMessageMap (Just msg) = object ["commit_message" .= msg ] buildCommitMessageMap Nothing = object [] github-0.23/src/GitHub/Endpoints/PullRequests/0000755000000000000000000000000007346545000017475 5ustar0000000000000000github-0.23/src/GitHub/Endpoints/PullRequests/Comments.hs0000644000000000000000000000542307346545000021622 0ustar0000000000000000----------------------------------------------------------------------------- -- | -- License : BSD-3-Clause -- Maintainer : Oleg Grenrus -- -- The pull request review comments API as described at -- . module GitHub.Endpoints.PullRequests.Comments ( pullRequestCommentsIO, pullRequestCommentsR, pullRequestComment, pullRequestCommentR, createPullComment, createPullCommentR, module GitHub.Data, ) where import GitHub.Data import GitHub.Internal.Prelude import GitHub.Request import Prelude () -- | All the comments on a pull request with the given ID. -- -- > pullRequestComments "thoughtbot" "factory_girl" (Id 256) pullRequestCommentsIO :: Name Owner -> Name Repo -> IssueNumber -> IO (Either Error (Vector Comment)) pullRequestCommentsIO user repo prid = executeRequest' $ pullRequestCommentsR user repo prid FetchAll -- | List comments on a pull request. -- See pullRequestCommentsR :: Name Owner -> Name Repo -> IssueNumber -> FetchCount -> Request k (Vector Comment) pullRequestCommentsR user repo prid = pagedQuery ["repos", toPathPart user, toPathPart repo, "pulls", toPathPart prid, "comments"] [] -- | One comment on a pull request, by the comment's ID. -- -- > pullRequestComment "thoughtbot" "factory_girl" (Id 301819) pullRequestComment :: Name Owner -> Name Repo -> Id Comment -> IO (Either Error Comment) pullRequestComment user repo cid = executeRequest' $ pullRequestCommentR user repo cid -- | Query a single comment. -- See 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 (BasicAuth "github-username" "github-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 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"] github-0.23/src/GitHub/Endpoints/PullRequests/Reviews.hs0000644000000000000000000001171507346545000021462 0ustar0000000000000000----------------------------------------------------------------------------- -- | -- License : BSD-3-Clause -- Maintainer : Oleg Grenrus -- -- The reviews API as described on . module GitHub.Endpoints.PullRequests.Reviews ( pullRequestReviewsR , pullRequestReviews , pullRequestReviews' , pullRequestReviewR , pullRequestReview , pullRequestReview' , pullRequestReviewCommentsR , pullRequestReviewCommentsIO , pullRequestReviewCommentsIO' , module GitHub.Data ) where import GitHub.Data import GitHub.Data.Id (Id) import GitHub.Internal.Prelude import GitHub.Request (Request, executeRequest', executeRequestMaybe) import Prelude () -- | List reviews for a pull request. -- See pullRequestReviewsR :: Name Owner -> Name Repo -> Id PullRequest -> FetchCount -> Request k (Vector Review) pullRequestReviewsR owner repo prid = pagedQuery [ "repos" , toPathPart owner , toPathPart repo , "pulls" , toPathPart prid , "reviews" ] [] -- | All reviews for a pull request given the repo owner, repo name and the pull -- request id. -- -- > pullRequestReviews "thoughtbot" "paperclip" (Id 101) pullRequestReviews :: Name Owner -> Name Repo -> Id PullRequest -> IO (Either Error (Vector Review)) pullRequestReviews owner repo prid = executeRequest' $ pullRequestReviewsR owner repo prid FetchAll -- | All reviews for a pull request given the repo owner, repo name and the pull -- request id. With authentication. -- -- > pullRequestReviews' (Just $ BasicAuth "github-username" "github-password") "thoughtbot" "paperclip" (Id 101) pullRequestReviews' :: Maybe Auth -> Name Owner -> Name Repo -> Id PullRequest -> IO (Either Error (Vector Review)) pullRequestReviews' auth owner repo pr = executeRequestMaybe auth $ pullRequestReviewsR owner repo pr FetchAll -- | Query a single pull request review. -- see pullRequestReviewR :: Name Owner -> Name Repo -> Id PullRequest -> Id Review -> Request k Review pullRequestReviewR owner repo prid rid = query [ "repos" , toPathPart owner , toPathPart repo , "pulls" , toPathPart prid , "reviews" , toPathPart rid ] [] -- | A detailed review on a pull request given the repo owner, repo name, pull -- request id and review id. -- -- > pullRequestReview "thoughtbot" "factory_girl" (Id 301819) (Id 332) pullRequestReview :: Name Owner -> Name Repo -> Id PullRequest -> Id Review -> IO (Either Error Review) pullRequestReview owner repo prid rid = executeRequest' $ pullRequestReviewR owner repo prid rid -- | A detailed review on a pull request given the repo owner, repo name, pull -- request id and review id. With authentication. -- -- > pullRequestReview' (Just $ BasicAuth "github-username" "github-password") -- > "thoughtbot" "factory_girl" (Id 301819) (Id 332) pullRequestReview' :: Maybe Auth -> Name Owner -> Name Repo -> Id PullRequest -> Id Review -> IO (Either Error Review) pullRequestReview' auth owner repo prid rid = executeRequestMaybe auth $ pullRequestReviewR owner repo prid rid -- | Query the comments for a single pull request review. -- see pullRequestReviewCommentsR :: Name Owner -> Name Repo -> Id PullRequest -> Id Review -> Request k [ReviewComment] pullRequestReviewCommentsR owner repo prid rid = query [ "repos" , toPathPart owner , toPathPart repo , "pulls" , toPathPart prid , "reviews" , toPathPart rid , "comments" ] [] -- | All comments for a review on a pull request given the repo owner, repo -- name, pull request id and review id. -- -- > pullRequestReviewComments "thoughtbot" "factory_girl" (Id 301819) (Id 332) pullRequestReviewCommentsIO :: Name Owner -> Name Repo -> Id PullRequest -> Id Review -> IO (Either Error [ReviewComment]) pullRequestReviewCommentsIO owner repo prid rid = executeRequest' $ pullRequestReviewCommentsR owner repo prid rid -- | All comments for a review on a pull request given the repo owner, repo -- name, pull request id and review id. With authentication. -- -- > pullRequestReviewComments' (Just $ BasicAuth "github-username" "github-password") "thoughtbot" "factory_girl" (Id 301819) (Id 332) pullRequestReviewCommentsIO' :: Maybe Auth -> Name Owner -> Name Repo -> Id PullRequest -> Id Review -> IO (Either Error [ReviewComment]) pullRequestReviewCommentsIO' auth owner repo prid rid = executeRequestMaybe auth $ pullRequestReviewCommentsR owner repo prid rid github-0.23/src/GitHub/Endpoints/RateLimit.hs0000644000000000000000000000215207346545000017253 0ustar0000000000000000----------------------------------------------------------------------------- -- | -- License : BSD-3-Clause -- Maintainer : Oleg Grenrus -- -- The Github RateLimit API, as described at -- . module GitHub.Endpoints.RateLimit ( rateLimitR, rateLimit, rateLimit', module GitHub.Data, ) where import GitHub.Data import GitHub.Internal.Prelude import GitHub.Request import Prelude () -- | Get your current rate limit status (Note: Accessing this endpoint does not count against your rate limit.) -- With authentication. rateLimit' :: Maybe Auth -> IO (Either Error RateLimit) rateLimit' auth = executeRequestMaybe auth rateLimitR -- | Get your current rate limit status (Note: Accessing this endpoint does not count against your rate limit.) -- Without authentication. rateLimit :: IO (Either Error RateLimit) rateLimit = rateLimit' Nothing -- | Get your current rate limit status. -- rateLimitR :: Request k RateLimit rateLimitR = query ["rate_limit"] [] github-0.23/src/GitHub/Endpoints/Repos.hs0000644000000000000000000003033707346545000016457 0ustar0000000000000000----------------------------------------------------------------------------- -- | -- License : BSD-3-Clause -- Maintainer : Oleg Grenrus -- -- The Github Repos API, as documented at -- module GitHub.Endpoints.Repos ( -- * Querying repositories currentUserRepos, currentUserReposR, userRepos, userRepos', userReposR, organizationRepos, organizationRepos', organizationReposR, repository, repository', repositoryR, contributors, contributors', contributorsR, contributorsWithAnonymous, contributorsWithAnonymous', languagesFor, languagesFor', languagesForR, tagsFor, tagsFor', tagsForR, branchesFor, branchesFor', branchesForR, -- ** Create createRepo', createRepoR, createOrganizationRepo', createOrganizationRepoR, forkExistingRepo', forkExistingRepoR, -- ** Edit editRepo, editRepoR, -- ** Delete deleteRepo, deleteRepoR, -- * Data module GitHub.Data, ) where import GitHub.Data import GitHub.Internal.Prelude import GitHub.Request import Prelude () repoPublicityQueryString :: RepoPublicity -> QueryString repoPublicityQueryString RepoPublicityAll = [("type", Just "all")] repoPublicityQueryString RepoPublicityOwner = [("type", Just "owner")] repoPublicityQueryString RepoPublicityMember = [("type", Just "member")] repoPublicityQueryString RepoPublicityPublic = [("type", Just "public")] repoPublicityQueryString RepoPublicityPrivate = [("type", Just "private")] -- | List your repositories. currentUserRepos :: Auth -> RepoPublicity -> IO (Either Error (Vector Repo)) currentUserRepos auth publicity = executeRequest auth $ currentUserReposR publicity FetchAll -- | List your repositories. -- See currentUserReposR :: RepoPublicity -> FetchCount -> Request k (Vector Repo) currentUserReposR publicity = pagedQuery ["user", "repos"] qs where qs = repoPublicityQueryString publicity -- | The repos for a user, by their login. Can be restricted to just repos they -- own, are a member of, or publicize. Private repos will return empty list. -- -- > userRepos "mike-burns" All userRepos :: Name Owner -> RepoPublicity -> IO (Either Error (Vector Repo)) userRepos = userRepos' Nothing -- | The repos for a user, by their login. -- With authentication. -- -- > userRepos' (Just $ BasicAuth "github-username" "github-password") "mike-burns" All userRepos' :: Maybe Auth -> Name Owner -> RepoPublicity -> IO (Either Error (Vector Repo)) userRepos' auth user publicity = executeRequestMaybe auth $ userReposR user publicity FetchAll -- | List user repositories. -- See userReposR :: Name Owner -> RepoPublicity -> FetchCount -> Request k(Vector Repo) userReposR user publicity = pagedQuery ["users", toPathPart user, "repos"] qs where qs = repoPublicityQueryString publicity -- | The repos for an organization, by the organization name. -- -- > organizationRepos "thoughtbot" organizationRepos :: Name Organization -> IO (Either Error (Vector Repo)) organizationRepos org = organizationRepos' Nothing org RepoPublicityAll -- | The repos for an organization, by the organization name. -- With authentication. -- -- > organizationRepos (Just $ BasicAuth "github-username" "github-password") "thoughtbot" All organizationRepos' :: Maybe Auth -> Name Organization -> RepoPublicity -> IO (Either Error (Vector Repo)) organizationRepos' auth org publicity = executeRequestMaybe auth $ organizationReposR org publicity FetchAll -- | List organization repositories. -- See organizationReposR :: Name Organization -> RepoPublicity -> FetchCount -> Request k (Vector Repo) organizationReposR org publicity = pagedQuery ["orgs", toPathPart org, "repos"] qs where qs = repoPublicityQueryString publicity -- | Details on a specific repo, given the owner and repo name. -- -- > repository "mike-burns" "github" repository :: Name Owner -> Name Repo -> IO (Either Error Repo) repository = repository' Nothing -- | Details on a specific repo, given the owner and repo name. -- With authentication. -- -- > repository' (Just $ BasicAuth "github-username" "github-password") "mike-burns" "github" repository' :: Maybe Auth -> Name Owner -> Name Repo -> IO (Either Error Repo) repository' auth user repo = executeRequestMaybe auth $ repositoryR user repo -- | Query single repository. -- See repositoryR :: Name Owner -> Name Repo -> Request k Repo repositoryR user repo = query ["repos", toPathPart user, toPathPart repo] [] -- | Create a new repository. -- -- > createRepo' (BasicAuth (user, password)) (newRepo "some_repo") {newRepoHasIssues = Just False} createRepo' :: Auth -> NewRepo -> IO (Either Error Repo) createRepo' auth nrepo = executeRequest auth $ createRepoR nrepo -- | Create a new repository. -- See 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 -- TODO: The third paramater (an optional Organisation) is not used yet. forkExistingRepoR :: Name Owner -> Name Repo -> Maybe (Name Owner) -> Request 'RW Repo forkExistingRepoR owner repo _morg = command Post ["repos", toPathPart owner, toPathPart repo, "forks" ] mempty -- | Create a new repository for an organization. -- -- > createOrganizationRepo (BasicAuth (user, password)) "thoughtbot" (newRepo "some_repo") {newRepoHasIssues = Just False} createOrganizationRepo' :: Auth -> Name Organization -> NewRepo -> IO (Either Error Repo) createOrganizationRepo' auth org nrepo = executeRequest auth $ createOrganizationRepoR org nrepo -- | Create a new repository for an organization. -- See createOrganizationRepoR :: Name Organization -> NewRepo -> Request 'RW Repo createOrganizationRepoR org nrepo = command Post ["orgs", toPathPart org, "repos"] (encode nrepo) -- | Edit an existing repository. -- -- > editRepo (BasicAuth (user, password)) "some_user" "some_repo" def {editDescription = Just "some description"} editRepo :: Auth -> Name Owner -- ^ owner -> Name Repo -- ^ repository name -> EditRepo -> IO (Either Error Repo) editRepo auth user repo body = executeRequest auth $ editRepoR user repo body -- | Edit an existing repository. -- See editRepoR :: Name Owner -> Name Repo -> EditRepo -> Request 'RW Repo editRepoR user repo body = command Patch ["repos", toPathPart user, toPathPart repo] (encode b) where -- if no name is given, use curent name b = body {editName = editName body <|> Just repo} -- | The contributors to a repo, given the owner and repo name. -- -- > contributors "thoughtbot" "paperclip" contributors :: Name Owner -> Name Repo -> IO (Either Error (Vector Contributor)) contributors = contributors' Nothing -- | The contributors to a repo, given the owner and repo name. -- With authentication. -- -- > contributors' (Just $ BasicAuth "github-username" "github-password") "thoughtbot" "paperclip" contributors' :: Maybe Auth -> Name Owner -> Name Repo -> IO (Either Error (Vector Contributor)) contributors' auth user repo = executeRequestMaybe auth $ contributorsR user repo False FetchAll -- | List contributors. -- See contributorsR :: Name Owner -> Name Repo -> Bool -- ^ Include anonymous -> FetchCount -> Request k (Vector Contributor) contributorsR user repo anon = pagedQuery ["repos", toPathPart user, toPathPart repo, "contributors"] qs where qs | anon = [("anon", Just "true")] | otherwise = [] -- | The contributors to a repo, including anonymous contributors (such as -- deleted users or git commits with unknown email addresses), given the owner -- and repo name. -- -- > contributorsWithAnonymous "thoughtbot" "paperclip" contributorsWithAnonymous :: Name Owner -> Name Repo -> IO (Either Error (Vector Contributor)) contributorsWithAnonymous = contributorsWithAnonymous' Nothing -- | The contributors to a repo, including anonymous contributors (such as -- deleted users or git commits with unknown email addresses), given the owner -- and repo name. -- With authentication. -- -- > contributorsWithAnonymous' (Just $ BasicAuth "github-username" "github-password") "thoughtbot" "paperclip" contributorsWithAnonymous' :: Maybe Auth -> Name Owner -> Name Repo -> IO (Either Error (Vector Contributor)) contributorsWithAnonymous' auth user repo = executeRequestMaybe auth $ contributorsR user repo True FetchAll -- | The programming languages used in a repo along with the number of -- characters written in that language. Takes the repo owner and name. -- -- > languagesFor "mike-burns" "ohlaunch" languagesFor :: Name Owner -> Name Repo -> IO (Either Error Languages) languagesFor = languagesFor' Nothing -- | The programming languages used in a repo along with the number of -- characters written in that language. Takes the repo owner and name. -- With authentication. -- -- > languagesFor' (Just $ BasicAuth "github-username" "github-password") "mike-burns" "ohlaunch" languagesFor' :: Maybe Auth -> Name Owner -> Name Repo -> IO (Either Error Languages) languagesFor' auth user repo = executeRequestMaybe auth $ languagesForR user repo -- | List languages. -- See languagesForR :: Name Owner -> Name Repo -> Request k Languages languagesForR user repo = query ["repos", toPathPart user, toPathPart repo, "languages"] [] -- | The git tags on a repo, given the repo owner and name. -- -- > tagsFor "thoughtbot" "paperclip" tagsFor :: Name Owner -> Name Repo -> IO (Either Error (Vector Tag)) tagsFor = tagsFor' Nothing -- | The git tags on a repo, given the repo owner and name. -- With authentication. -- -- > tagsFor' (Just $ BasicAuth "github-username" "github-password") "thoughtbot" "paperclip" tagsFor' :: Maybe Auth -> Name Owner -> Name Repo -> IO (Either Error (Vector Tag)) tagsFor' auth user repo = executeRequestMaybe auth $ tagsForR user repo FetchAll -- | List tags. -- See tagsForR :: Name Owner -> Name Repo -> FetchCount -> Request k (Vector Tag) tagsForR user repo = pagedQuery ["repos", toPathPart user, toPathPart repo, "tags"] [] -- | The git branches on a repo, given the repo owner and name. -- -- > branchesFor "thoughtbot" "paperclip" branchesFor :: Name Owner -> Name Repo -> IO (Either Error (Vector Branch)) branchesFor = branchesFor' Nothing -- | The git branches on a repo, given the repo owner and name. -- With authentication. -- -- > branchesFor' (Just $ BasicAuth "github-username" "github-password") "thoughtbot" "paperclip" branchesFor' :: Maybe Auth -> Name Owner -> Name Repo -> IO (Either Error (Vector Branch)) branchesFor' auth user repo = executeRequestMaybe auth $ branchesForR user repo FetchAll -- | List branches. -- See branchesForR :: Name Owner -> Name Repo -> FetchCount -> Request k (Vector Branch) branchesForR user repo = pagedQuery ["repos", toPathPart user, toPathPart repo, "branches"] [] -- | Delete an existing repository. -- -- > deleteRepo (BasicAuth (user, password)) "thoughtbot" "some_repo" deleteRepo :: Auth -> Name Owner -> Name Repo -> IO (Either Error ()) deleteRepo auth user repo = executeRequest auth $ deleteRepoR user repo -- | Delete a repository,. -- See deleteRepoR :: Name Owner -> Name Repo -> GenRequest 'MtUnit 'RW () deleteRepoR user repo = Command Delete ["repos", toPathPart user, toPathPart repo] mempty github-0.23/src/GitHub/Endpoints/Repos/0000755000000000000000000000000007346545000016115 5ustar0000000000000000github-0.23/src/GitHub/Endpoints/Repos/Collaborators.hs0000644000000000000000000000622407346545000021263 0ustar0000000000000000----------------------------------------------------------------------------- -- | -- License : BSD-3-Clause -- Maintainer : Oleg Grenrus -- -- The repo collaborators API as described on -- . module GitHub.Endpoints.Repos.Collaborators ( collaboratorsOn, collaboratorsOn', collaboratorsOnR, isCollaboratorOn, isCollaboratorOnR, addCollaborator, addCollaboratorR, module GitHub.Data, ) where import GitHub.Data import GitHub.Internal.Prelude import GitHub.Request import Prelude () -- | All the users who have collaborated on a repo. -- -- > collaboratorsOn "thoughtbot" "paperclip" collaboratorsOn :: Name Owner -> Name Repo -> IO (Either Error (Vector SimpleUser)) collaboratorsOn = collaboratorsOn' Nothing -- | All the users who have collaborated on a repo. -- With authentication. collaboratorsOn' :: Maybe Auth -> Name Owner -> Name Repo -> IO (Either Error (Vector SimpleUser)) collaboratorsOn' auth user repo = executeRequestMaybe auth $ collaboratorsOnR user repo FetchAll -- | List collaborators. -- See collaboratorsOnR :: Name Owner -> Name Repo -> FetchCount -> Request k (Vector SimpleUser) collaboratorsOnR user repo = pagedQuery ["repos", toPathPart user, toPathPart repo, "collaborators"] [] -- | Whether the user is collaborating on a repo. Takes the user in question, -- the user who owns the repo, and the repo name. -- -- > isCollaboratorOn Nothing "mike-burns" "thoughtbot" "paperclip" -- > isCollaboratorOn Nothing "johnson" "thoughtbot" "paperclip" isCollaboratorOn :: Maybe Auth -> Name Owner -- ^ Repository owner -> Name Repo -- ^ Repository name -> Name User -- ^ Collaborator? -> IO (Either Error Bool) isCollaboratorOn auth user repo coll = executeRequestMaybe auth $ isCollaboratorOnR user repo coll -- | Check if a user is a collaborator. -- See isCollaboratorOnR :: Name Owner -- ^ Repository owner -> Name Repo -- ^ Repository name -> Name User -- ^ Collaborator? -> GenRequest 'MtStatus rw Bool isCollaboratorOnR user repo coll = Query ["repos", toPathPart user, toPathPart repo, "collaborators", toPathPart coll] [] addCollaborator :: Auth -> Name Owner -- ^ Repository owner -> Name Repo -- ^ Repository name -> Name User -- ^ Collaborator to add -> IO (Either Error (Maybe RepoInvitation)) addCollaborator auth owner repo coll = executeRequest auth $ addCollaboratorR owner repo coll -- | Invite a user as a collaborator. -- See addCollaboratorR :: Name Owner -- ^ Repository owner -> Name Repo -- ^ Repository name -> Name User -- ^ Collaborator to add -> GenRequest 'MtJSON 'RW (Maybe RepoInvitation) addCollaboratorR owner repo coll = Command Put ["repos", toPathPart owner, toPathPart repo, "collaborators", toPathPart coll] mempty github-0.23/src/GitHub/Endpoints/Repos/Comments.hs0000644000000000000000000000655707346545000020253 0ustar0000000000000000{-# LANGUAGE CPP #-} ----------------------------------------------------------------------------- -- | -- License : BSD-3-Clause -- Maintainer : Oleg Grenrus -- -- The repo commits API as described on -- . module GitHub.Endpoints.Repos.Comments ( commentsFor, commentsFor', commentsForR, commitCommentsFor, commitCommentsFor', commitCommentsForR, commitCommentFor, commitCommentFor', commitCommentForR, module GitHub.Data, ) where import GitHub.Data import GitHub.Internal.Prelude import GitHub.Request import Prelude () -- | All the comments on a Github repo. -- -- > commentsFor "thoughtbot" "paperclip" commentsFor :: Name Owner -> Name Repo -> IO (Either Error (Vector Comment)) commentsFor = commentsFor' Nothing -- | All the comments on a Github repo. -- With authentication. -- -- > commentsFor "thoughtbot" "paperclip" commentsFor' :: Maybe Auth -> Name Owner -> Name Repo -> IO (Either Error (Vector Comment)) commentsFor' auth user repo = executeRequestMaybe auth $ commentsForR user repo FetchAll -- | List commit comments for a repository. -- See commentsForR :: Name Owner -> Name Repo -> FetchCount -> Request k (Vector Comment) commentsForR user repo = pagedQuery ["repos", toPathPart user, toPathPart repo, "comments"] [] -- | Just the comments on a specific SHA for a given Github repo. -- -- > commitCommentsFor "thoughtbot" "paperclip" "41f685f6e01396936bb8cd98e7cca517e2c7d96b" commitCommentsFor :: Name Owner -> Name Repo -> Name Commit -> IO (Either Error (Vector Comment)) commitCommentsFor = commitCommentsFor' Nothing -- | Just the comments on a specific SHA for a given Github repo. -- With authentication. -- -- > commitCommentsFor "thoughtbot" "paperclip" "41f685f6e01396936bb8cd98e7cca517e2c7d96b" commitCommentsFor' :: Maybe Auth -> Name Owner -> Name Repo -> Name Commit -> IO (Either Error (Vector Comment)) commitCommentsFor' auth user repo sha = executeRequestMaybe auth $ commitCommentsForR user repo sha FetchAll -- | List comments for a single commit. -- See commitCommentsForR :: Name Owner -> Name Repo -> Name Commit -> FetchCount -> Request k (Vector Comment) commitCommentsForR user repo sha = pagedQuery ["repos", toPathPart user, toPathPart repo, "commits", toPathPart sha, "comments"] [] -- | A comment, by its ID, relative to the Github repo. -- -- > commitCommentFor "thoughtbot" "paperclip" "669575" commitCommentFor :: Name Owner -> Name Repo -> Id Comment -> IO (Either Error Comment) commitCommentFor = commitCommentFor' Nothing -- | A comment, by its ID, relative to the Github repo. -- -- > commitCommentFor "thoughtbot" "paperclip" "669575" commitCommentFor' :: Maybe Auth -> Name Owner -> Name Repo -> Id Comment -> IO (Either Error Comment) commitCommentFor' auth user repo cid = executeRequestMaybe auth $ commitCommentForR user repo cid -- | Query a single commit comment. -- See commitCommentForR :: Name Owner -> Name Repo -> Id Comment -> Request k Comment commitCommentForR user repo cid = query ["repos", toPathPart user, toPathPart repo, "comments", toPathPart cid] [] github-0.23/src/GitHub/Endpoints/Repos/Commits.hs0000644000000000000000000001167707346545000020100 0ustar0000000000000000{-# LANGUAGE CPP #-} ----------------------------------------------------------------------------- -- | -- License : BSD-3-Clause -- Maintainer : Oleg Grenrus -- -- The repo commits API as described on -- . module GitHub.Endpoints.Repos.Commits ( CommitQueryOption(..), commitsFor, commitsFor', commitsForR, commitsWithOptionsFor, commitsWithOptionsFor', commitsWithOptionsForR, commit, commit', commitR, diff, diff', diffR, module GitHub.Data, ) where import GitHub.Data import GitHub.Internal.Prelude import GitHub.Request import Prelude () import qualified Data.ByteString as BS import qualified Data.Text as T import qualified Data.Text.Encoding as TE renderCommitQueryOption :: CommitQueryOption -> (BS.ByteString, Maybe BS.ByteString) renderCommitQueryOption (CommitQuerySha sha) = ("sha", Just $ TE.encodeUtf8 sha) renderCommitQueryOption (CommitQueryPath path) = ("path", Just $ TE.encodeUtf8 path) renderCommitQueryOption (CommitQueryAuthor author) = ("author", Just $ TE.encodeUtf8 author) renderCommitQueryOption (CommitQuerySince date) = ("since", Just $ TE.encodeUtf8 . T.pack $ formatISO8601 date) renderCommitQueryOption (CommitQueryUntil date) = ("until", Just $ TE.encodeUtf8 . T.pack $ formatISO8601 date) -- | The commit history for a repo. -- -- > commitsFor "mike-burns" "github" commitsFor :: Name Owner -> Name Repo -> IO (Either Error (Vector Commit)) commitsFor = commitsFor' Nothing -- | The commit history for a repo. -- With authentication. -- -- > commitsFor' (Just $ BasicAuth "github-username" "github-password") "mike-burns" "github" commitsFor' :: Maybe Auth -> Name Owner -> Name Repo -> IO (Either Error (Vector Commit)) commitsFor' auth user repo = commitsWithOptionsFor' auth user repo [] -- | List commits on a repository. -- See commitsForR :: Name Owner -> Name Repo -> FetchCount -> Request k (Vector Commit) commitsForR user repo limit = commitsWithOptionsForR user repo limit [] commitsWithOptionsFor :: Name Owner -> Name Repo -> [CommitQueryOption] -> IO (Either Error (Vector Commit)) commitsWithOptionsFor = commitsWithOptionsFor' Nothing -- | The commit history for a repo, with commits filtered to satisfy a list of -- query options. -- With authentication. -- -- > commitsWithOptionsFor' (Just $ BasicAuth "github-username" "github-password") "mike-burns" "github" [CommitQueryAuthor "djeik"] commitsWithOptionsFor' :: Maybe Auth -> Name Owner -> Name Repo -> [CommitQueryOption] -> IO (Either Error (Vector Commit)) commitsWithOptionsFor' auth user repo opts = executeRequestMaybe auth $ commitsWithOptionsForR user repo FetchAll opts -- | List commits on a repository. -- See commitsWithOptionsForR :: Name Owner -> Name Repo -> FetchCount -> [CommitQueryOption] -> Request k (Vector Commit) commitsWithOptionsForR user repo limit opts = pagedQuery ["repos", toPathPart user, toPathPart repo, "commits"] qs limit where qs = map renderCommitQueryOption opts -- | Details on a specific SHA1 for a repo. -- -- > commit "mike-burns" "github" "9d1a9a361266c3c890b1108ad2fdf52f824b1b81" commit :: Name Owner -> Name Repo -> Name Commit -> IO (Either Error Commit) commit = commit' Nothing -- | Details on a specific SHA1 for a repo. -- With authentication. -- -- > commit (Just $ BasicAuth "github-username" "github-password") "mike-burns" "github" "9d1a9a361266c3c890b1108ad2fdf52f824b1b81" commit' :: Maybe Auth -> Name Owner -> Name Repo -> Name Commit -> IO (Either Error Commit) commit' auth user repo sha = executeRequestMaybe auth $ commitR user repo sha -- | Query a single commit. -- See commitR :: Name Owner -> Name Repo -> Name Commit -> Request k Commit commitR user repo sha = query ["repos", toPathPart user, toPathPart repo, "commits", toPathPart sha] [] -- | The diff between two treeishes on a repo. -- -- > diff "thoughtbot" "paperclip" "41f685f6e01396936bb8cd98e7cca517e2c7d96b" "HEAD" diff :: Name Owner -> Name Repo -> Name Commit -> Name Commit -> IO (Either Error Diff) diff = diff' Nothing -- | The diff between two treeishes on a repo. -- -- > diff "thoughtbot" "paperclip" "41f685f6e01396936bb8cd98e7cca517e2c7d96b" "HEAD" diff' :: Maybe Auth -> Name Owner -> Name Repo -> Name Commit -> Name Commit -> IO (Either Error Diff) diff' auth user repo base headref = executeRequestMaybe auth $ diffR user repo base headref -- | Compare two commits. -- See diffR :: Name Owner -> Name Repo -> Name Commit -> Name Commit -> Request k Diff diffR user repo base headref = query ["repos", toPathPart user, toPathPart repo, "compare", toPathPart base <> "..." <> toPathPart headref] [] github-0.23/src/GitHub/Endpoints/Repos/Contents.hs0000644000000000000000000001272107346545000020251 0ustar0000000000000000----------------------------------------------------------------------------- -- | -- License : BSD-3-Clause -- Maintainer : Oleg Grenrus -- -- The Github Repo Contents API, as documented at -- module GitHub.Endpoints.Repos.Contents ( -- * Querying contents contentsFor, contentsFor', contentsForR, readmeFor, readmeFor', readmeForR, archiveFor, archiveFor', archiveForR, -- ** Create createFile, createFileR, -- ** Update updateFile, updateFileR, -- ** Delete deleteFile, deleteFileR, module GitHub.Data ) where import GitHub.Data import GitHub.Internal.Prelude import GitHub.Request import Prelude () import Data.Maybe (maybeToList) import qualified Data.Text.Encoding as TE import Network.URI (URI) -- | The contents of a file or directory in a repo, given the repo owner, name, and path to the file -- -- > contentsFor "thoughtbot" "paperclip" "README.md" contentsFor :: Name Owner -> Name Repo -> Text -> Maybe Text -> IO (Either Error Content) contentsFor = contentsFor' Nothing -- | The contents of a file or directory in a repo, given the repo owner, name, and path to the file -- With Authentication -- -- > contentsFor' (Just $ BasicAuth "github-username" "github-password") "thoughtbot" "paperclip" "README.md" Nothing contentsFor' :: Maybe Auth -> Name Owner -> Name Repo -> Text -> Maybe Text -> IO (Either Error Content) contentsFor' auth user repo path ref = executeRequestMaybe auth $ contentsForR user repo path ref contentsForR :: Name Owner -> Name Repo -> Text -- ^ file or directory -> Maybe Text -- ^ Git commit -> Request k Content contentsForR user repo path ref = query ["repos", toPathPart user, toPathPart repo, "contents", path] qs where qs = maybe [] (\r -> [("ref", Just . TE.encodeUtf8 $ r)]) ref -- | The contents of a README file in a repo, given the repo owner and name -- -- > readmeFor "thoughtbot" "paperclip" readmeFor :: Name Owner -> Name Repo -> IO (Either Error Content) readmeFor = readmeFor' Nothing -- | The contents of a README file in a repo, given the repo owner and name -- With Authentication -- -- > readmeFor' (Just $ BasicAuth "github-username" "github-password") "thoughtbot" "paperclip" readmeFor' :: Maybe Auth -> Name Owner -> Name Repo -> IO (Either Error Content) readmeFor' auth user repo = executeRequestMaybe auth $ readmeForR user repo readmeForR :: Name Owner -> Name Repo -> Request k Content readmeForR user repo = query ["repos", toPathPart user, toPathPart repo, "readme"] [] -- | The archive of a repo, given the repo owner, name, and archive type -- -- > archiveFor "thoughtbot" "paperclip" ArchiveFormatTarball Nothing archiveFor :: Name Owner -> Name Repo -> ArchiveFormat -> Maybe Text -> IO (Either Error URI) archiveFor = archiveFor' Nothing -- | The archive of a repo, given the repo owner, name, and archive type -- With Authentication -- -- > archiveFor' (Just $ BasicAuth "github-username" "github-password") "thoughtbot" "paperclip" ArchiveFormatTarball Nothing archiveFor' :: Maybe Auth -> Name Owner -> Name Repo -> ArchiveFormat -> Maybe Text -> IO (Either Error URI) archiveFor' auth user repo path ref = executeRequestMaybe auth $ archiveForR user repo path ref -- | Get archive link. -- See archiveForR :: Name Owner -> Name Repo -> ArchiveFormat -- ^ The type of archive to retrieve -> Maybe Text -- ^ Git commit -> GenRequest 'MtRedirect rw URI archiveForR user repo format ref = Query path [] where path = ["repos", toPathPart user, toPathPart repo, toPathPart format] <> maybeToList ref -- | Create a file. createFile :: Auth -> Name Owner -- ^ owner -> Name Repo -- ^ repository name -> CreateFile -> IO (Either Error ContentResult) createFile auth user repo body = executeRequest auth $ createFileR user repo body -- | Create a file. -- See createFileR :: Name Owner -> Name Repo -> CreateFile -> Request 'RW ContentResult createFileR user repo body = command Put ["repos", toPathPart user, toPathPart repo, "contents", createFilePath body] (encode body) -- | Update a file. updateFile :: Auth -> Name Owner -- ^ owner -> Name Repo -- ^ repository name -> UpdateFile -> IO (Either Error ContentResult) updateFile auth user repo body = executeRequest auth $ updateFileR user repo body -- | Update a file. -- See updateFileR :: Name Owner -> Name Repo -> UpdateFile -> Request 'RW ContentResult updateFileR user repo body = command Put ["repos", toPathPart user, toPathPart repo, "contents", updateFilePath body] (encode body) -- | Delete a file. deleteFile :: Auth -> Name Owner -- ^ owner -> Name Repo -- ^ repository name -> DeleteFile -> IO (Either Error ()) deleteFile auth user repo body = executeRequest auth $ deleteFileR user repo body -- | Delete a file. -- See deleteFileR :: Name Owner -> Name Repo -> DeleteFile -> GenRequest 'MtUnit 'RW () deleteFileR user repo body = Command Delete ["repos", toPathPart user, toPathPart repo, "contents", deleteFilePath body] (encode body) github-0.23/src/GitHub/Endpoints/Repos/DeployKeys.hs0000644000000000000000000000533207346545000020544 0ustar0000000000000000----------------------------------------------------------------------------- -- | -- License : BSD-3-Clause -- Maintainer : Todd Mohney -- -- The deploy keys API, as described at -- module GitHub.Endpoints.Repos.DeployKeys ( -- * Querying deploy keys deployKeysFor', deployKeysForR, deployKeyFor', deployKeyForR, -- ** Create createRepoDeployKey', createRepoDeployKeyR, -- ** Delete deleteRepoDeployKey', deleteRepoDeployKeyR, ) where import GitHub.Data import GitHub.Internal.Prelude import GitHub.Request import Prelude () -- | Querying deploy keys. deployKeysFor' :: Auth -> Name Owner -> Name Repo -> IO (Either Error (Vector RepoDeployKey)) deployKeysFor' auth user repo = executeRequest auth $ deployKeysForR user repo FetchAll -- | Querying deploy keys. -- See deployKeysForR :: Name Owner -> Name Repo -> FetchCount -> Request 'RA (Vector RepoDeployKey) deployKeysForR user repo = pagedQuery ["repos", toPathPart user, toPathPart repo, "keys"] [] -- | Querying a deploy key deployKeyFor' :: Auth -> Name Owner -> Name Repo -> Id RepoDeployKey -> IO (Either Error RepoDeployKey) deployKeyFor' auth user repo keyId = executeRequest auth $ deployKeyForR user repo keyId -- | Querying a deploy key. -- See deployKeyForR :: Name Owner -> Name Repo -> Id RepoDeployKey -> Request 'RA RepoDeployKey deployKeyForR user repo keyId = query ["repos", toPathPart user, toPathPart repo, "keys", toPathPart keyId] [] -- | Create a deploy key createRepoDeployKey' :: Auth -> Name Owner -> Name Repo -> NewRepoDeployKey -> IO (Either Error RepoDeployKey) createRepoDeployKey' auth user repo key = executeRequest auth $ createRepoDeployKeyR user repo key -- | Create a deploy key. -- See . createRepoDeployKeyR :: Name Owner -> Name Repo -> NewRepoDeployKey -> Request 'RW RepoDeployKey createRepoDeployKeyR user repo key = command Post ["repos", toPathPart user, toPathPart repo, "keys"] (encode key) deleteRepoDeployKey' :: Auth -> Name Owner -> Name Repo -> Id RepoDeployKey -> IO (Either Error ()) deleteRepoDeployKey' auth user repo keyId = executeRequest auth $ deleteRepoDeployKeyR user repo keyId -- | Delete a deploy key. -- See deleteRepoDeployKeyR :: Name Owner -> Name Repo -> Id RepoDeployKey -> GenRequest 'MtUnit 'RW () deleteRepoDeployKeyR user repo keyId = Command Delete ["repos", toPathPart user, toPathPart repo, "keys", toPathPart keyId] mempty github-0.23/src/GitHub/Endpoints/Repos/Deployments.hs0000644000000000000000000000427007346545000020757 0ustar0000000000000000-- | The deployments API, as described at module GitHub.Endpoints.Repos.Deployments ( deploymentsWithOptionsForR , createDeploymentR , deploymentStatusesForR , createDeploymentStatusR , module GitHub.Data ) where import Control.Arrow (second) import Data.Vector (Vector) import GitHub.Data import GitHub.Internal.Prelude -- | List deployments. -- See deploymentsWithOptionsForR :: FromJSON a => Name Owner -> Name Repo -> FetchCount -> [DeploymentQueryOption] -> Request 'RA (Vector (Deployment a)) deploymentsWithOptionsForR owner repo limit opts = pagedQuery (deployPaths owner repo) (map (second Just . renderDeploymentQueryOption) opts) limit -- | Create a deployment. -- See createDeploymentR :: ( ToJSON a , FromJSON a ) => Name Owner -> Name Repo -> CreateDeployment a -> Request 'RW (Deployment a) createDeploymentR owner repo = command Post (deployPaths owner repo) . encode -- | List deployment statuses. -- See deploymentStatusesForR :: Name Owner -> Name Repo -> Id (Deployment a) -> FetchCount -> Request 'RA (Vector DeploymentStatus) deploymentStatusesForR owner repo deploy = pagedQuery (statusesPaths owner repo deploy) [] -- | Create a deployment status. -- See createDeploymentStatusR :: Name Owner -> Name Repo -> Id (Deployment a) -> CreateDeploymentStatus -> Request 'RW DeploymentStatus createDeploymentStatusR owner repo deploy = command Post (statusesPaths owner repo deploy) . encode statusesPaths :: Name Owner -> Name Repo -> Id (Deployment a) -> Paths statusesPaths owner repo deploy = deployPaths owner repo ++ [toPathPart deploy, "statuses"] deployPaths :: Name Owner -> Name Repo -> Paths deployPaths owner repo = ["repos", toPathPart owner, toPathPart repo, "deployments"] github-0.23/src/GitHub/Endpoints/Repos/Forks.hs0000644000000000000000000000237207346545000017541 0ustar0000000000000000----------------------------------------------------------------------------- -- | -- License : BSD-3-Clause -- Maintainer : Oleg Grenrus -- -- Hot forking action, as described at -- . module GitHub.Endpoints.Repos.Forks ( forksFor, forksFor', forksForR, module GitHub.Data, ) where import GitHub.Data import GitHub.Internal.Prelude import GitHub.Request import Prelude () -- | All the repos that are forked off the given repo. -- -- > forksFor "thoughtbot" "paperclip" forksFor :: Name Owner -> Name Repo -> IO (Either Error (Vector Repo)) forksFor = forksFor' Nothing -- | All the repos that are forked off the given repo. -- | With authentication -- -- > forksFor' (Just $ BasicAuth "github-username" "github-password") "thoughtbot" "paperclip" forksFor' :: Maybe Auth -> Name Owner -> Name Repo -> IO (Either Error (Vector Repo)) forksFor' auth user repo = executeRequestMaybe auth $ forksForR user repo FetchAll -- | List forks. -- See forksForR :: Name Owner -> Name Repo -> FetchCount -> Request k (Vector Repo) forksForR user repo = pagedQuery ["repos", toPathPart user, toPathPart repo, "forks"] [] github-0.23/src/GitHub/Endpoints/Repos/Invitations.hs0000644000000000000000000000261307346545000020762 0ustar0000000000000000----------------------------------------------------------------------------- -- | -- License : BSD-3-Clause -- Maintainer : Oleg Grenrus -- -- The repo invitations API as described on -- . module GitHub.Endpoints.Repos.Invitations ( listInvitationsOnR, listInvitationsForR, acceptInvitationFromR ) where import GitHub.Data import GitHub.Internal.Prelude import Prelude () -- | List open invitations of a repository -- See listInvitationsOnR :: Name Owner -> Name Repo -> FetchCount -> GenRequest 'MtJSON k (Vector RepoInvitation) listInvitationsOnR user repo = PagedQuery ["repos", toPathPart user, toPathPart repo, "invitations"] [] -- | List a user's repository invitations -- See listInvitationsForR :: FetchCount -> Request k (Vector RepoInvitation) listInvitationsForR = pagedQuery ["user", "repository_invitations"] [] -- | Accept a repository invitation -- See acceptInvitationFromR :: Id RepoInvitation -> GenRequest 'MtUnit 'RW () acceptInvitationFromR invId = Command Patch ["user", "repository_invitations", toPathPart invId] mempty github-0.23/src/GitHub/Endpoints/Repos/Releases.hs0000644000000000000000000001052107346545000020213 0ustar0000000000000000-- The Release API, as described at -- . module GitHub.Endpoints.Repos.Releases ( releases, releases', releasesR, release, release', releaseR, latestRelease, latestRelease', latestReleaseR, releaseByTagName, releaseByTagName', releaseByTagNameR, module GitHub.Data, ) where import GitHub.Data import GitHub.Internal.Prelude import GitHub.Request import Prelude () -- | All releases for the given repo. -- -- > releases "calleerlandsson" "pick" releases :: Name Owner -> Name Repo -> IO (Either Error (Vector Release)) releases = releases' Nothing -- | All releases for the given repo with authentication. -- -- > releases' (Just $ BasicAuth "github-username" "github-password") "calleerlandsson" "pick" releases' :: Maybe Auth -> Name Owner -> Name Repo -> IO (Either Error (Vector Release)) releases' auth user repo = executeRequestMaybe auth $ releasesR user repo FetchAll -- | List releases for a repository. -- See releasesR :: Name Owner -> Name Repo -> FetchCount -> Request k (Vector Release) releasesR user repo = pagedQuery ["repos", toPathPart user, toPathPart repo, "releases"] [] -- | Query a single release. -- -- > release "calleerlandsson" "pick" release :: Name Owner -> Name Repo -> Id Release -> IO (Either Error Release) release = release' Nothing -- | Query a single release with authentication. -- -- > release' (Just $ BasicAuth "github-username" "github-password") "calleerlandsson" "pick" release' :: Maybe Auth -> Name Owner -> Name Repo -> Id Release -> IO (Either Error Release) release' auth user repo reqReleaseId = executeRequestMaybe auth $ releaseR user repo reqReleaseId -- | Get a single release. -- See releaseR :: Name Owner -> Name Repo -> Id Release -> Request k Release releaseR user repo reqReleaseId = query ["repos", toPathPart user, toPathPart repo, "releases", toPathPart reqReleaseId ] [] -- | Query latest release. -- -- > latestRelease "calleerlandsson" "pick" latestRelease :: Name Owner -> Name Repo -> IO (Either Error Release) latestRelease = latestRelease' Nothing -- | Query latest release with authentication. -- -- > latestRelease' (Just $ BasicAuth "github-username" "github-password") "calleerlandsson" "pick" latestRelease' :: Maybe Auth -> Name Owner -> Name Repo -> IO (Either Error Release) latestRelease' auth user repo = executeRequestMaybe auth $ latestReleaseR user repo -- | Get the latest release. -- See latestReleaseR :: Name Owner -> Name Repo -> Request k Release latestReleaseR user repo = query ["repos", toPathPart user, toPathPart repo, "releases", "latest" ] [] -- | Query release by tag name. -- -- > releaseByTagName "calleerlandsson" "pick" releaseByTagName :: Name Owner -> Name Repo -> Text -> IO (Either Error Release) releaseByTagName = releaseByTagName' Nothing -- | Query release by tag name with authentication. -- -- > releaseByTagName' (Just $ BasicAuth "github-username" "github-password") "calleerlandsson" "pick" releaseByTagName' :: Maybe Auth -> Name Owner -> Name Repo -> Text -> IO (Either Error Release) releaseByTagName' auth user repo reqTagName = executeRequestMaybe auth $ releaseByTagNameR user repo reqTagName -- | Get a release by tag name -- See releaseByTagNameR :: Name Owner -> Name Repo -> Text -> Request k Release releaseByTagNameR user repo reqTagName = query ["repos", toPathPart user, toPathPart repo, "releases", "tags" , reqTagName ] [] {- -- TODO: implement the following: https://developer.github.com/v3/repos/releases/#create-a-release https://developer.github.com/v3/repos/releases/#edit-a-release https://developer.github.com/v3/repos/releases/#delete-a-release https://developer.github.com/v3/repos/releases/#list-assets-for-a-release https://developer.github.com/v3/repos/releases/#upload-a-release-asset https://developer.github.com/v3/repos/releases/#get-a-single-release-asset https://developer.github.com/v3/repos/releases/#edit-a-release-asset https://developer.github.com/v3/repos/releases/#delete-a-release-asset -} github-0.23/src/GitHub/Endpoints/Repos/Statuses.hs0000644000000000000000000000520607346545000020267 0ustar0000000000000000----------------------------------------------------------------------------- -- | -- License : BSD-3-Clause -- Maintainer : Oleg Grenrus -- -- The repo statuses API as described on -- . module GitHub.Endpoints.Repos.Statuses ( createStatus, createStatusR, statusesFor, statusesForR, statusFor, statusForR, module GitHub.Data ) where import GitHub.Data import GitHub.Internal.Prelude import GitHub.Request import Prelude () -- | Create a new status -- -- > createStatus (BasicAuth user password) "thoughtbot" "paperclip" -- > "41f685f6e01396936bb8cd98e7cca517e2c7d96b" -- > (NewStatus StatusSuccess Nothing "Looks good!" Nothing) createStatus :: Auth -> Name Owner -> Name Repo -> Name Commit -> NewStatus -> IO (Either Error Status) createStatus auth owner repo sha ns = executeRequest auth $ createStatusR owner repo sha ns -- | Create a new status -- See createStatusR :: Name Owner -> Name Repo -> Name Commit -> NewStatus -> Request 'RW Status createStatusR owner repo sha = command Post parts . encode where parts = ["repos", toPathPart owner, toPathPart repo, "statuses", toPathPart sha] -- | All statuses for a commit -- -- > statusesFor (BasicAuth user password) "thoughtbot" "paperclip" -- > "41f685f6e01396936bb8cd98e7cca517e2c7d96b" statusesFor :: Auth -> Name Owner -> Name Repo -> Name Commit -> IO (Either Error (Vector Status)) statusesFor auth user repo sha = executeRequest auth $ statusesForR user repo sha FetchAll -- | All statuses for a commit -- See statusesForR :: Name Owner -> Name Repo -> Name Commit -> FetchCount -> Request 'RW (Vector Status) statusesForR user repo sha = pagedQuery ["repos", toPathPart user, toPathPart repo, "commits", toPathPart sha, "statuses"] [] -- | The combined status for a specific commit -- -- > statusFor (BasicAuth user password) "thoughtbot" "paperclip" -- > "41f685f6e01396936bb8cd98e7cca517e2c7d96b" statusFor :: Auth -> Name Owner -> Name Repo -> Name Commit -> IO (Either Error CombinedStatus) statusFor auth user repo sha = executeRequest auth $ statusForR user repo sha -- | The combined status for a specific commit -- See statusForR :: Name Owner -> Name Repo -> Name Commit -> Request 'RW CombinedStatus statusForR user repo sha = query ["repos", toPathPart user, toPathPart repo, "commits", toPathPart sha, "status"] [] github-0.23/src/GitHub/Endpoints/Repos/Webhooks.hs0000644000000000000000000001144007346545000020232 0ustar0000000000000000 ----------------------------------------------------------------------------- -- | -- License : BSD-3-Clause -- Maintainer : Oleg Grenrus -- -- The webhooks API, as described at -- -- module GitHub.Endpoints.Repos.Webhooks ( -- * Querying repositories webhooksFor', webhooksForR, webhookFor', webhookForR, -- ** Create createRepoWebhook', createRepoWebhookR, -- ** Edit editRepoWebhook', editRepoWebhookR, -- ** Test testPushRepoWebhook', testPushRepoWebhookR, pingRepoWebhook', pingRepoWebhookR, -- ** Delete deleteRepoWebhook', deleteRepoWebhookR, ) where import GitHub.Data import GitHub.Internal.Prelude import GitHub.Request import Prelude () webhooksFor' :: Auth -> Name Owner -> Name Repo -> IO (Either Error (Vector RepoWebhook)) webhooksFor' auth user repo = executeRequest auth $ webhooksForR user repo FetchAll -- | List hooks. -- See webhooksForR :: Name Owner -> Name Repo -> FetchCount -> Request k (Vector RepoWebhook) webhooksForR user repo = pagedQuery ["repos", toPathPart user, toPathPart repo, "hooks"] [] webhookFor' :: Auth -> Name Owner -> Name Repo -> Id RepoWebhook -> IO (Either Error RepoWebhook) webhookFor' auth user repo hookId = executeRequest auth $ webhookForR user repo hookId -- | Query single hook. -- See webhookForR :: Name Owner -> Name Repo -> Id RepoWebhook -> Request k RepoWebhook webhookForR user repo hookId = query ["repos", toPathPart user, toPathPart repo, "hooks", toPathPart hookId] [] createRepoWebhook' :: Auth -> Name Owner -> Name Repo -> NewRepoWebhook -> IO (Either Error RepoWebhook) createRepoWebhook' auth user repo hook = executeRequest auth $ createRepoWebhookR user repo hook -- | Create a hook. -- See createRepoWebhookR :: Name Owner -> Name Repo -> NewRepoWebhook -> Request 'RW RepoWebhook createRepoWebhookR user repo hook = command Post ["repos", toPathPart user, toPathPart repo, "hooks"] (encode hook) editRepoWebhook' :: Auth -> Name Owner -> Name Repo -> Id RepoWebhook -> EditRepoWebhook -> IO (Either Error RepoWebhook) editRepoWebhook' auth user repo hookId hookEdit = executeRequest auth $ editRepoWebhookR user repo hookId hookEdit -- | Edit a hook. -- See editRepoWebhookR :: Name Owner -> Name Repo -> Id RepoWebhook -> EditRepoWebhook -> Request 'RW RepoWebhook editRepoWebhookR user repo hookId hookEdit = command Patch ["repos", toPathPart user, toPathPart repo, "hooks", toPathPart hookId] (encode hookEdit) testPushRepoWebhook' :: Auth -> Name Owner -> Name Repo -> Id RepoWebhook -> IO (Either Error Bool) testPushRepoWebhook' auth user repo hookId = executeRequest auth $ testPushRepoWebhookR user repo hookId -- | Test a push hook. -- See testPushRepoWebhookR :: Name Owner -> Name Repo -> Id RepoWebhook -> GenRequest 'MtStatus 'RW Bool testPushRepoWebhookR user repo hookId = Command Post (createWebhookOpPath user repo hookId $ Just "tests") (encode ()) pingRepoWebhook' :: Auth -> Name Owner -> Name Repo -> Id RepoWebhook -> IO (Either Error Bool) pingRepoWebhook' auth user repo hookId = executeRequest auth $ pingRepoWebhookR user repo hookId -- | Ping a hook. -- See pingRepoWebhookR :: Name Owner -> Name Repo -> Id RepoWebhook -> GenRequest 'MtStatus 'RW Bool pingRepoWebhookR user repo hookId = Command Post (createWebhookOpPath user repo hookId $ Just "pings") (encode ()) deleteRepoWebhook' :: Auth -> Name Owner -> Name Repo -> Id RepoWebhook -> IO (Either Error ()) deleteRepoWebhook' auth user repo hookId = executeRequest auth $ deleteRepoWebhookR user repo hookId -- | Delete a hook. -- See deleteRepoWebhookR :: Name Owner -> Name Repo -> Id RepoWebhook -> GenRequest 'MtUnit 'RW () deleteRepoWebhookR user repo hookId = Command Delete (createWebhookOpPath user repo hookId Nothing) mempty createBaseWebhookPath :: Name Owner -> Name Repo -> Id RepoWebhook -> Paths createBaseWebhookPath user repo hookId = ["repos", toPathPart user, toPathPart repo, "hooks", toPathPart hookId] createWebhookOpPath :: Name Owner -> Name Repo -> Id RepoWebhook -> Maybe Text -> Paths createWebhookOpPath owner reqName webhookId Nothing = createBaseWebhookPath owner reqName webhookId createWebhookOpPath owner reqName webhookId (Just operation) = createBaseWebhookPath owner reqName webhookId ++ [operation] github-0.23/src/GitHub/Endpoints/Search.hs0000644000000000000000000000571407346545000016575 0ustar0000000000000000----------------------------------------------------------------------------- -- | -- License : BSD-3-Clause -- Maintainer : Oleg Grenrus -- -- The Github Search API, as described at -- . module GitHub.Endpoints.Search( searchRepos', searchRepos, searchReposR, searchCode', searchCode, searchCodeR, searchIssues', searchIssues, searchIssuesR, module GitHub.Data, ) where import GitHub.Data import GitHub.Internal.Prelude import GitHub.Request import Prelude () import qualified Data.Text.Encoding as TE -- | Perform a repository search. -- With authentication. -- -- > searchRepos' (Just $ BasicAuth "github-username" "github-password') "a in%3Aname language%3Ahaskell created%3A>2013-10-01&per_page=100" searchRepos' :: Maybe Auth -> Text -> IO (Either Error (SearchResult Repo)) searchRepos' auth = executeRequestMaybe auth . searchReposR -- | Perform a repository search. -- Without authentication. -- -- > searchRepos "q=a in%3Aname language%3Ahaskell created%3A>2013-10-01&per_page=100" searchRepos :: Text -> IO (Either Error (SearchResult Repo)) searchRepos = searchRepos' Nothing -- | Search repositories. -- See searchReposR :: Text -> Request k (SearchResult Repo) searchReposR searchString = query ["search", "repositories"] [("q", Just $ TE.encodeUtf8 searchString)] -- | Perform a code search. -- With authentication. -- -- > searchCode' (Just $ BasicAuth "github-username" "github-password') "a in%3Aname language%3Ahaskell created%3A>2013-10-01&per_page=100" searchCode' :: Maybe Auth -> Text -> IO (Either Error (SearchResult Code)) searchCode' auth = executeRequestMaybe auth . searchCodeR -- | Perform a code search. -- Without authentication. -- -- > searchCode "q=addClass+in:file+language:js+repo:jquery/jquery" searchCode :: Text -> IO (Either Error (SearchResult Code)) searchCode = searchCode' Nothing -- | Search code. -- See searchCodeR :: Text -> Request k (SearchResult Code) searchCodeR searchString = query ["search", "code"] [("q", Just $ TE.encodeUtf8 searchString)] -- | Perform an issue search. -- With authentication. -- -- > searchIssues' (Just $ BasicAuth "github-username" "github-password') "a repo%3Aphadej%2Fgithub&per_page=100" searchIssues' :: Maybe Auth -> Text -> IO (Either Error (SearchResult Issue)) searchIssues' auth = executeRequestMaybe auth . searchIssuesR -- | Perform an issue search. -- Without authentication. -- -- > searchIssues "q=a repo%3Aphadej%2Fgithub&per_page=100" searchIssues :: Text -> IO (Either Error (SearchResult Issue)) searchIssues = searchIssues' Nothing -- | Search issues. -- See searchIssuesR :: Text -> Request k (SearchResult Issue) searchIssuesR searchString = query ["search", "issues"] [("q", Just $ TE.encodeUtf8 searchString)] github-0.23/src/GitHub/Endpoints/Users.hs0000644000000000000000000000347307346545000016471 0ustar0000000000000000----------------------------------------------------------------------------- -- | -- License : BSD-3-Clause -- Maintainer : Oleg Grenrus -- -- The Github Users API, as described at -- . module GitHub.Endpoints.Users ( userInfoFor, userInfoFor', userInfoForR, ownerInfoForR, userInfoCurrent', userInfoCurrentR, module GitHub.Data, ) where import GitHub.Data import GitHub.Internal.Prelude import GitHub.Request import Prelude () -- | The information for a single user, by login name. -- With authentification -- -- > userInfoFor' (Just $ BasicAuth "github-username" "github-password") "mike-burns" userInfoFor' :: Maybe Auth -> Name User -> IO (Either Error User) userInfoFor' auth = executeRequestMaybe auth . userInfoForR -- | The information for a single user, by login name. -- -- > userInfoFor "mike-burns" userInfoFor :: Name User -> IO (Either Error User) userInfoFor = executeRequest' . userInfoForR -- | Query a single user. -- See userInfoForR :: Name User -> Request k User userInfoForR user = query ["users", toPathPart user] [] -- | Query a single user or an organization. -- See ownerInfoForR :: Name Owner -> Request k Owner ownerInfoForR owner = query ["users", toPathPart owner] [] -- | Retrieve information about the user associated with the supplied authentication. -- -- > userInfoCurrent' (OAuth "...") userInfoCurrent' :: Auth -> IO (Either Error User) userInfoCurrent' auth = executeRequest auth $ userInfoCurrentR -- | Query the authenticated user. -- See userInfoCurrentR :: Request 'RA User userInfoCurrentR = query ["user"] [] github-0.23/src/GitHub/Endpoints/Users/0000755000000000000000000000000007346545000016126 5ustar0000000000000000github-0.23/src/GitHub/Endpoints/Users/Emails.hs0000644000000000000000000000302007346545000017667 0ustar0000000000000000----------------------------------------------------------------------------- -- | -- License : BSD-3-Clause -- Maintainer : Oleg Grenrus -- -- The user emails API as described on -- . module GitHub.Endpoints.Users.Emails ( currentUserEmails', currentUserEmailsR, currentUserPublicEmails', currentUserPublicEmailsR, module GitHub.Data, ) where import GitHub.Data import GitHub.Internal.Prelude import GitHub.Request import Prelude () -- | List email addresses for the authenticated user. -- -- > currentUserEmails' (OAuth "token") currentUserEmails' :: Auth -> IO (Either Error (Vector Email)) currentUserEmails' auth = executeRequest auth $ currentUserEmailsR FetchAll -- | List email addresses. -- See currentUserEmailsR :: FetchCount -> Request 'RA (Vector Email) currentUserEmailsR = pagedQuery ["user", "emails"] [] -- | List public email addresses for the authenticated user. -- -- > currentUserPublicEmails' (OAuth "token") currentUserPublicEmails' :: Auth -> IO (Either Error (Vector Email)) currentUserPublicEmails' auth = executeRequest auth $ currentUserPublicEmailsR FetchAll -- | List public email addresses. -- See currentUserPublicEmailsR :: FetchCount -> Request 'RA (Vector Email) currentUserPublicEmailsR = pagedQuery ["user", "public_emails"] [] github-0.23/src/GitHub/Endpoints/Users/Followers.hs0000644000000000000000000000301007346545000020430 0ustar0000000000000000----------------------------------------------------------------------------- -- | -- License : BSD-3-Clause -- Maintainer : Oleg Grenrus -- -- The user followers API as described on -- . module GitHub.Endpoints.Users.Followers ( usersFollowing, usersFollowedBy, usersFollowingR, usersFollowedByR, module GitHub.Data, ) where import GitHub.Data import GitHub.Internal.Prelude import GitHub.Request import Prelude () -- | All the users following the given user. -- -- > usersFollowing "mike-burns" usersFollowing :: Name User -> IO (Either Error (Vector SimpleUser)) usersFollowing user = executeRequest' $ usersFollowingR user FetchAll -- | List followers of a user. -- See usersFollowingR :: Name User -> FetchCount -> Request k (Vector SimpleUser) usersFollowingR user = pagedQuery ["users", toPathPart user, "followers"] [] -- | All the users that the given user follows. -- -- > usersFollowedBy "mike-burns" usersFollowedBy :: Name User -> IO (Either Error (Vector SimpleUser)) usersFollowedBy user = executeRequest' $ usersFollowedByR user FetchAll -- | List users followed by another user. -- See usersFollowedByR :: Name User -> FetchCount -> Request k (Vector SimpleUser) usersFollowedByR user = pagedQuery ["users", toPathPart user, "following"] [] github-0.23/src/GitHub/Endpoints/Users/PublicSSHKeys.hs0000644000000000000000000000554107346545000021117 0ustar0000000000000000----------------------------------------------------------------------------- -- | -- License : BSD-3-Clause -- Maintainer : Todd Mohney -- -- The public keys API, as described at -- module GitHub.Endpoints.Users.PublicSSHKeys ( -- * Querying public SSH keys publicSSHKeys', publicSSHKeysR, publicSSHKeysFor', publicSSHKeysForR, publicSSHKey', publicSSHKeyR, -- ** Create createUserPublicSSHKey', createUserPublicSSHKeyR, -- ** Delete deleteUserPublicSSHKey', deleteUserPublicSSHKeyR, ) where import GitHub.Data import GitHub.Internal.Prelude import GitHub.Request import Prelude () -- | Querying public SSH keys. publicSSHKeysFor' :: Name Owner -> IO (Either Error (Vector PublicSSHKeyBasic)) publicSSHKeysFor' user = executeRequest' $ publicSSHKeysForR user FetchAll -- | Querying public SSH keys. -- See publicSSHKeysForR :: Name Owner -> FetchCount -> Request 'RO (Vector PublicSSHKeyBasic) publicSSHKeysForR user = pagedQuery ["users", toPathPart user, "keys"] [] -- | Querying the authenticated users' public SSH keys publicSSHKeys' :: Auth -> IO (Either Error (Vector PublicSSHKey)) publicSSHKeys' auth = executeRequest auth publicSSHKeysR -- | Querying the authenticated users' public SSH keys -- See publicSSHKeysR :: Request 'RA (Vector PublicSSHKey) publicSSHKeysR = query ["user", "keys"] [] -- | Querying a public SSH key publicSSHKey' :: Auth -> Id PublicSSHKey -> IO (Either Error PublicSSHKey) publicSSHKey' auth keyId = executeRequest auth $ publicSSHKeyR keyId -- | Querying a public SSH key. -- See publicSSHKeyR :: Id PublicSSHKey -> Request 'RA PublicSSHKey publicSSHKeyR keyId = query ["user", "keys", toPathPart keyId] [] -- | Create a public SSH key createUserPublicSSHKey' :: Auth -> NewPublicSSHKey -> IO (Either Error PublicSSHKey) createUserPublicSSHKey' auth key = executeRequest auth $ createUserPublicSSHKeyR key -- | Create a public SSH key. -- See . createUserPublicSSHKeyR :: NewPublicSSHKey -> Request 'RW PublicSSHKey createUserPublicSSHKeyR key = command Post ["user", "keys"] (encode key) deleteUserPublicSSHKey' :: Auth -> Id PublicSSHKey -> IO (Either Error ()) deleteUserPublicSSHKey' auth keyId = executeRequest auth $ deleteUserPublicSSHKeyR keyId -- | Delete a public SSH key. -- See deleteUserPublicSSHKeyR :: Id PublicSSHKey -> GenRequest 'MtUnit 'RW () deleteUserPublicSSHKeyR keyId = Command Delete ["user", "keys", toPathPart keyId] mempty github-0.23/src/GitHub/Internal/0000755000000000000000000000000007346545000014636 5ustar0000000000000000github-0.23/src/GitHub/Internal/Prelude.hs0000644000000000000000000000371707346545000016602 0ustar0000000000000000{-# LANGUAGE NoImplicitPrelude #-} ----------------------------------------------------------------------------- -- | -- License : BSD-3-Clause -- Maintainer : Oleg Grenrus -- -- This module may change between minor releases. Do not rely on its contents. module GitHub.Internal.Prelude ( module Prelude.Compat, -- * Commonly used types UTCTime, HashMap, Text, pack, unpack, Vector, -- * Commonly used typeclasses Binary, Data, Typeable, Generic, Hashable(..), IsString(..), NFData(..), genericRnf, Semigroup(..), -- * Aeson FromJSON(..), ToJSON(..), Value(..), Object, emptyObject, encode, withText, withObject, (.:), (.:?), (.!=), (.=), object, typeMismatch, -- * Control.Applicative (<|>), -- * Data.Maybe catMaybes, -- * Data.List intercalate, toList, -- * Data.Time.ISO8601 formatISO8601, ) where import Control.Applicative ((<|>)) import Control.DeepSeq (NFData (..)) import Control.DeepSeq.Generics (genericRnf) import Data.Aeson (FromJSON (..), Object, ToJSON (..), Value (..), encode, object, withObject, withText, (.!=), (.:), (.:?), (.=)) import Data.Aeson.Types (emptyObject, typeMismatch) import Data.Binary (Binary) import Data.Binary.Instances () import Data.Data (Data, Typeable) import Data.Foldable (toList) import Data.Hashable (Hashable (..)) import Data.HashMap.Strict (HashMap) import Data.List (intercalate) import Data.Maybe (catMaybes) import Data.Semigroup (Semigroup (..)) import Data.String (IsString (..)) import Data.Text (Text, pack, unpack) import Data.Time (UTCTime) import Data.Time.ISO8601 (formatISO8601) import Data.Vector (Vector) import Data.Vector.Instances () import GHC.Generics (Generic) import Prelude.Compat github-0.23/src/GitHub/Request.hs0000644000000000000000000004367007346545000015060 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE KindSignatures #-} {-# LANGUAGE MultiParamTypeClasses #-} ----------------------------------------------------------------------------- -- | -- License : BSD-3-Clause -- Maintainer : Oleg Grenrus -- -- This module provides data types and helper methods, which makes possible -- to build alternative API request intepreters in addition to provided -- 'IO' functions. -- -- Simple example using @operational@ package. See @samples\/Operational\/Operational.hs@ -- -- > type GithubMonad a = Program (GH.Request 'False) a -- > -- > -- | Intepret GithubMonad value into IO -- > runMonad :: Manager -> GH.Auth -> GithubMonad a -> ExceptT GH.Error IO a -- > runMonad mgr auth m = case view m of -- > Return a -> return a -- > req :>>= k -> do -- > b <- ExceptT $ GH.executeRequestWithMgr mgr auth req -- > runMonad mgr auth (k b) -- > -- > -- | Lift request into Monad -- > githubRequest :: GH.Request 'False a -> GithubMonad a -- > githubRequest = singleton module GitHub.Request ( -- * Types Request, GenRequest (..), CommandMethod(..), toMethod, Paths, QueryString, -- * Request execution in IO executeRequest, executeRequestWithMgr, executeRequest', executeRequestWithMgr', executeRequestMaybe, unsafeDropAuthRequirements, -- * Helpers Accept (..), ParseResponse (..), makeHttpRequest, parseStatus, StatusMap, getNextUrl, performPagedRequest, parseResponseJSON, -- ** Preview PreviewAccept (..), PreviewParseResponse (..), ) where import GitHub.Internal.Prelude import Prelude () import Control.Monad.Error.Class (MonadError (..)) import Control.Monad (when) import Control.Monad.Catch (MonadCatch (..), MonadThrow) import Control.Monad.Trans.Class (lift) import Control.Monad.Trans.Except (ExceptT (..), runExceptT) import Data.Aeson (eitherDecode) import Data.List (find, intercalate) import Data.String (fromString) import Data.Tagged (Tagged (..)) import Data.Version (showVersion) import Network.HTTP.Client (HttpException (..), Manager, RequestBody (..), Response (..), getUri, httpLbs, method, newManager, redirectCount, requestBody, requestHeaders, setQueryString, setRequestIgnoreStatus) import Network.HTTP.Link.Parser (parseLinkHeaderBS) import Network.HTTP.Link.Types (Link (..), LinkParam (..), href, linkParams) import Network.HTTP.Types (Method, RequestHeaders, Status (..)) import Network.URI (URI, escapeURIString, isUnescapedInURIComponent, parseURIReference, relativeTo) import qualified Data.ByteString as BS import qualified Data.ByteString.Lazy as LBS import qualified Data.Text as T import qualified Data.Text.Encoding as TE import qualified Data.Vector as V import qualified Network.HTTP.Client as HTTP import qualified Network.HTTP.Client.Internal as HTTP #ifdef MIN_VERSION_http_client_tls import Network.HTTP.Client.TLS (tlsManagerSettings) #else import Network.HTTP.Client.OpenSSL (opensslManagerSettings, withOpenSSL) import qualified OpenSSL.Session as SSL import qualified OpenSSL.X509.SystemStore as SSL #endif import GitHub.Auth (Auth, AuthMethod, endpoint, setAuthRequest) import GitHub.Data (Error (..)) import GitHub.Data.PullRequests (MergeResult (..)) import GitHub.Data.Request import Paths_github (version) #ifdef MIN_VERSION_http_client_tls withOpenSSL :: IO a -> IO a withOpenSSL = id #else tlsManagerSettings :: HTTP.ManagerSettings tlsManagerSettings = opensslManagerSettings $ do ctx <- SSL.context SSL.contextAddOption ctx SSL.SSL_OP_NO_SSLv2 SSL.contextAddOption ctx SSL.SSL_OP_NO_SSLv3 SSL.contextAddOption ctx SSL.SSL_OP_NO_TLSv1 SSL.contextSetCiphers ctx "ECDHE-ECDSA-AES256-GCM-SHA384:ECDHE-RSA-AES256-GCM-SHA384:ECDHE-ECDSA-CHACHA20-POLY1305:ECDHE-RSA-CHACHA20-POLY1305:ECDHE-ECDSA-AES128-GCM-SHA256:ECDHE-RSA-AES128-GCM-SHA256:ECDHE-ECDSA-AES256-SHA384:ECDHE-RSA-AES256-SHA384:ECDHE-ECDSA-AES128-SHA256:ECDHE-RSA-AES128-SHA256" SSL.contextLoadSystemCerts ctx SSL.contextSetVerificationMode ctx $ SSL.VerifyPeer True True Nothing return ctx #endif -- | Execute 'Request' in 'IO' executeRequest :: (AuthMethod am, ParseResponse mt a) => am -> GenRequest mt rw a -> IO (Either Error a) executeRequest auth req = withOpenSSL $ withOpenSSL $ do manager <- newManager tlsManagerSettings executeRequestWithMgr manager auth req lessFetchCount :: Int -> FetchCount -> Bool lessFetchCount _ FetchAll = True lessFetchCount i (FetchAtLeast j) = i < fromIntegral j -- | Like 'executeRequest' but with provided 'Manager'. executeRequestWithMgr :: (AuthMethod am, ParseResponse mt a) => Manager -> am -> GenRequest mt rw a -> IO (Either Error a) executeRequestWithMgr mgr auth req = runExceptT $ do httpReq <- makeHttpRequest (Just auth) req performHttpReq httpReq req where httpLbs' :: HTTP.Request -> ExceptT Error IO (Response LBS.ByteString) httpLbs' req' = lift (httpLbs req' mgr) `catch` onHttpException performHttpReq :: forall rw mt b. ParseResponse mt b => HTTP.Request -> GenRequest mt rw b -> ExceptT Error IO b performHttpReq httpReq Query {} = do res <- httpLbs' httpReq unTagged (parseResponse httpReq res :: Tagged mt (ExceptT Error IO b)) performHttpReq httpReq (PagedQuery _ _ l) = unTagged (performPagedRequest httpLbs' predicate httpReq :: Tagged mt (ExceptT Error IO b)) where predicate v = lessFetchCount (V.length v) l performHttpReq httpReq (Command _ _ _) = do res <- httpLbs' httpReq unTagged (parseResponse httpReq res :: Tagged mt (ExceptT Error IO b)) -- | Like 'executeRequest' but without authentication. executeRequest' :: ParseResponse mt a => GenRequest mt 'RO a -> IO (Either Error a) executeRequest' req = withOpenSSL $ do manager <- newManager tlsManagerSettings executeRequestWithMgr' manager req -- | Like 'executeRequestWithMgr' but without authentication. executeRequestWithMgr' :: ParseResponse mt a => Manager -> GenRequest mt 'RO a -> IO (Either Error a) executeRequestWithMgr' mgr req = runExceptT $ do httpReq <- makeHttpRequest (Nothing :: Maybe Auth) req performHttpReq httpReq req where httpLbs' :: HTTP.Request -> ExceptT Error IO (Response LBS.ByteString) httpLbs' req' = lift (httpLbs req' mgr) `catch` onHttpException performHttpReq :: forall mt b. ParseResponse mt b => HTTP.Request -> GenRequest mt 'RO b -> ExceptT Error IO b performHttpReq httpReq Query {} = do res <- httpLbs' httpReq unTagged (parseResponse httpReq res :: Tagged mt (ExceptT Error IO b)) performHttpReq httpReq (PagedQuery _ _ l) = unTagged (performPagedRequest httpLbs' predicate httpReq :: Tagged mt (ExceptT Error IO b)) where predicate v = lessFetchCount (V.length v) l -- | Helper for picking between 'executeRequest' and 'executeRequest''. -- -- The use is discouraged. executeRequestMaybe :: (AuthMethod am, ParseResponse mt a) => Maybe am -> GenRequest mt 'RO a -> IO (Either Error a) executeRequestMaybe = maybe executeRequest' executeRequest -- | Partial function to drop authentication need. unsafeDropAuthRequirements :: GenRequest mt rw' a -> GenRequest mt rw a unsafeDropAuthRequirements (Query ps qs) = Query ps qs unsafeDropAuthRequirements r = error $ "Trying to drop authenatication from" ++ show r ------------------------------------------------------------------------------- -- Parse response ------------------------------------------------------------------------------- class Accept (mt :: MediaType *) where contentType :: Tagged mt BS.ByteString contentType = Tagged "application/json" -- default is JSON modifyRequest :: Tagged mt (HTTP.Request -> HTTP.Request) modifyRequest = Tagged id class Accept mt => ParseResponse (mt :: MediaType *) a where parseResponse :: MonadError Error m => HTTP.Request -> HTTP.Response LBS.ByteString -> Tagged mt (m a) ------------------------------------------------------------------------------- -- JSON (+ star) ------------------------------------------------------------------------------- -- | Parse API response. -- -- @ -- parseResponse :: 'FromJSON' a => 'Response' 'LBS.ByteString' -> 'Either' 'Error' a -- @ parseResponseJSON :: (FromJSON a, MonadError Error m) => Response LBS.ByteString -> m a parseResponseJSON res = case eitherDecode (responseBody res) of Right x -> return x Left err -> throwError . ParseError . T.pack $ err instance Accept 'MtJSON where contentType = Tagged "application/vnd.github.v3+json" instance FromJSON a => ParseResponse 'MtJSON a where parseResponse _ res = Tagged (parseResponseJSON res) instance Accept 'MtStar where contentType = Tagged "application/vnd.github.v3.star+json" instance FromJSON a => ParseResponse 'MtStar a where parseResponse _ res = Tagged (parseResponseJSON res) ------------------------------------------------------------------------------- -- Raw / Diff / Patch / Sha ------------------------------------------------------------------------------- instance Accept 'MtRaw where contentType = Tagged "application/vnd.github.v3.raw" instance Accept 'MtDiff where contentType = Tagged "application/vnd.github.v3.diff" instance Accept 'MtPatch where contentType = Tagged "application/vnd.github.v3.patch" instance Accept 'MtSha where contentType = Tagged "application/vnd.github.v3.sha" instance a ~ LBS.ByteString => ParseResponse 'MtRaw a where parseResponse _ = Tagged . return . responseBody instance a ~ LBS.ByteString => ParseResponse 'MtDiff a where parseResponse _ = Tagged . return . responseBody instance a ~ LBS.ByteString => ParseResponse 'MtPatch a where parseResponse _ = Tagged . return . responseBody instance a ~ LBS.ByteString => ParseResponse 'MtSha a where parseResponse _ = Tagged . return . responseBody ------------------------------------------------------------------------------- -- Redirect ------------------------------------------------------------------------------- instance Accept 'MtRedirect where modifyRequest = Tagged $ \req -> setRequestIgnoreStatus $ req { redirectCount = 0 } instance b ~ URI => ParseResponse 'MtRedirect b where parseResponse req = Tagged . parseRedirect (getUri req) -- | Helper for handling of 'RequestRedirect'. -- -- @ -- parseRedirect :: 'Response' 'LBS.ByteString' -> 'Either' 'Error' a -- @ parseRedirect :: MonadError Error m => URI -> Response LBS.ByteString -> m URI parseRedirect originalUri rsp = do let status = responseStatus rsp when (statusCode status /= 302) $ throwError $ ParseError $ "invalid status: " <> T.pack (show status) loc <- maybe noLocation return $ lookup "Location" $ responseHeaders rsp case parseURIReference $ T.unpack $ TE.decodeUtf8 loc of Nothing -> throwError $ ParseError $ "location header does not contain a URI: " <> T.pack (show loc) Just uri -> return $ uri `relativeTo` originalUri where noLocation = throwError $ ParseError "no location header in response" ------------------------------------------------------------------------------- -- Extension point ------------------------------------------------------------------------------- class PreviewAccept p where previewContentType :: Tagged ('MtPreview p) BS.ByteString previewModifyRequest :: Tagged ('MtPreview p) (HTTP.Request -> HTTP.Request) previewModifyRequest = Tagged id class PreviewAccept p => PreviewParseResponse p a where previewParseResponse :: MonadError Error m => HTTP.Request -> HTTP.Response LBS.ByteString -> Tagged ('MtPreview p) (m a) instance PreviewAccept p => Accept ('MtPreview p) where contentType = previewContentType modifyRequest = previewModifyRequest instance PreviewParseResponse p a => ParseResponse ('MtPreview p) a where parseResponse = previewParseResponse ------------------------------------------------------------------------------- -- Status ------------------------------------------------------------------------------- instance Accept 'MtStatus where modifyRequest = Tagged setRequestIgnoreStatus instance HasStatusMap a => ParseResponse 'MtStatus a where parseResponse _ = Tagged . parseStatus statusMap . responseStatus type StatusMap a = [(Int, a)] class HasStatusMap a where statusMap :: StatusMap a instance HasStatusMap Bool where statusMap = [ (204, True) , (404, False) ] instance HasStatusMap MergeResult where statusMap = [ (200, MergeSuccessful) , (405, MergeCannotPerform) , (409, MergeConflict) ] -- | Helper for handling of 'RequestStatus'. -- -- @ -- parseStatus :: 'StatusMap' a -> 'Status' -> 'Either' 'Error' a -- @ parseStatus :: MonadError Error m => StatusMap a -> Status -> m a parseStatus m (Status sci _) = maybe err return $ lookup sci m where err = throwError $ JsonError $ "invalid status: " <> T.pack (show sci) ------------------------------------------------------------------------------- -- Unit ------------------------------------------------------------------------------- -- | Note: we don't ignore response status. -- -- We only accept any response body. instance Accept 'MtUnit where instance a ~ () => ParseResponse 'MtUnit a where parseResponse _ _ = Tagged (return ()) ------------------------------------------------------------------------------ -- Tools ------------------------------------------------------------------------------ -- | Create @http-client@ 'Request'. -- -- * for 'PagedQuery', the initial request is created. -- * for 'Status', the 'Request' for underlying 'Request' is created, -- status checking is modifying accordingly. -- makeHttpRequest :: forall am mt rw a m. (AuthMethod am, MonadThrow m, Accept mt) => Maybe am -> GenRequest mt rw a -> m HTTP.Request makeHttpRequest auth r = case r of Query paths qs -> do req <- parseUrl' $ url paths return $ setReqHeaders . unTagged (modifyRequest :: Tagged mt (HTTP.Request -> HTTP.Request)) . maybe id setAuthRequest auth . setQueryString qs $ req PagedQuery paths qs _ -> do req <- parseUrl' $ url paths return $ setReqHeaders . unTagged (modifyRequest :: Tagged mt (HTTP.Request -> HTTP.Request)) . maybe id setAuthRequest auth . setQueryString qs $ req Command m paths body -> do req <- parseUrl' $ url paths return $ setReqHeaders . unTagged (modifyRequest :: Tagged mt (HTTP.Request -> HTTP.Request)) . maybe id setAuthRequest auth . setBody body . setMethod (toMethod m) $ req where parseUrl' :: MonadThrow m => String -> m HTTP.Request parseUrl' = HTTP.parseUrlThrow url :: Paths -> String url paths = maybe "https://api.github.com" T.unpack (endpoint =<< auth) ++ "/" ++ intercalate "/" paths' where paths' = map (escapeURIString isUnescapedInURIComponent . T.unpack) paths setReqHeaders :: HTTP.Request -> HTTP.Request setReqHeaders req = req { requestHeaders = reqHeaders <> requestHeaders req } setMethod :: Method -> HTTP.Request -> HTTP.Request setMethod m req = req { method = m } reqHeaders :: RequestHeaders reqHeaders = [("User-Agent", "github.hs/" <> fromString (showVersion version))] -- Version <> [("Accept", unTagged (contentType :: Tagged mt BS.ByteString))] setBody :: LBS.ByteString -> HTTP.Request -> HTTP.Request setBody body req = req { requestBody = RequestBodyLBS body } -- | Query @Link@ header with @rel=next@ from the request headers. getNextUrl :: Response a -> Maybe URI getNextUrl req = do linkHeader <- lookup "Link" (responseHeaders req) links <- parseLinkHeaderBS linkHeader nextURI <- find isRelNext links return $ href nextURI where isRelNext :: Link -> Bool isRelNext = any (== relNextLinkParam) . linkParams relNextLinkParam :: (LinkParam, Text) relNextLinkParam = (Rel, "next") -- | Helper for making paginated requests. Responses, @a@ are combined monoidally. -- -- @ -- performPagedRequest :: ('FromJSON' a, 'Semigroup' a) -- => ('HTTP.Request' -> 'ExceptT' 'Error' 'IO' ('Response' 'LBS.ByteString')) -- -> (a -> 'Bool') -- -> 'HTTP.Request' -- -> 'ExceptT' 'Error' 'IO' a -- @ performPagedRequest :: forall a m mt. (ParseResponse mt a, Semigroup a, MonadCatch m, MonadError Error m) => (HTTP.Request -> m (Response LBS.ByteString)) -- ^ `httpLbs` analogue -> (a -> Bool) -- ^ predicate to continue iteration -> HTTP.Request -- ^ initial request -> Tagged mt (m a) performPagedRequest httpLbs' predicate initReq = Tagged $ do res <- httpLbs' initReq m <- unTagged (parseResponse initReq res :: Tagged mt (m a)) go m res initReq where go :: a -> Response LBS.ByteString -> HTTP.Request -> m a go acc res req = case (predicate acc, getNextUrl res) of (True, Just uri) -> do req' <- HTTP.setUri req uri res' <- httpLbs' req' m <- unTagged (parseResponse req' res' :: Tagged mt (m a)) go (acc <> m) res' req' (_, _) -> return acc ------------------------------------------------------------------------------- -- Internal ------------------------------------------------------------------------------- onHttpException :: MonadError Error m => HttpException -> m a onHttpException = throwError . HTTPError