diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,42 +1,287 @@ +## Changes for 0.30.0.2 + +_2026-03-12, Andreas Abel_ + +- Fixed issue [#531](https://github.com/haskell-github/github/issues/531) + (Norfairking, PR [#532](https://github.com/haskell-github/github/pull/532)). +- Allow `http-client-tls-0.4`. + +Tested with GHC 8.2 - 9.14.1. + +## Changes for 0.30.0.1 + +_2025-08-27, Andreas Abel_ + +- Drop dependencies `deepseq-generics` and `transformers-compat`. +- Remove obsolete `deriving Typeable`. + +Tested with GHC 8.2 - 9.14 alpha1. + +## Changes for 0.30 + +_2025-05-09, Andreas Abel, Peace edition_ + +- Organization membership endpoint (Domen Kožar, PR [#487](https://github.com/haskell-github/github/pull/487)). +- Allow JWT as an authentication method (Tom Sydney Kerckhove, PR [#497](https://github.com/haskell-github/github/pull/497)). +- Support pagination (Tom McLaughlin, PR [#503](https://github.com/haskell-github/github/pull/503)). +- Initial subset of Reactions endpoints (Dan Rijks, PR [#509](https://github.com/haskell-github/github/pull/509)). +- Fix `getNotifications` (maralorn, PR [#511](https://github.com/haskell-github/github/pull/511)). +- Add missing `name` field to `WorkflowJobs` `Job` type (Hugh Davidson, PR [#518](https://github.com/haskell-github/github/pull/518)). +- Add `StateReasonDuplicate` to `IssueStateReason` (PR [#523](https://github.com/haskell-github/github/pull/523)). +- Drop support for GHC 8.0 and below. +- Drop dependency `time-compat`. + +Tested with GHC 8.2 - 9.12.2. + + +## Changes for 0.29 + +_2023-06-24, Andreas Abel, Midsommar edition_ + +- Support for the GitHub Actions API + (PR [#459](https://github.com/haskell-github/github/pull/459)): + * New endpoint modules `GitHub.EndPoints.Actions.Artifacts`, `.Cache`, + `.Secrets`, `.Workflows`, `.WorkflowRuns`, `.WorkflowJobs`. + * Matching data structure modules `GitHub.Data.Actions.*`. + +- Add field `issueStateReason` of type `Maybe IssueStateReason` to `Issue` + with possible values `completed`, `not_planned` and `reopened` + (PR [#496](https://github.com/haskell-github/github/pull/496)). + +Tested with GHC 7.8 - 9.6.2 + +## Changes for 0.28.0.1 + +_2022-07-23, Andreas Abel_ + +Tested with GHC 7.8 - 9.4.1 alpha3 + +- Drop unused dependency `vector-instances`. +- Allow latest: `aeson-2.1`, `mtl-2.3`, `vector-0.13`, `transformers-0.6`. + +## Changes for 0.28 + +_2022-04-30, Andreas Abel, Valborg edition_ + +Tested with GHC 7.8 - 9.2.2 + +- Add constructors to `IssueRepoMod` that allow filtering issues by + milestone, assignee, creator, mentioned user: + `GitHub.Data.Options.options{Milestone,Assignee,Creator,Mentioned}` + (PR [#470](https://github.com/haskell-github/github/pull/470)) + +- Add permissions field to `Repo`. + This adds record `RepoPermissions` and field `Repo.repoPermissions` + in module `GitHub.Data.Repos`. + (PR [#476](https://github.com/haskell-github/github/pull/476)) + +- Add unwatch request `GitHub.Endpoints.Activity.Watching.unwatchRepoR` + (PR [#473](https://github.com/haskell-github/github/pull/473)) + +Breaking change: + +- Make searches paginated + (PR [#474](https://github.com/haskell-github/github/pull/474)): + * Adds record `GitHub.Data.Repos.CodeSearchRepo`. + * Adds argument `FetchCount` + to `GitHub.Endpoints.Search.search{Repos,Code,Issues,Users}R`. + +## Changes for 0.27 + +_2021-10-10, Oleg Grenrus_ + +- Add vector of `SimpleTeam` in "requested_teams" field of `PullRequest` + [#453](https://github.com/haskell-github/github/pull/453) +- Add endpoint to create gist + [#455](https://github.com/haskell-github/github/pull/455) +- Update `RepoWebhookEvent` + [#461](https://github.com/haskell-github/github/pull/461) +- `PullRequest` Reviews may not have submitted_at field + [#450](https://github.com/haskell-github/github/pull/450) + +## Changes for 0.26 + +_2020-05-26, Oleg Grenrus_ + +- Generalize `PagedQuery` to allow its reuse by preview github APIs + [#439](https://github.com/haskell-github/github/pull/439) +- Add endpoint for listing organizations outside collaborators + [#445](https://github.com/haskell-github/github/pull/445) +- Add endpoint for users search + [#444](https://github.com/haskell-github/github/pull/444) +- Make `repoWebhookResponseStatus` optional + [#436](https://github.com/haskell-github/github/pull/436) +- Teams improvements + [#417](https://github.com/haskell-github/github/pull/417) +- Add `deleteReference` endpoint + [#388](https://github.com/haskell-github/github/pull/388) + +## Changes for 0.25 + +_2020-02-18, Oleg Grenrus_ + +- Add `executeRequestWithMgrAndRes` + [#421](https://github.com/haskell-github/github/pull/421) +- Add `limitsFromHttpResponse` + [#421](https://github.com/haskell-github/github/pull/421) +- Add label descriptions + [#418](https://github.com/haskell-github/github/pull/418) +- Add "draft" option to mergeable state + [#431](https://github.com/haskell-github/github/pull/431) +- Use `IssueNumber` in `editIssueR` and `issueR` + [#429](https://github.com/haskell-github/github/pull/429) +- Manage orgs in GitHub Enterprise + [#420](https://github.com/haskell-github/github/pull/420) +- Add support for collaborator permission endpoint + [#425](https://github.com/haskell-github/github/pull/425) +- Add support for the comment reply endpoint + [#424](https://github.com/haskell-github/github/pull/424) +- Organise exports in `GitHub` + [#430](https://github.com/haskell-github/github/pull/430) + +## Changes for 0.24 + +_2019-11-27, Oleg Grenrus_ + +**Major change**: +Introduce `github` n-ary combinator to hoist `... -> Request rw res` +into `... -> IO (Either Error res)` (i.e. n-ary `executeRequest`). +With that in place drop `.. -> IO (Either Error res)` functions. + +This reduces symbol bloat in the library. +[#415](https://github.com/haskell-github/github/pull/415) + +- Remove double `withOpenSSL` + [#414](https://github.com/haskell-github/github/pull/414) +- Pull requests reviews API uses issue number + [#409](https://github.com/haskell-github/github/pull/409) +- Update `Repo`, `NewRepo` and `EditRepo` data types + [#407](https://github.com/haskell-github/github/pull/407) + +## Changes for 0.23 + +_2019-10-01, Oleg Grenrus_ + +- Escape URI paths + [#404](https://github.com/haskell-github/github/pull/404) +- Add `OwnerBot` to `OwnerType` + [#399](https://github.com/haskell-github/github/pull/399) +- Make `File.fileSha` optional + [#392](https://github.com/haskell-github/github/pull/392) +- Update User-Agent to contain up to date version + [#403](https://github.com/haskell-github/github/pull/403) + [#394](https://github.com/haskell-github/github/pull/394) + +## Changes for 0.22 + +_2019-05-31, Oleg Grenrus_ + +- Type-class for various auth methods + [#365](https://github.com/haskell-github/github/pull/365) +- Throw on non-200 responses + [#350](https://github.com/haskell-github/github/pull/350) +- Add extension point for (preview) media types + [#370](https://github.com/haskell-github/github/pull/370) +- Add missing webhook event types + [#359](https://github.com/haskell-github/github/pull/359) +- Add invitation endpoint + [#360](https://github.com/haskell-github/github/pull/360) +- Add notifications endpoints + [#324](https://github.com/haskell-github/github/pull/324) +- Add ssh keys endpoints + [#363](https://github.com/haskell-github/github/pull/365) +- Case insensitive enum parsing + [#373](https://github.com/haskell-github/github/pull/373) +- Don't try parse unitary responses + [#377](https://github.com/haskell-github/github/issues/377) +- Update dependencies + [#364](https://github.com/haskell-github/github/pull/364) + [#368](https://github.com/haskell-github/github/pull/368) + [#369](https://github.com/haskell-github/github/pull/369) +- Documentation improvements + [#357](https://github.com/haskell-github/github/pull/357) + +## Changes for 0.21 + +_2019-02-18, Oleg Grenrus_ + +- Refactor `Request` type. + [#349](https://github.com/haskell-github/github/pull/349) +- Allow `http-client-0.6` + [#344](https://github.com/haskell-github/github/pull/344) +- Change to use `cryptohash-sha1` (`cryptohash` was used before) +- Add Create milestone endpoints + [#337](https://github.com/haskell-github/github/pull/337) +- Make `fileBlobUrl` and `fileRawUrl` optional + [#339](https://github.com/haskell-github/github/issues/339) + [#340](https://github.com/haskell-github/github/pull/340) +- Add `organizationsR` to request user organizations + [#345](https://github.com/haskell-github/github/pull/345) +- Add `updateMilestoneR`, `deleteMilestoneR` + [#338](https://github.com/haskell-github/github/pull/338) +- Allow multiple assignees in `NewIssue` and `EditIssue` + [#336](https://github.com/haskell-github/github/pull/336) +- Add `pullRequestPatchR` and `pullRequestDiffR` + [#325](https://github.com/haskell-github/github/pull/325) + +## Changes for 0.20 + +_2018-09-26, Oleg Grenrus_ + +- Add ratelimit endpoint + [#315](https://github.com/haskell-github/github/pull/315) +- Add some deployment endoints + [#330](https://github.com/haskell-github/github/pull/330) +- Add webhook installation events + [#329](https://github.com/haskell-github/github/pull/330) +- Tighten lower bounds (also remove `aeson-compat` dep) + [#332](https://github.com/haskell-github/github/pull/332) + ## Changes for 0.19 +_2018-02-19, Oleg Grenrus_ + - 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) + [#301](https://github.com/haskell-github/github/issues/301) +- Include label info in `IssueEvent` + [#302](https://github.com/haskell-github/github/issues/302) - Fix `ShowRepo` example - [#306](https://github.com/phadej/github/pull/306) + [#306](https://github.com/haskell-github/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) + [#307](https://github.com/haskell-github/github/pull/307) +- Make "repo" in `PullRequestCommit` nullable (repository can be gone) + [#311](https://github.com/haskell-github/github/pull/311) +- Add read-only emails endpoint + [#313](https://github.com/haskell-github/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) + [#312](https://github.com/haskell-github/github/pull/312) +- Fix `isPullRequestMerged` and other boolean responses + [#312](https://github.com/haskell-github/github/pull/312) - Add `behind` pull request mergeable state - [#308](https://github.com/phadej/github/pull/308) + [#308](https://github.com/haskell-github/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) +_2017-11-10, Oleg Grenrus_ + +- Endpoints for deleting issue comments. + [#294](https://github.com/haskell-github/github/pull/294) - Endpoints for (un)starring gists. - [#296](https://github.com/phadej/github/pull/296) + [#296](https://github.com/haskell-github/github/pull/296) - Add `archived` field to `Repo`. - [#298](https://github.com/phadej/github/pull/298) + [#298](https://github.com/haskell-github/github/pull/298) - Update dependencies. - [#295](https://github.com/phadej/github/pull/295) + [#295](https://github.com/haskell-github/github/pull/295) - Add Statuses endpoints. - [#268](https://github.com/phadej/github/pull/268) + [#268](https://github.com/haskell-github/github/pull/268) - Add requested reviewers field to pull request records. - [#292](https://github.com/phadej/github/pull/292) + [#292](https://github.com/haskell-github/github/pull/292) ## Changes for 0.17.0 +_2017-09-26, Oleg Grenrus_ + - Add `Ord Request` instance - Repository contents - Repository starring endpoints @@ -44,15 +289,19 @@ ## Changes for 0.16.0 +_2017-07-24, Oleg Grenrus_ + - Add support for `mergeable_state = "blocked".` - Fix HTTP status code of merge PR - Supports newest versions of dependencies - user events - release endpoints -- forkExistingRepo +- `forkExistingRepo` ## Changes for 0.15.0 +_2016-11-04, Oleg Grenrus_ + - Reworked `PullRequest` (notably `pullRequestsFor`) - Reworked PR and Issue filtering - GHC-8.0.1 support @@ -62,19 +311,21 @@ - Add `HeaderQuery` to `Request` - Add `Hashable Auth` instance - Add `mkUserId`, `mkUserName`, `fromUserId`, `fromOrganizationId` -- Add 'userIssuesR' -- Add 'organizationIssuesR' +- Add `userIssuesR` +- Add `organizationIssuesR` - Make `teamName :: Text` amnd `teamSlug :: Name Team` in both: `Team` and `SimpleTeam` -- Refactor 'Request' structure +- 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. +- Remove `simpleUserType`, it was always the same. -See [git commit summary](https://github.com/phadej/github/compare/v0.14.1...v0.15.0) +See [git commit summary](https://github.com/haskell-github/github/compare/v0.14.1...v0.15.0) ## Changes for 0.14.1 +_2016-02-02, Oleg Grenrus_ + - Add `membersOfWithR`, `listTeamMembersR` - Add related enums: `OrgMemberFilter`, `OrgMemberRole`, `TeamMemberRole` - Add `Enum` and `Bounded` instances to `Privacy`, `Permission`, @@ -83,6 +334,8 @@ ## Changes for 0.14.0 +_2016-01-25, Oleg Grenrus_ + Large API changes: - Use `Text` and `Vector` in place of `String` and `[]`. @@ -92,28 +345,56 @@ - Add `Binary` instances for all data - `GithubOwner` is a `newtype` of `Either User Organization`. There's still `SimpleOwner`. +## Releases without changelog + +| Version | Date | Uploader | +|---|---|---| +| __0.13.2__ | _2015-04-26_ | _John Wiegley_ | +| __0.13.1__ | _2014-12-01_ | _César López-Natarén_ | +| __0.13__ | _2014-11-09_ | _César López-Natarén_ | +| __0.12__ | _2014-11-09_ | _César López-Natarén_ | +| __0.11.1__ | _2014-09-07_ | _César López-Natarén_ | +| __0.11.0__ | _2014-08-25_ | _César López-Natarén_ | +| __0.10.0__ | _2014-08-18_ | _César López-Natarén_ | +| __0.9__ | _2014-07-31_ | _John Wiegley_ | +| __0.8__ | _2014-05-02_ | _John Wiegley_ | +| __0.7.4__ | _2014-01-22_ | _John Wiegley_ | +| __0.7.3__ | _2013-12-21_ | _John Wiegley_ | +| __0.7.2__ | _2013-12-02_ | _John Wiegley_ | +| __0.7.1__ | _2013-08-08_ | _John Wiegley_ | +| __0.7.0__ | _2013-04-26_ | _John Wiegley_ | +| __0.6.0__ | _2013-04-12_ | _John Wiegley_ | + ## Changes for 0.5.0: -* OAuth. +_2013-02-05, Mike Burns_ + +* `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. +* 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. +_2013-01-14, Mike Burns_ +* 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. +_2012-06-26, Mike Burns_ +* Use `http-conduit` version 1.4.1.10. + ## Changes for 0.3.0: +_2012-06-10, Mike Burns_ + * Re-instantiate the Blobs API. * `repoDescription1` and `repoPushedAt` are a `Maybe GithubDate`. * Add `deleteRepo`, `editRepo`, and `createRepo`. @@ -124,13 +405,17 @@ ## Changes for 0.2.1: -* Expand the unordered-containers dependency to anything in 0.1.x . +_2012-02-16, Mike Burns_ +* Expand the `unordered-containers` dependency to anything in 0.1.x . + ## Changes for 0.2.0: +_2012-02-15, Mike Burns_ + * `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 +* 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. diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -1,15 +1,15 @@ -Github +GitHub ------ -[![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) +[![Hackage version](https://img.shields.io/hackage/v/github.svg?label=Hackage&color=informational)](http://hackage.haskell.org/package/github) +[![github on Stackage Nightly](https://stackage.org/package/github/badge/nightly)](https://stackage.org/nightly/package/github) +[![Stackage LTS version](https://www.stackage.org/package/github/badge/lts?label=Stackage)](https://www.stackage.org/package/github) +[![Haskell-CI](https://github.com/haskell-github/github/actions/workflows/haskell-ci.yml/badge.svg)](https://github.com/haskell-github/github/actions/workflows/haskell-ci.yml) -The Github API v3 for Haskell. +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 +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 @@ -18,31 +18,32 @@ 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 +cabal v1-install github ``` Example Usage ============= See the samples in the -[samples/](https://github.com/fpco/github/tree/master/samples) directory. +[samples/](https://github.com/haskell-github/github/tree/master/samples) directory. +Note: some samples might be outdated. + 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/). +[documentation from the GitHub API](https://docs.github.com/en/rest). -Request functions (ending with `R`) construct a data type with can be executed +Request functions (ending with `R`) construct a data type which can be executed in `IO` by `executeRequest` functions. They are all listed in the root `GitHub` module. @@ -51,7 +52,7 @@ 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. +[`samples/`](https://github.com/haskell-github/github/tree/master/samples) directory. ```hs {-# LANGUAGE NoImplicitPrelude #-} @@ -63,11 +64,12 @@ import Data.Text.IO as T (putStrLn) import Data.Monoid ((<>)) -import qualified GitHub.Endpoints.Users.Followers as GitHub +import GitHub (github') +import qualified GitHub main :: IO () main = do - possibleUsers <- GitHub.usersFollowing "mike-burns" + possibleUsers <- github' GitHub.usersFollowingR "phadej" T.putStrLn $ either (("Error: " <>) . pack . show) (foldMap ((<> "\n") . formatUser)) possibleUsers @@ -76,21 +78,11 @@ 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) +[CONTRIBUTING.md](https://github.com/haskell-github/github/blob/master/CONTRIBUTING.md) for details on how you can help. Copyright @@ -98,8 +90,16 @@ Copyright 2011-2012 Mike Burns. Copyright 2013-2015 John Wiegley. -Copyright 2016 Oleg Grenrus. +Copyright 2016-2019 Oleg Grenrus. Available under the BSD 3-clause license. -[hackage]: http://hackage.haskell.org/package/github "Hackage" +[hackage]: https://hackage.haskell.org/package/github "Hackage" + +Alternative +=========== + +Library [`github-rest`](https://hackage.haskell.org/package/github-rest) +also provides an interface to the GitHub API. +It compares itself to `github` here: +https://github.com/LeapYear/github-rest#comparison-to-other-libraries diff --git a/fixtures/actions/artifact.json b/fixtures/actions/artifact.json new file mode 100644 --- /dev/null +++ b/fixtures/actions/artifact.json @@ -0,0 +1,19 @@ +{ + "id": 416767789, + "node_id": "MDg6QXJ0aWZhY3Q0MTY3Njc3ODk=", + "name": "dist-without-markdown", + "size_in_bytes": 42718, + "url": "https://api.github.com/repos/kote-test-org-actions/actions-api/actions/artifacts/416767789", + "archive_download_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/actions/artifacts/416767789/zip", + "expired": false, + "created_at": "2022-10-29T22:18:21Z", + "updated_at": "2022-10-29T22:18:23Z", + "expires_at": "2023-01-27T22:18:16Z", + "workflow_run": { + "id": 3353148947, + "repository_id": 559365297, + "head_repository_id": 559365297, + "head_branch": "main", + "head_sha": "601593ecb1d8a57a04700fdb445a28d4186b8954" + } +} diff --git a/fixtures/actions/artifacts-list.json b/fixtures/actions/artifacts-list.json new file mode 100644 --- /dev/null +++ b/fixtures/actions/artifacts-list.json @@ -0,0 +1,43 @@ +{ + "total_count": 23809, + "artifacts": [ + { + "id": 416737084, + "node_id": "MDg6QXJ0aWZhY3Q0MTY3MzcwODQ=", + "name": "doc-html", + "size_in_bytes": 61667543, + "url": "https://api.github.com/repos/python/cpython/actions/artifacts/416737084", + "archive_download_url": "https://api.github.com/repos/python/cpython/actions/artifacts/416737084/zip", + "expired": false, + "created_at": "2022-10-29T20:56:24Z", + "updated_at": "2022-10-29T20:56:25Z", + "expires_at": "2023-01-27T20:50:21Z", + "workflow_run": { + "id": 3352897496, + "repository_id": 81598961, + "head_repository_id": 101955313, + "head_branch": "backport-bfecff5-3.11", + "head_sha": "692cd77975413d71ff0951072df686e6f38711c8" + } + }, + { + "id": 416712612, + "node_id": "MDg6QXJ0aWZhY3Q0MTY3MTI2MTI=", + "name": "doc-html", + "size_in_bytes": 61217330, + "url": "https://api.github.com/repos/python/cpython/actions/artifacts/416712612", + "archive_download_url": "https://api.github.com/repos/python/cpython/actions/artifacts/416712612/zip", + "expired": false, + "created_at": "2022-10-29T19:53:19Z", + "updated_at": "2022-10-29T19:53:20Z", + "expires_at": "2023-01-27T19:49:12Z", + "workflow_run": { + "id": 3352724493, + "repository_id": 81598961, + "head_repository_id": 559335486, + "head_branch": "patch-1", + "head_sha": "62eb88a66d1d35f7701873d8b698a2f8d7e84fa5" + } + } + ] +} diff --git a/fixtures/actions/cache-list.json b/fixtures/actions/cache-list.json new file mode 100644 --- /dev/null +++ b/fixtures/actions/cache-list.json @@ -0,0 +1,14 @@ +{ + "total_count": 1, + "actions_caches": [ + { + "id": 1, + "ref": "refs/heads/main", + "key": "cache_key", + "version": "f5f850afdadd47730296d4ffa900de95f6bbafb75dc1e8475df1fa6ae79dcece", + "last_accessed_at": "2022-10-30T00:08:14.223333300Z", + "created_at": "2022-10-30T00:08:14.223333300Z", + "size_in_bytes": 26586 + } + ] +} diff --git a/fixtures/actions/org-cache-usage.json b/fixtures/actions/org-cache-usage.json new file mode 100644 --- /dev/null +++ b/fixtures/actions/org-cache-usage.json @@ -0,0 +1,4 @@ +{ + "total_active_caches_size_in_bytes": 26586, + "total_active_caches_count": 1 +} diff --git a/fixtures/actions/org-public-key.json b/fixtures/actions/org-public-key.json new file mode 100644 --- /dev/null +++ b/fixtures/actions/org-public-key.json @@ -0,0 +1,4 @@ +{ + "key_id": "568250167242549743", + "key": "KHVvOxB765kjkShEgUu27QCzl5XxKz/L20V+KRsWf0w=" +} diff --git a/fixtures/actions/org-secrets-list.json b/fixtures/actions/org-secrets-list.json new file mode 100644 --- /dev/null +++ b/fixtures/actions/org-secrets-list.json @@ -0,0 +1,18 @@ +{ + "total_count": 2, + "secrets": [ + { + "name": "TEST_SECRET", + "created_at": "2022-10-31T00:08:12Z", + "updated_at": "2022-10-31T00:08:12Z", + "visibility": "all" + }, + { + "name": "TEST_SELECTED", + "created_at": "2022-10-31T00:08:43Z", + "updated_at": "2022-10-31T00:08:43Z", + "visibility": "selected", + "selected_repositories_url": "https://api.github.com/orgs/kote-test-org-actions/actions/secrets/TEST_SELECTED/repositories" + } + ] +} diff --git a/fixtures/actions/repo-cache-usage.json b/fixtures/actions/repo-cache-usage.json new file mode 100644 --- /dev/null +++ b/fixtures/actions/repo-cache-usage.json @@ -0,0 +1,5 @@ +{ + "full_name": "python/cpython", + "active_caches_size_in_bytes": 55000268087, + "active_caches_count": 171 +} diff --git a/fixtures/actions/selected-repositories-for-secret.json b/fixtures/actions/selected-repositories-for-secret.json new file mode 100644 --- /dev/null +++ b/fixtures/actions/selected-repositories-for-secret.json @@ -0,0 +1,72 @@ +{ + "total_count": 1, + "repositories": [ + { + "id": 559365297, + "node_id": "R_kgDOIVc8sQ", + "name": "actions-api", + "full_name": "kote-test-org-actions/actions-api", + "private": true, + "owner": { + "login": "kote-test-org-actions", + "id": 116976977, + "node_id": "O_kgDOBvjtUQ", + "avatar_url": "https://avatars.githubusercontent.com/u/116976977?v=4", + "gravatar_id": "", + "url": "https://api.github.com/users/kote-test-org-actions", + "html_url": "https://github.com/kote-test-org-actions", + "followers_url": "https://api.github.com/users/kote-test-org-actions/followers", + "following_url": "https://api.github.com/users/kote-test-org-actions/following{/other_user}", + "gists_url": "https://api.github.com/users/kote-test-org-actions/gists{/gist_id}", + "starred_url": "https://api.github.com/users/kote-test-org-actions/starred{/owner}{/repo}", + "subscriptions_url": "https://api.github.com/users/kote-test-org-actions/subscriptions", + "organizations_url": "https://api.github.com/users/kote-test-org-actions/orgs", + "repos_url": "https://api.github.com/users/kote-test-org-actions/repos", + "events_url": "https://api.github.com/users/kote-test-org-actions/events{/privacy}", + "received_events_url": "https://api.github.com/users/kote-test-org-actions/received_events", + "type": "Organization", + "site_admin": false + }, + "html_url": "https://github.com/kote-test-org-actions/actions-api", + "description": null, + "fork": false, + "url": "https://api.github.com/repos/kote-test-org-actions/actions-api", + "forks_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/forks", + "keys_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/keys{/key_id}", + "collaborators_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/collaborators{/collaborator}", + "teams_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/teams", + "hooks_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/hooks", + "issue_events_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/issues/events{/number}", + "events_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/events", + "assignees_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/assignees{/user}", + "branches_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/branches{/branch}", + "tags_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/tags", + "blobs_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/git/blobs{/sha}", + "git_tags_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/git/tags{/sha}", + "git_refs_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/git/refs{/sha}", + "trees_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/git/trees{/sha}", + "statuses_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/statuses/{sha}", + "languages_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/languages", + "stargazers_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/stargazers", + "contributors_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/contributors", + "subscribers_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/subscribers", + "subscription_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/subscription", + "commits_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/commits{/sha}", + "git_commits_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/git/commits{/sha}", + "comments_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/comments{/number}", + "issue_comment_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/issues/comments{/number}", + "contents_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/contents/{+path}", + "compare_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/compare/{base}...{head}", + "merges_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/merges", + "archive_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/{archive_format}{/ref}", + "downloads_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/downloads", + "issues_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/issues{/number}", + "pulls_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/pulls{/number}", + "milestones_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/milestones{/number}", + "notifications_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/notifications{?since,all,participating}", + "labels_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/labels{/name}", + "releases_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/releases{/id}", + "deployments_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/deployments" + } + ] +} diff --git a/fixtures/actions/workflow-job.json b/fixtures/actions/workflow-job.json new file mode 100644 --- /dev/null +++ b/fixtures/actions/workflow-job.json @@ -0,0 +1,113 @@ +{ + "id": 9183275828, + "run_id": 3353449941, + "run_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/actions/runs/3353449941", + "run_attempt": 1, + "node_id": "CR_kwDOIVc8sc8AAAACI12rNA", + "head_sha": "3156f684232a3adec5085c920d2006aca80f2798", + "url": "https://api.github.com/repos/kote-test-org-actions/actions-api/actions/jobs/9183275828", + "html_url": "https://github.com/kote-test-org-actions/actions-api/actions/runs/3353449941/jobs/5556228789", + "status": "completed", + "conclusion": "success", + "started_at": "2022-10-30T00:09:29Z", + "completed_at": "2022-10-30T00:09:49Z", + "name": "check-bats-version", + "steps": [ + { + "name": "Set up job", + "status": "completed", + "conclusion": "success", + "number": 1, + "started_at": "2022-10-29T17:09:29.000-07:00", + "completed_at": "2022-10-29T17:09:32.000-07:00" + }, + { + "name": "Run actions/checkout@v3", + "status": "completed", + "conclusion": "success", + "number": 2, + "started_at": "2022-10-29T17:09:32.000-07:00", + "completed_at": "2022-10-29T17:09:33.000-07:00" + }, + { + "name": "Run actions/setup-node@v3", + "status": "completed", + "conclusion": "success", + "number": 3, + "started_at": "2022-10-29T17:09:34.000-07:00", + "completed_at": "2022-10-29T17:09:39.000-07:00" + }, + { + "name": "Run npm install -g bats", + "status": "completed", + "conclusion": "success", + "number": 4, + "started_at": "2022-10-29T17:09:40.000-07:00", + "completed_at": "2022-10-29T17:09:42.000-07:00" + }, + { + "name": "Run bats -v", + "status": "completed", + "conclusion": "success", + "number": 5, + "started_at": "2022-10-29T17:09:42.000-07:00", + "completed_at": "2022-10-29T17:09:42.000-07:00" + }, + { + "name": "Archive Test", + "status": "completed", + "conclusion": "success", + "number": 6, + "started_at": "2022-10-29T17:09:42.000-07:00", + "completed_at": "2022-10-29T17:09:46.000-07:00" + }, + { + "name": "Cache", + "status": "completed", + "conclusion": "success", + "number": 7, + "started_at": "2022-10-29T17:09:46.000-07:00", + "completed_at": "2022-10-29T17:09:47.000-07:00" + }, + { + "name": "Post Cache", + "status": "completed", + "conclusion": "success", + "number": 12, + "started_at": "2022-10-29T17:09:49.000-07:00", + "completed_at": "2022-10-29T17:09:47.000-07:00" + }, + { + "name": "Post Run actions/setup-node@v3", + "status": "completed", + "conclusion": "success", + "number": 13, + "started_at": "2022-10-29T17:09:49.000-07:00", + "completed_at": "2022-10-29T17:09:49.000-07:00" + }, + { + "name": "Post Run actions/checkout@v3", + "status": "completed", + "conclusion": "success", + "number": 14, + "started_at": "2022-10-29T17:09:49.000-07:00", + "completed_at": "2022-10-29T17:09:49.000-07:00" + }, + { + "name": "Complete job", + "status": "completed", + "conclusion": "success", + "number": 15, + "started_at": "2022-10-29T17:09:47.000-07:00", + "completed_at": "2022-10-29T17:09:47.000-07:00" + } + ], + "check_run_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/check-runs/9183275828", + "labels": [ + "ubuntu-latest" + ], + "runner_id": 1, + "runner_name": "Hosted Agent", + "runner_group_id": 2, + "runner_group_name": "GitHub Actions" +} diff --git a/fixtures/actions/workflow-list.json b/fixtures/actions/workflow-list.json new file mode 100644 --- /dev/null +++ b/fixtures/actions/workflow-list.json @@ -0,0 +1,17 @@ +{ + "total_count": 1, + "workflows": [ + { + "id": 39065091, + "node_id": "W_kwDOIVc8sc4CVBYD", + "name": "learn-github-actions", + "path": ".github/workflows/make_artifact.yaml", + "state": "active", + "created_at": "2022-10-29T15:17:59.000-07:00", + "updated_at": "2022-10-29T15:17:59.000-07:00", + "url": "https://api.github.com/repos/kote-test-org-actions/actions-api/actions/workflows/39065091", + "html_url": "https://github.com/kote-test-org-actions/actions-api/blob/main/.github/workflows/make_artifact.yaml", + "badge_url": "https://github.com/kote-test-org-actions/actions-api/workflows/learn-github-actions/badge.svg" + } + ] +} diff --git a/fixtures/actions/workflow-runs-list.json b/fixtures/actions/workflow-runs-list.json new file mode 100644 --- /dev/null +++ b/fixtures/actions/workflow-runs-list.json @@ -0,0 +1,665 @@ +{ + "total_count": 3, + "workflow_runs": [ + { + "id": 3353449941, + "name": "K0Te is learning GitHub Actions", + "node_id": "WFR_kwLOIVc8sc7H4ZXV", + "head_branch": "main", + "head_sha": "3156f684232a3adec5085c920d2006aca80f2798", + "path": ".github/workflows/make_artifact.yaml", + "display_title": "K0Te is learning GitHub Actions", + "run_number": 3, + "event": "push", + "status": "completed", + "conclusion": "success", + "workflow_id": 39065091, + "check_suite_id": 9030268154, + "check_suite_node_id": "CS_kwDOIVc8sc8AAAACGj70-g", + "url": "https://api.github.com/repos/kote-test-org-actions/actions-api/actions/runs/3353449941", + "html_url": "https://github.com/kote-test-org-actions/actions-api/actions/runs/3353449941", + "pull_requests": [], + "created_at": "2022-10-30T00:09:22Z", + "updated_at": "2022-10-30T00:09:50Z", + "actor": { + "login": "K0Te", + "id": 6162155, + "node_id": "MDQ6VXNlcjYxNjIxNTU=", + "avatar_url": "https://avatars.githubusercontent.com/u/6162155?v=4", + "gravatar_id": "", + "url": "https://api.github.com/users/K0Te", + "html_url": "https://github.com/K0Te", + "followers_url": "https://api.github.com/users/K0Te/followers", + "following_url": "https://api.github.com/users/K0Te/following{/other_user}", + "gists_url": "https://api.github.com/users/K0Te/gists{/gist_id}", + "starred_url": "https://api.github.com/users/K0Te/starred{/owner}{/repo}", + "subscriptions_url": "https://api.github.com/users/K0Te/subscriptions", + "organizations_url": "https://api.github.com/users/K0Te/orgs", + "repos_url": "https://api.github.com/users/K0Te/repos", + "events_url": "https://api.github.com/users/K0Te/events{/privacy}", + "received_events_url": "https://api.github.com/users/K0Te/received_events", + "type": "User", + "site_admin": false + }, + "run_attempt": 1, + "referenced_workflows": [], + "run_started_at": "2022-10-30T00:09:22Z", + "triggering_actor": { + "login": "K0Te", + "id": 6162155, + "node_id": "MDQ6VXNlcjYxNjIxNTU=", + "avatar_url": "https://avatars.githubusercontent.com/u/6162155?v=4", + "gravatar_id": "", + "url": "https://api.github.com/users/K0Te", + "html_url": "https://github.com/K0Te", + "followers_url": "https://api.github.com/users/K0Te/followers", + "following_url": "https://api.github.com/users/K0Te/following{/other_user}", + "gists_url": "https://api.github.com/users/K0Te/gists{/gist_id}", + "starred_url": "https://api.github.com/users/K0Te/starred{/owner}{/repo}", + "subscriptions_url": "https://api.github.com/users/K0Te/subscriptions", + "organizations_url": "https://api.github.com/users/K0Te/orgs", + "repos_url": "https://api.github.com/users/K0Te/repos", + "events_url": "https://api.github.com/users/K0Te/events{/privacy}", + "received_events_url": "https://api.github.com/users/K0Te/received_events", + "type": "User", + "site_admin": false + }, + "jobs_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/actions/runs/3353449941/jobs", + "logs_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/actions/runs/3353449941/logs", + "check_suite_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/check-suites/9030268154", + "artifacts_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/actions/runs/3353449941/artifacts", + "cancel_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/actions/runs/3353449941/cancel", + "rerun_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/actions/runs/3353449941/rerun", + "previous_attempt_url": null, + "workflow_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/actions/workflows/39065091", + "head_commit": { + "id": "3156f684232a3adec5085c920d2006aca80f2798", + "tree_id": "f51ba8632086ca7af92f5e58c1dc98df1c62d7ce", + "message": "up", + "timestamp": "2022-10-30T00:09:16Z", + "author": { + "name": "Oleg Nykolyn", + "email": "juravel2@gmail.com" + }, + "committer": { + "name": "Oleg Nykolyn", + "email": "juravel2@gmail.com" + } + }, + "repository": { + "id": 559365297, + "node_id": "R_kgDOIVc8sQ", + "name": "actions-api", + "full_name": "kote-test-org-actions/actions-api", + "private": true, + "owner": { + "login": "kote-test-org-actions", + "id": 116976977, + "node_id": "O_kgDOBvjtUQ", + "avatar_url": "https://avatars.githubusercontent.com/u/116976977?v=4", + "gravatar_id": "", + "url": "https://api.github.com/users/kote-test-org-actions", + "html_url": "https://github.com/kote-test-org-actions", + "followers_url": "https://api.github.com/users/kote-test-org-actions/followers", + "following_url": "https://api.github.com/users/kote-test-org-actions/following{/other_user}", + "gists_url": "https://api.github.com/users/kote-test-org-actions/gists{/gist_id}", + "starred_url": "https://api.github.com/users/kote-test-org-actions/starred{/owner}{/repo}", + "subscriptions_url": "https://api.github.com/users/kote-test-org-actions/subscriptions", + "organizations_url": "https://api.github.com/users/kote-test-org-actions/orgs", + "repos_url": "https://api.github.com/users/kote-test-org-actions/repos", + "events_url": "https://api.github.com/users/kote-test-org-actions/events{/privacy}", + "received_events_url": "https://api.github.com/users/kote-test-org-actions/received_events", + "type": "Organization", + "site_admin": false + }, + "html_url": "https://github.com/kote-test-org-actions/actions-api", + "description": null, + "fork": false, + "url": "https://api.github.com/repos/kote-test-org-actions/actions-api", + "forks_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/forks", + "keys_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/keys{/key_id}", + "collaborators_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/collaborators{/collaborator}", + "teams_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/teams", + "hooks_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/hooks", + "issue_events_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/issues/events{/number}", + "events_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/events", + "assignees_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/assignees{/user}", + "branches_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/branches{/branch}", + "tags_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/tags", + "blobs_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/git/blobs{/sha}", + "git_tags_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/git/tags{/sha}", + "git_refs_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/git/refs{/sha}", + "trees_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/git/trees{/sha}", + "statuses_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/statuses/{sha}", + "languages_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/languages", + "stargazers_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/stargazers", + "contributors_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/contributors", + "subscribers_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/subscribers", + "subscription_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/subscription", + "commits_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/commits{/sha}", + "git_commits_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/git/commits{/sha}", + "comments_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/comments{/number}", + "issue_comment_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/issues/comments{/number}", + "contents_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/contents/{+path}", + "compare_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/compare/{base}...{head}", + "merges_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/merges", + "archive_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/{archive_format}{/ref}", + "downloads_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/downloads", + "issues_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/issues{/number}", + "pulls_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/pulls{/number}", + "milestones_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/milestones{/number}", + "notifications_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/notifications{?since,all,participating}", + "labels_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/labels{/name}", + "releases_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/releases{/id}", + "deployments_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/deployments" + }, + "head_repository": { + "id": 559365297, + "node_id": "R_kgDOIVc8sQ", + "name": "actions-api", + "full_name": "kote-test-org-actions/actions-api", + "private": true, + "owner": { + "login": "kote-test-org-actions", + "id": 116976977, + "node_id": "O_kgDOBvjtUQ", + "avatar_url": "https://avatars.githubusercontent.com/u/116976977?v=4", + "gravatar_id": "", + "url": "https://api.github.com/users/kote-test-org-actions", + "html_url": "https://github.com/kote-test-org-actions", + "followers_url": "https://api.github.com/users/kote-test-org-actions/followers", + "following_url": "https://api.github.com/users/kote-test-org-actions/following{/other_user}", + "gists_url": "https://api.github.com/users/kote-test-org-actions/gists{/gist_id}", + "starred_url": "https://api.github.com/users/kote-test-org-actions/starred{/owner}{/repo}", + "subscriptions_url": "https://api.github.com/users/kote-test-org-actions/subscriptions", + "organizations_url": "https://api.github.com/users/kote-test-org-actions/orgs", + "repos_url": "https://api.github.com/users/kote-test-org-actions/repos", + "events_url": "https://api.github.com/users/kote-test-org-actions/events{/privacy}", + "received_events_url": "https://api.github.com/users/kote-test-org-actions/received_events", + "type": "Organization", + "site_admin": false + }, + "html_url": "https://github.com/kote-test-org-actions/actions-api", + "description": null, + "fork": false, + "url": "https://api.github.com/repos/kote-test-org-actions/actions-api", + "forks_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/forks", + "keys_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/keys{/key_id}", + "collaborators_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/collaborators{/collaborator}", + "teams_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/teams", + "hooks_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/hooks", + "issue_events_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/issues/events{/number}", + "events_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/events", + "assignees_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/assignees{/user}", + "branches_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/branches{/branch}", + "tags_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/tags", + "blobs_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/git/blobs{/sha}", + "git_tags_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/git/tags{/sha}", + "git_refs_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/git/refs{/sha}", + "trees_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/git/trees{/sha}", + "statuses_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/statuses/{sha}", + "languages_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/languages", + "stargazers_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/stargazers", + "contributors_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/contributors", + "subscribers_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/subscribers", + "subscription_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/subscription", + "commits_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/commits{/sha}", + "git_commits_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/git/commits{/sha}", + "comments_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/comments{/number}", + "issue_comment_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/issues/comments{/number}", + "contents_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/contents/{+path}", + "compare_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/compare/{base}...{head}", + "merges_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/merges", + "archive_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/{archive_format}{/ref}", + "downloads_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/downloads", + "issues_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/issues{/number}", + "pulls_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/pulls{/number}", + "milestones_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/milestones{/number}", + "notifications_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/notifications{?since,all,participating}", + "labels_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/labels{/name}", + "releases_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/releases{/id}", + "deployments_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/deployments" + } + }, + { + "id": 3353445625, + "name": "K0Te is learning GitHub Actions", + "node_id": "WFR_kwLOIVc8sc7H4YT5", + "head_branch": "main", + "head_sha": "2d2486b9aecb80bf916717f47f7c312431d3ceb6", + "path": ".github/workflows/make_artifact.yaml", + "display_title": "K0Te is learning GitHub Actions", + "run_number": 2, + "event": "push", + "status": "completed", + "conclusion": "success", + "workflow_id": 39065091, + "check_suite_id": 9030259685, + "check_suite_node_id": "CS_kwDOIVc8sc8AAAACGj7T5Q", + "url": "https://api.github.com/repos/kote-test-org-actions/actions-api/actions/runs/3353445625", + "html_url": "https://github.com/kote-test-org-actions/actions-api/actions/runs/3353445625", + "pull_requests": [], + "created_at": "2022-10-30T00:07:49Z", + "updated_at": "2022-10-30T00:08:19Z", + "actor": { + "login": "K0Te", + "id": 6162155, + "node_id": "MDQ6VXNlcjYxNjIxNTU=", + "avatar_url": "https://avatars.githubusercontent.com/u/6162155?v=4", + "gravatar_id": "", + "url": "https://api.github.com/users/K0Te", + "html_url": "https://github.com/K0Te", + "followers_url": "https://api.github.com/users/K0Te/followers", + "following_url": "https://api.github.com/users/K0Te/following{/other_user}", + "gists_url": "https://api.github.com/users/K0Te/gists{/gist_id}", + "starred_url": "https://api.github.com/users/K0Te/starred{/owner}{/repo}", + "subscriptions_url": "https://api.github.com/users/K0Te/subscriptions", + "organizations_url": "https://api.github.com/users/K0Te/orgs", + "repos_url": "https://api.github.com/users/K0Te/repos", + "events_url": "https://api.github.com/users/K0Te/events{/privacy}", + "received_events_url": "https://api.github.com/users/K0Te/received_events", + "type": "User", + "site_admin": false + }, + "run_attempt": 1, + "referenced_workflows": [], + "run_started_at": "2022-10-30T00:07:49Z", + "triggering_actor": { + "login": "K0Te", + "id": 6162155, + "node_id": "MDQ6VXNlcjYxNjIxNTU=", + "avatar_url": "https://avatars.githubusercontent.com/u/6162155?v=4", + "gravatar_id": "", + "url": "https://api.github.com/users/K0Te", + "html_url": "https://github.com/K0Te", + "followers_url": "https://api.github.com/users/K0Te/followers", + "following_url": "https://api.github.com/users/K0Te/following{/other_user}", + "gists_url": "https://api.github.com/users/K0Te/gists{/gist_id}", + "starred_url": "https://api.github.com/users/K0Te/starred{/owner}{/repo}", + "subscriptions_url": "https://api.github.com/users/K0Te/subscriptions", + "organizations_url": "https://api.github.com/users/K0Te/orgs", + "repos_url": "https://api.github.com/users/K0Te/repos", + "events_url": "https://api.github.com/users/K0Te/events{/privacy}", + "received_events_url": "https://api.github.com/users/K0Te/received_events", + "type": "User", + "site_admin": false + }, + "jobs_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/actions/runs/3353445625/jobs", + "logs_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/actions/runs/3353445625/logs", + "check_suite_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/check-suites/9030259685", + "artifacts_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/actions/runs/3353445625/artifacts", + "cancel_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/actions/runs/3353445625/cancel", + "rerun_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/actions/runs/3353445625/rerun", + "previous_attempt_url": null, + "workflow_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/actions/workflows/39065091", + "head_commit": { + "id": "2d2486b9aecb80bf916717f47f7c312431d3ceb6", + "tree_id": "21d858674ab650ea734b7efbf05442a21685d121", + "message": "up", + "timestamp": "2022-10-30T00:07:44Z", + "author": { + "name": "Oleg Nykolyn", + "email": "juravel2@gmail.com" + }, + "committer": { + "name": "Oleg Nykolyn", + "email": "juravel2@gmail.com" + } + }, + "repository": { + "id": 559365297, + "node_id": "R_kgDOIVc8sQ", + "name": "actions-api", + "full_name": "kote-test-org-actions/actions-api", + "private": true, + "owner": { + "login": "kote-test-org-actions", + "id": 116976977, + "node_id": "O_kgDOBvjtUQ", + "avatar_url": "https://avatars.githubusercontent.com/u/116976977?v=4", + "gravatar_id": "", + "url": "https://api.github.com/users/kote-test-org-actions", + "html_url": "https://github.com/kote-test-org-actions", + "followers_url": "https://api.github.com/users/kote-test-org-actions/followers", + "following_url": "https://api.github.com/users/kote-test-org-actions/following{/other_user}", + "gists_url": "https://api.github.com/users/kote-test-org-actions/gists{/gist_id}", + "starred_url": "https://api.github.com/users/kote-test-org-actions/starred{/owner}{/repo}", + "subscriptions_url": "https://api.github.com/users/kote-test-org-actions/subscriptions", + "organizations_url": "https://api.github.com/users/kote-test-org-actions/orgs", + "repos_url": "https://api.github.com/users/kote-test-org-actions/repos", + "events_url": "https://api.github.com/users/kote-test-org-actions/events{/privacy}", + "received_events_url": "https://api.github.com/users/kote-test-org-actions/received_events", + "type": "Organization", + "site_admin": false + }, + "html_url": "https://github.com/kote-test-org-actions/actions-api", + "description": null, + "fork": false, + "url": "https://api.github.com/repos/kote-test-org-actions/actions-api", + "forks_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/forks", + "keys_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/keys{/key_id}", + "collaborators_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/collaborators{/collaborator}", + "teams_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/teams", + "hooks_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/hooks", + "issue_events_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/issues/events{/number}", + "events_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/events", + "assignees_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/assignees{/user}", + "branches_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/branches{/branch}", + "tags_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/tags", + "blobs_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/git/blobs{/sha}", + "git_tags_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/git/tags{/sha}", + "git_refs_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/git/refs{/sha}", + "trees_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/git/trees{/sha}", + "statuses_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/statuses/{sha}", + "languages_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/languages", + "stargazers_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/stargazers", + "contributors_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/contributors", + "subscribers_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/subscribers", + "subscription_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/subscription", + "commits_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/commits{/sha}", + "git_commits_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/git/commits{/sha}", + "comments_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/comments{/number}", + "issue_comment_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/issues/comments{/number}", + "contents_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/contents/{+path}", + "compare_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/compare/{base}...{head}", + "merges_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/merges", + "archive_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/{archive_format}{/ref}", + "downloads_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/downloads", + "issues_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/issues{/number}", + "pulls_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/pulls{/number}", + "milestones_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/milestones{/number}", + "notifications_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/notifications{?since,all,participating}", + "labels_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/labels{/name}", + "releases_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/releases{/id}", + "deployments_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/deployments" + }, + "head_repository": { + "id": 559365297, + "node_id": "R_kgDOIVc8sQ", + "name": "actions-api", + "full_name": "kote-test-org-actions/actions-api", + "private": true, + "owner": { + "login": "kote-test-org-actions", + "id": 116976977, + "node_id": "O_kgDOBvjtUQ", + "avatar_url": "https://avatars.githubusercontent.com/u/116976977?v=4", + "gravatar_id": "", + "url": "https://api.github.com/users/kote-test-org-actions", + "html_url": "https://github.com/kote-test-org-actions", + "followers_url": "https://api.github.com/users/kote-test-org-actions/followers", + "following_url": "https://api.github.com/users/kote-test-org-actions/following{/other_user}", + "gists_url": "https://api.github.com/users/kote-test-org-actions/gists{/gist_id}", + "starred_url": "https://api.github.com/users/kote-test-org-actions/starred{/owner}{/repo}", + "subscriptions_url": "https://api.github.com/users/kote-test-org-actions/subscriptions", + "organizations_url": "https://api.github.com/users/kote-test-org-actions/orgs", + "repos_url": "https://api.github.com/users/kote-test-org-actions/repos", + "events_url": "https://api.github.com/users/kote-test-org-actions/events{/privacy}", + "received_events_url": "https://api.github.com/users/kote-test-org-actions/received_events", + "type": "Organization", + "site_admin": false + }, + "html_url": "https://github.com/kote-test-org-actions/actions-api", + "description": null, + "fork": false, + "url": "https://api.github.com/repos/kote-test-org-actions/actions-api", + "forks_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/forks", + "keys_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/keys{/key_id}", + "collaborators_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/collaborators{/collaborator}", + "teams_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/teams", + "hooks_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/hooks", + "issue_events_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/issues/events{/number}", + "events_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/events", + "assignees_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/assignees{/user}", + "branches_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/branches{/branch}", + "tags_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/tags", + "blobs_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/git/blobs{/sha}", + "git_tags_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/git/tags{/sha}", + "git_refs_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/git/refs{/sha}", + "trees_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/git/trees{/sha}", + "statuses_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/statuses/{sha}", + "languages_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/languages", + "stargazers_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/stargazers", + "contributors_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/contributors", + "subscribers_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/subscribers", + "subscription_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/subscription", + "commits_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/commits{/sha}", + "git_commits_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/git/commits{/sha}", + "comments_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/comments{/number}", + "issue_comment_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/issues/comments{/number}", + "contents_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/contents/{+path}", + "compare_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/compare/{base}...{head}", + "merges_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/merges", + "archive_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/{archive_format}{/ref}", + "downloads_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/downloads", + "issues_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/issues{/number}", + "pulls_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/pulls{/number}", + "milestones_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/milestones{/number}", + "notifications_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/notifications{?since,all,participating}", + "labels_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/labels{/name}", + "releases_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/releases{/id}", + "deployments_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/deployments" + } + }, + { + "id": 3353148947, + "name": "K0Te is learning GitHub Actions", + "node_id": "WFR_kwLOIVc8sc7H3P4T", + "head_branch": "main", + "head_sha": "601593ecb1d8a57a04700fdb445a28d4186b8954", + "path": ".github/workflows/make_artifact.yaml", + "display_title": "K0Te is learning GitHub Actions", + "run_number": 1, + "event": "push", + "status": "completed", + "conclusion": "success", + "workflow_id": 39065091, + "check_suite_id": 9029740591, + "check_suite_node_id": "CS_kwDOIVc8sc8AAAACGjboLw", + "url": "https://api.github.com/repos/kote-test-org-actions/actions-api/actions/runs/3353148947", + "html_url": "https://github.com/kote-test-org-actions/actions-api/actions/runs/3353148947", + "pull_requests": [], + "created_at": "2022-10-29T22:18:02Z", + "updated_at": "2022-10-29T22:18:22Z", + "actor": { + "login": "K0Te", + "id": 6162155, + "node_id": "MDQ6VXNlcjYxNjIxNTU=", + "avatar_url": "https://avatars.githubusercontent.com/u/6162155?v=4", + "gravatar_id": "", + "url": "https://api.github.com/users/K0Te", + "html_url": "https://github.com/K0Te", + "followers_url": "https://api.github.com/users/K0Te/followers", + "following_url": "https://api.github.com/users/K0Te/following{/other_user}", + "gists_url": "https://api.github.com/users/K0Te/gists{/gist_id}", + "starred_url": "https://api.github.com/users/K0Te/starred{/owner}{/repo}", + "subscriptions_url": "https://api.github.com/users/K0Te/subscriptions", + "organizations_url": "https://api.github.com/users/K0Te/orgs", + "repos_url": "https://api.github.com/users/K0Te/repos", + "events_url": "https://api.github.com/users/K0Te/events{/privacy}", + "received_events_url": "https://api.github.com/users/K0Te/received_events", + "type": "User", + "site_admin": false + }, + "run_attempt": 1, + "referenced_workflows": [], + "run_started_at": "2022-10-29T22:18:02Z", + "triggering_actor": { + "login": "K0Te", + "id": 6162155, + "node_id": "MDQ6VXNlcjYxNjIxNTU=", + "avatar_url": "https://avatars.githubusercontent.com/u/6162155?v=4", + "gravatar_id": "", + "url": "https://api.github.com/users/K0Te", + "html_url": "https://github.com/K0Te", + "followers_url": "https://api.github.com/users/K0Te/followers", + "following_url": "https://api.github.com/users/K0Te/following{/other_user}", + "gists_url": "https://api.github.com/users/K0Te/gists{/gist_id}", + "starred_url": "https://api.github.com/users/K0Te/starred{/owner}{/repo}", + "subscriptions_url": "https://api.github.com/users/K0Te/subscriptions", + "organizations_url": "https://api.github.com/users/K0Te/orgs", + "repos_url": "https://api.github.com/users/K0Te/repos", + "events_url": "https://api.github.com/users/K0Te/events{/privacy}", + "received_events_url": "https://api.github.com/users/K0Te/received_events", + "type": "User", + "site_admin": false + }, + "jobs_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/actions/runs/3353148947/jobs", + "logs_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/actions/runs/3353148947/logs", + "check_suite_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/check-suites/9029740591", + "artifacts_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/actions/runs/3353148947/artifacts", + "cancel_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/actions/runs/3353148947/cancel", + "rerun_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/actions/runs/3353148947/rerun", + "previous_attempt_url": null, + "workflow_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/actions/workflows/39065091", + "head_commit": { + "id": "601593ecb1d8a57a04700fdb445a28d4186b8954", + "tree_id": "7aa2d4e6f4e0ddb277fe2f35f7615651ee01c5a2", + "message": "test", + "timestamp": "2022-10-29T22:17:55Z", + "author": { + "name": "Oleg Nykolyn", + "email": "juravel2@gmail.com" + }, + "committer": { + "name": "Oleg Nykolyn", + "email": "juravel2@gmail.com" + } + }, + "repository": { + "id": 559365297, + "node_id": "R_kgDOIVc8sQ", + "name": "actions-api", + "full_name": "kote-test-org-actions/actions-api", + "private": true, + "owner": { + "login": "kote-test-org-actions", + "id": 116976977, + "node_id": "O_kgDOBvjtUQ", + "avatar_url": "https://avatars.githubusercontent.com/u/116976977?v=4", + "gravatar_id": "", + "url": "https://api.github.com/users/kote-test-org-actions", + "html_url": "https://github.com/kote-test-org-actions", + "followers_url": "https://api.github.com/users/kote-test-org-actions/followers", + "following_url": "https://api.github.com/users/kote-test-org-actions/following{/other_user}", + "gists_url": "https://api.github.com/users/kote-test-org-actions/gists{/gist_id}", + "starred_url": "https://api.github.com/users/kote-test-org-actions/starred{/owner}{/repo}", + "subscriptions_url": "https://api.github.com/users/kote-test-org-actions/subscriptions", + "organizations_url": "https://api.github.com/users/kote-test-org-actions/orgs", + "repos_url": "https://api.github.com/users/kote-test-org-actions/repos", + "events_url": "https://api.github.com/users/kote-test-org-actions/events{/privacy}", + "received_events_url": "https://api.github.com/users/kote-test-org-actions/received_events", + "type": "Organization", + "site_admin": false + }, + "html_url": "https://github.com/kote-test-org-actions/actions-api", + "description": null, + "fork": false, + "url": "https://api.github.com/repos/kote-test-org-actions/actions-api", + "forks_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/forks", + "keys_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/keys{/key_id}", + "collaborators_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/collaborators{/collaborator}", + "teams_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/teams", + "hooks_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/hooks", + "issue_events_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/issues/events{/number}", + "events_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/events", + "assignees_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/assignees{/user}", + "branches_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/branches{/branch}", + "tags_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/tags", + "blobs_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/git/blobs{/sha}", + "git_tags_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/git/tags{/sha}", + "git_refs_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/git/refs{/sha}", + "trees_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/git/trees{/sha}", + "statuses_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/statuses/{sha}", + "languages_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/languages", + "stargazers_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/stargazers", + "contributors_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/contributors", + "subscribers_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/subscribers", + "subscription_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/subscription", + "commits_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/commits{/sha}", + "git_commits_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/git/commits{/sha}", + "comments_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/comments{/number}", + "issue_comment_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/issues/comments{/number}", + "contents_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/contents/{+path}", + "compare_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/compare/{base}...{head}", + "merges_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/merges", + "archive_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/{archive_format}{/ref}", + "downloads_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/downloads", + "issues_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/issues{/number}", + "pulls_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/pulls{/number}", + "milestones_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/milestones{/number}", + "notifications_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/notifications{?since,all,participating}", + "labels_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/labels{/name}", + "releases_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/releases{/id}", + "deployments_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/deployments" + }, + "head_repository": { + "id": 559365297, + "node_id": "R_kgDOIVc8sQ", + "name": "actions-api", + "full_name": "kote-test-org-actions/actions-api", + "private": true, + "owner": { + "login": "kote-test-org-actions", + "id": 116976977, + "node_id": "O_kgDOBvjtUQ", + "avatar_url": "https://avatars.githubusercontent.com/u/116976977?v=4", + "gravatar_id": "", + "url": "https://api.github.com/users/kote-test-org-actions", + "html_url": "https://github.com/kote-test-org-actions", + "followers_url": "https://api.github.com/users/kote-test-org-actions/followers", + "following_url": "https://api.github.com/users/kote-test-org-actions/following{/other_user}", + "gists_url": "https://api.github.com/users/kote-test-org-actions/gists{/gist_id}", + "starred_url": "https://api.github.com/users/kote-test-org-actions/starred{/owner}{/repo}", + "subscriptions_url": "https://api.github.com/users/kote-test-org-actions/subscriptions", + "organizations_url": "https://api.github.com/users/kote-test-org-actions/orgs", + "repos_url": "https://api.github.com/users/kote-test-org-actions/repos", + "events_url": "https://api.github.com/users/kote-test-org-actions/events{/privacy}", + "received_events_url": "https://api.github.com/users/kote-test-org-actions/received_events", + "type": "Organization", + "site_admin": false + }, + "html_url": "https://github.com/kote-test-org-actions/actions-api", + "description": null, + "fork": false, + "url": "https://api.github.com/repos/kote-test-org-actions/actions-api", + "forks_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/forks", + "keys_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/keys{/key_id}", + "collaborators_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/collaborators{/collaborator}", + "teams_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/teams", + "hooks_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/hooks", + "issue_events_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/issues/events{/number}", + "events_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/events", + "assignees_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/assignees{/user}", + "branches_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/branches{/branch}", + "tags_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/tags", + "blobs_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/git/blobs{/sha}", + "git_tags_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/git/tags{/sha}", + "git_refs_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/git/refs{/sha}", + "trees_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/git/trees{/sha}", + "statuses_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/statuses/{sha}", + "languages_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/languages", + "stargazers_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/stargazers", + "contributors_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/contributors", + "subscribers_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/subscribers", + "subscription_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/subscription", + "commits_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/commits{/sha}", + "git_commits_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/git/commits{/sha}", + "comments_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/comments{/number}", + "issue_comment_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/issues/comments{/number}", + "contents_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/contents/{+path}", + "compare_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/compare/{base}...{head}", + "merges_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/merges", + "archive_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/{archive_format}{/ref}", + "downloads_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/downloads", + "issues_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/issues{/number}", + "pulls_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/pulls{/number}", + "milestones_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/milestones{/number}", + "notifications_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/notifications{?since,all,participating}", + "labels_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/labels{/name}", + "releases_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/releases{/id}", + "deployments_url": "https://api.github.com/repos/kote-test-org-actions/actions-api/deployments" + } + } + ] +} diff --git a/fixtures/pull-request-approved-review.json b/fixtures/pull-request-approved-review.json new file mode 100644 --- /dev/null +++ b/fixtures/pull-request-approved-review.json @@ -0,0 +1,38 @@ +{ + "id": 80, + "node_id": "MDE3OlB1bGxSZXF1ZXN0UmV2aWV3ODA=", + "user": { + "login": "octocat", + "id": 1, + "node_id": "MDQ6VXNlcjE=", + "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 + }, + "body": "Here is the body for the review.", + "state": "APPROVED", + "html_url": "https://github.com/octocat/Hello-World/pull/12#pullrequestreview-80", + "pull_request_url": "https://api.github.com/repos/octocat/Hello-World/pulls/12", + "_links": { + "html": { + "href": "https://github.com/octocat/Hello-World/pull/12#pullrequestreview-80" + }, + "pull_request": { + "href": "https://api.github.com/repos/octocat/Hello-World/pulls/12" + } + }, + "submitted_at": "2019-11-17T17:43:43Z", + "commit_id": "ecdd80bb57125d7ba9641ffaa4d7d2c19d3f3091" +} diff --git a/fixtures/pull-request-pending-review.json b/fixtures/pull-request-pending-review.json new file mode 100644 --- /dev/null +++ b/fixtures/pull-request-pending-review.json @@ -0,0 +1,37 @@ +{ + "id": 80, + "node_id": "MDE3OlB1bGxSZXF1ZXN0UmV2aWV3ODA=", + "user": { + "login": "octocat", + "id": 1, + "node_id": "MDQ6VXNlcjE=", + "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 + }, + "body": "Here is the body for the review.", + "state": "PENDING", + "html_url": "https://github.com/octocat/Hello-World/pull/12#pullrequestreview-80", + "pull_request_url": "https://api.github.com/repos/octocat/Hello-World/pulls/12", + "_links": { + "html": { + "href": "https://github.com/octocat/Hello-World/pull/12#pullrequestreview-80" + }, + "pull_request": { + "href": "https://api.github.com/repos/octocat/Hello-World/pulls/12" + } + }, + "commit_id": "ecdd80bb57125d7ba9641ffaa4d7d2c19d3f3091" +} diff --git a/fixtures/pull-request-team-review-requested.json b/fixtures/pull-request-team-review-requested.json new file mode 100644 --- /dev/null +++ b/fixtures/pull-request-team-review-requested.json @@ -0,0 +1,362 @@ +{ + "url": "https://api.github.com/repos/tahoe-lafs/tahoe-lafs/pulls/910", + "id": 529597962, + "node_id": "MDExOlB1bGxSZXF1ZXN0NTI5NTk3OTYy", + "html_url": "https://github.com/tahoe-lafs/tahoe-lafs/pull/910", + "diff_url": "https://github.com/tahoe-lafs/tahoe-lafs/pull/910.diff", + "patch_url": "https://github.com/tahoe-lafs/tahoe-lafs/pull/910.patch", + "issue_url": "https://api.github.com/repos/tahoe-lafs/tahoe-lafs/issues/910", + "number": 910, + "state": "open", + "locked": false, + "title": "Fix NodeMaker's use of the WeakValueDictionary", + "user": { + "login": "exarkun", + "id": 254565, + "node_id": "MDQ6VXNlcjI1NDU2NQ==", + "avatar_url": "https://avatars1.githubusercontent.com/u/254565?v=4", + "gravatar_id": "", + "url": "https://api.github.com/users/exarkun", + "html_url": "https://github.com/exarkun", + "followers_url": "https://api.github.com/users/exarkun/followers", + "following_url": "https://api.github.com/users/exarkun/following{/other_user}", + "gists_url": "https://api.github.com/users/exarkun/gists{/gist_id}", + "starred_url": "https://api.github.com/users/exarkun/starred{/owner}{/repo}", + "subscriptions_url": "https://api.github.com/users/exarkun/subscriptions", + "organizations_url": "https://api.github.com/users/exarkun/orgs", + "repos_url": "https://api.github.com/users/exarkun/repos", + "events_url": "https://api.github.com/users/exarkun/events{/privacy}", + "received_events_url": "https://api.github.com/users/exarkun/received_events", + "type": "User", + "site_admin": false + }, + "body": "https://tahoe-lafs.org/trac/tahoe-lafs/ticket/3539", + "created_at": "2020-11-30T14:46:37Z", + "updated_at": "2020-12-02T17:23:41Z", + "closed_at": null, + "merged_at": null, + "merge_commit_sha": "3c97064ee5f71357c88f7940a91da8859641c2c6", + "assignee": null, + "assignees": [ + + ], + "requested_reviewers": [ + + ], + "requested_teams": [ + { + "name": "Tahoe Committers", + "id": 121616, + "node_id": "MDQ6VGVhbTEyMTYxNg==", + "slug": "tahoe-committers", + "description": null, + "privacy": "closed", + "url": "https://api.github.com/organizations/1156454/team/121616", + "html_url": "https://github.com/orgs/tahoe-lafs/teams/tahoe-committers", + "members_url": "https://api.github.com/organizations/1156454/team/121616/members{/member}", + "repositories_url": "https://api.github.com/organizations/1156454/team/121616/repos", + "permission": "push", + "parent": null + } + ], + "labels": [ + + ], + "milestone": null, + "draft": false, + "commits_url": "https://api.github.com/repos/tahoe-lafs/tahoe-lafs/pulls/910/commits", + "review_comments_url": "https://api.github.com/repos/tahoe-lafs/tahoe-lafs/pulls/910/comments", + "review_comment_url": "https://api.github.com/repos/tahoe-lafs/tahoe-lafs/pulls/comments{/number}", + "comments_url": "https://api.github.com/repos/tahoe-lafs/tahoe-lafs/issues/910/comments", + "statuses_url": "https://api.github.com/repos/tahoe-lafs/tahoe-lafs/statuses/ef2f7e61364c6a3187d2ab4859adfc4031213bdd", + "head": { + "label": "tahoe-lafs:3539.nodemaker-weakrefdict", + "ref": "3539.nodemaker-weakrefdict", + "sha": "ef2f7e61364c6a3187d2ab4859adfc4031213bdd", + "user": { + "login": "tahoe-lafs", + "id": 1156454, + "node_id": "MDEyOk9yZ2FuaXphdGlvbjExNTY0NTQ=", + "avatar_url": "https://avatars1.githubusercontent.com/u/1156454?v=4", + "gravatar_id": "", + "url": "https://api.github.com/users/tahoe-lafs", + "html_url": "https://github.com/tahoe-lafs", + "followers_url": "https://api.github.com/users/tahoe-lafs/followers", + "following_url": "https://api.github.com/users/tahoe-lafs/following{/other_user}", + "gists_url": "https://api.github.com/users/tahoe-lafs/gists{/gist_id}", + "starred_url": "https://api.github.com/users/tahoe-lafs/starred{/owner}{/repo}", + "subscriptions_url": "https://api.github.com/users/tahoe-lafs/subscriptions", + "organizations_url": "https://api.github.com/users/tahoe-lafs/orgs", + "repos_url": "https://api.github.com/users/tahoe-lafs/repos", + "events_url": "https://api.github.com/users/tahoe-lafs/events{/privacy}", + "received_events_url": "https://api.github.com/users/tahoe-lafs/received_events", + "type": "Organization", + "site_admin": false + }, + "repo": { + "id": 3007569, + "node_id": "MDEwOlJlcG9zaXRvcnkzMDA3NTY5", + "name": "tahoe-lafs", + "full_name": "tahoe-lafs/tahoe-lafs", + "private": false, + "owner": { + "login": "tahoe-lafs", + "id": 1156454, + "node_id": "MDEyOk9yZ2FuaXphdGlvbjExNTY0NTQ=", + "avatar_url": "https://avatars1.githubusercontent.com/u/1156454?v=4", + "gravatar_id": "", + "url": "https://api.github.com/users/tahoe-lafs", + "html_url": "https://github.com/tahoe-lafs", + "followers_url": "https://api.github.com/users/tahoe-lafs/followers", + "following_url": "https://api.github.com/users/tahoe-lafs/following{/other_user}", + "gists_url": "https://api.github.com/users/tahoe-lafs/gists{/gist_id}", + "starred_url": "https://api.github.com/users/tahoe-lafs/starred{/owner}{/repo}", + "subscriptions_url": "https://api.github.com/users/tahoe-lafs/subscriptions", + "organizations_url": "https://api.github.com/users/tahoe-lafs/orgs", + "repos_url": "https://api.github.com/users/tahoe-lafs/repos", + "events_url": "https://api.github.com/users/tahoe-lafs/events{/privacy}", + "received_events_url": "https://api.github.com/users/tahoe-lafs/received_events", + "type": "Organization", + "site_admin": false + }, + "html_url": "https://github.com/tahoe-lafs/tahoe-lafs", + "description": "The Tahoe-LAFS decentralized secure filesystem.", + "fork": false, + "url": "https://api.github.com/repos/tahoe-lafs/tahoe-lafs", + "forks_url": "https://api.github.com/repos/tahoe-lafs/tahoe-lafs/forks", + "keys_url": "https://api.github.com/repos/tahoe-lafs/tahoe-lafs/keys{/key_id}", + "collaborators_url": "https://api.github.com/repos/tahoe-lafs/tahoe-lafs/collaborators{/collaborator}", + "teams_url": "https://api.github.com/repos/tahoe-lafs/tahoe-lafs/teams", + "hooks_url": "https://api.github.com/repos/tahoe-lafs/tahoe-lafs/hooks", + "issue_events_url": "https://api.github.com/repos/tahoe-lafs/tahoe-lafs/issues/events{/number}", + "events_url": "https://api.github.com/repos/tahoe-lafs/tahoe-lafs/events", + "assignees_url": "https://api.github.com/repos/tahoe-lafs/tahoe-lafs/assignees{/user}", + "branches_url": "https://api.github.com/repos/tahoe-lafs/tahoe-lafs/branches{/branch}", + "tags_url": "https://api.github.com/repos/tahoe-lafs/tahoe-lafs/tags", + "blobs_url": "https://api.github.com/repos/tahoe-lafs/tahoe-lafs/git/blobs{/sha}", + "git_tags_url": "https://api.github.com/repos/tahoe-lafs/tahoe-lafs/git/tags{/sha}", + "git_refs_url": "https://api.github.com/repos/tahoe-lafs/tahoe-lafs/git/refs{/sha}", + "trees_url": "https://api.github.com/repos/tahoe-lafs/tahoe-lafs/git/trees{/sha}", + "statuses_url": "https://api.github.com/repos/tahoe-lafs/tahoe-lafs/statuses/{sha}", + "languages_url": "https://api.github.com/repos/tahoe-lafs/tahoe-lafs/languages", + "stargazers_url": "https://api.github.com/repos/tahoe-lafs/tahoe-lafs/stargazers", + "contributors_url": "https://api.github.com/repos/tahoe-lafs/tahoe-lafs/contributors", + "subscribers_url": "https://api.github.com/repos/tahoe-lafs/tahoe-lafs/subscribers", + "subscription_url": "https://api.github.com/repos/tahoe-lafs/tahoe-lafs/subscription", + "commits_url": "https://api.github.com/repos/tahoe-lafs/tahoe-lafs/commits{/sha}", + "git_commits_url": "https://api.github.com/repos/tahoe-lafs/tahoe-lafs/git/commits{/sha}", + "comments_url": "https://api.github.com/repos/tahoe-lafs/tahoe-lafs/comments{/number}", + "issue_comment_url": "https://api.github.com/repos/tahoe-lafs/tahoe-lafs/issues/comments{/number}", + "contents_url": "https://api.github.com/repos/tahoe-lafs/tahoe-lafs/contents/{+path}", + "compare_url": "https://api.github.com/repos/tahoe-lafs/tahoe-lafs/compare/{base}...{head}", + "merges_url": "https://api.github.com/repos/tahoe-lafs/tahoe-lafs/merges", + "archive_url": "https://api.github.com/repos/tahoe-lafs/tahoe-lafs/{archive_format}{/ref}", + "downloads_url": "https://api.github.com/repos/tahoe-lafs/tahoe-lafs/downloads", + "issues_url": "https://api.github.com/repos/tahoe-lafs/tahoe-lafs/issues{/number}", + "pulls_url": "https://api.github.com/repos/tahoe-lafs/tahoe-lafs/pulls{/number}", + "milestones_url": "https://api.github.com/repos/tahoe-lafs/tahoe-lafs/milestones{/number}", + "notifications_url": "https://api.github.com/repos/tahoe-lafs/tahoe-lafs/notifications{?since,all,participating}", + "labels_url": "https://api.github.com/repos/tahoe-lafs/tahoe-lafs/labels{/name}", + "releases_url": "https://api.github.com/repos/tahoe-lafs/tahoe-lafs/releases{/id}", + "deployments_url": "https://api.github.com/repos/tahoe-lafs/tahoe-lafs/deployments", + "created_at": "2011-12-18T19:33:55Z", + "updated_at": "2020-12-02T20:24:23Z", + "pushed_at": "2020-12-02T20:27:05Z", + "git_url": "git://github.com/tahoe-lafs/tahoe-lafs.git", + "ssh_url": "git@github.com:tahoe-lafs/tahoe-lafs.git", + "clone_url": "https://github.com/tahoe-lafs/tahoe-lafs.git", + "svn_url": "https://github.com/tahoe-lafs/tahoe-lafs", + "homepage": "https://tahoe-lafs.org/", + "size": 73606, + "stargazers_count": 1018, + "watchers_count": 1018, + "language": "Python", + "has_issues": false, + "has_projects": false, + "has_downloads": true, + "has_wiki": false, + "has_pages": false, + "forks_count": 236, + "mirror_url": null, + "archived": false, + "disabled": false, + "open_issues_count": 21, + "license": { + "key": "other", + "name": "Other", + "spdx_id": "NOASSERTION", + "url": null, + "node_id": "MDc6TGljZW5zZTA=" + }, + "forks": 236, + "open_issues": 21, + "watchers": 1018, + "default_branch": "master" + } + }, + "base": { + "label": "tahoe-lafs:master", + "ref": "master", + "sha": "fba386cb8ee2b48a34c0d954b5c6b5b080d3234e", + "user": { + "login": "tahoe-lafs", + "id": 1156454, + "node_id": "MDEyOk9yZ2FuaXphdGlvbjExNTY0NTQ=", + "avatar_url": "https://avatars1.githubusercontent.com/u/1156454?v=4", + "gravatar_id": "", + "url": "https://api.github.com/users/tahoe-lafs", + "html_url": "https://github.com/tahoe-lafs", + "followers_url": "https://api.github.com/users/tahoe-lafs/followers", + "following_url": "https://api.github.com/users/tahoe-lafs/following{/other_user}", + "gists_url": "https://api.github.com/users/tahoe-lafs/gists{/gist_id}", + "starred_url": "https://api.github.com/users/tahoe-lafs/starred{/owner}{/repo}", + "subscriptions_url": "https://api.github.com/users/tahoe-lafs/subscriptions", + "organizations_url": "https://api.github.com/users/tahoe-lafs/orgs", + "repos_url": "https://api.github.com/users/tahoe-lafs/repos", + "events_url": "https://api.github.com/users/tahoe-lafs/events{/privacy}", + "received_events_url": "https://api.github.com/users/tahoe-lafs/received_events", + "type": "Organization", + "site_admin": false + }, + "repo": { + "id": 3007569, + "node_id": "MDEwOlJlcG9zaXRvcnkzMDA3NTY5", + "name": "tahoe-lafs", + "full_name": "tahoe-lafs/tahoe-lafs", + "private": false, + "owner": { + "login": "tahoe-lafs", + "id": 1156454, + "node_id": "MDEyOk9yZ2FuaXphdGlvbjExNTY0NTQ=", + "avatar_url": "https://avatars1.githubusercontent.com/u/1156454?v=4", + "gravatar_id": "", + "url": "https://api.github.com/users/tahoe-lafs", + "html_url": "https://github.com/tahoe-lafs", + "followers_url": "https://api.github.com/users/tahoe-lafs/followers", + "following_url": "https://api.github.com/users/tahoe-lafs/following{/other_user}", + "gists_url": "https://api.github.com/users/tahoe-lafs/gists{/gist_id}", + "starred_url": "https://api.github.com/users/tahoe-lafs/starred{/owner}{/repo}", + "subscriptions_url": "https://api.github.com/users/tahoe-lafs/subscriptions", + "organizations_url": "https://api.github.com/users/tahoe-lafs/orgs", + "repos_url": "https://api.github.com/users/tahoe-lafs/repos", + "events_url": "https://api.github.com/users/tahoe-lafs/events{/privacy}", + "received_events_url": "https://api.github.com/users/tahoe-lafs/received_events", + "type": "Organization", + "site_admin": false + }, + "html_url": "https://github.com/tahoe-lafs/tahoe-lafs", + "description": "The Tahoe-LAFS decentralized secure filesystem.", + "fork": false, + "url": "https://api.github.com/repos/tahoe-lafs/tahoe-lafs", + "forks_url": "https://api.github.com/repos/tahoe-lafs/tahoe-lafs/forks", + "keys_url": "https://api.github.com/repos/tahoe-lafs/tahoe-lafs/keys{/key_id}", + "collaborators_url": "https://api.github.com/repos/tahoe-lafs/tahoe-lafs/collaborators{/collaborator}", + "teams_url": "https://api.github.com/repos/tahoe-lafs/tahoe-lafs/teams", + "hooks_url": "https://api.github.com/repos/tahoe-lafs/tahoe-lafs/hooks", + "issue_events_url": "https://api.github.com/repos/tahoe-lafs/tahoe-lafs/issues/events{/number}", + "events_url": "https://api.github.com/repos/tahoe-lafs/tahoe-lafs/events", + "assignees_url": "https://api.github.com/repos/tahoe-lafs/tahoe-lafs/assignees{/user}", + "branches_url": "https://api.github.com/repos/tahoe-lafs/tahoe-lafs/branches{/branch}", + "tags_url": "https://api.github.com/repos/tahoe-lafs/tahoe-lafs/tags", + "blobs_url": "https://api.github.com/repos/tahoe-lafs/tahoe-lafs/git/blobs{/sha}", + "git_tags_url": "https://api.github.com/repos/tahoe-lafs/tahoe-lafs/git/tags{/sha}", + "git_refs_url": "https://api.github.com/repos/tahoe-lafs/tahoe-lafs/git/refs{/sha}", + "trees_url": "https://api.github.com/repos/tahoe-lafs/tahoe-lafs/git/trees{/sha}", + "statuses_url": "https://api.github.com/repos/tahoe-lafs/tahoe-lafs/statuses/{sha}", + "languages_url": "https://api.github.com/repos/tahoe-lafs/tahoe-lafs/languages", + "stargazers_url": "https://api.github.com/repos/tahoe-lafs/tahoe-lafs/stargazers", + "contributors_url": "https://api.github.com/repos/tahoe-lafs/tahoe-lafs/contributors", + "subscribers_url": "https://api.github.com/repos/tahoe-lafs/tahoe-lafs/subscribers", + "subscription_url": "https://api.github.com/repos/tahoe-lafs/tahoe-lafs/subscription", + "commits_url": "https://api.github.com/repos/tahoe-lafs/tahoe-lafs/commits{/sha}", + "git_commits_url": "https://api.github.com/repos/tahoe-lafs/tahoe-lafs/git/commits{/sha}", + "comments_url": "https://api.github.com/repos/tahoe-lafs/tahoe-lafs/comments{/number}", + "issue_comment_url": "https://api.github.com/repos/tahoe-lafs/tahoe-lafs/issues/comments{/number}", + "contents_url": "https://api.github.com/repos/tahoe-lafs/tahoe-lafs/contents/{+path}", + "compare_url": "https://api.github.com/repos/tahoe-lafs/tahoe-lafs/compare/{base}...{head}", + "merges_url": "https://api.github.com/repos/tahoe-lafs/tahoe-lafs/merges", + "archive_url": "https://api.github.com/repos/tahoe-lafs/tahoe-lafs/{archive_format}{/ref}", + "downloads_url": "https://api.github.com/repos/tahoe-lafs/tahoe-lafs/downloads", + "issues_url": "https://api.github.com/repos/tahoe-lafs/tahoe-lafs/issues{/number}", + "pulls_url": "https://api.github.com/repos/tahoe-lafs/tahoe-lafs/pulls{/number}", + "milestones_url": "https://api.github.com/repos/tahoe-lafs/tahoe-lafs/milestones{/number}", + "notifications_url": "https://api.github.com/repos/tahoe-lafs/tahoe-lafs/notifications{?since,all,participating}", + "labels_url": "https://api.github.com/repos/tahoe-lafs/tahoe-lafs/labels{/name}", + "releases_url": "https://api.github.com/repos/tahoe-lafs/tahoe-lafs/releases{/id}", + "deployments_url": "https://api.github.com/repos/tahoe-lafs/tahoe-lafs/deployments", + "created_at": "2011-12-18T19:33:55Z", + "updated_at": "2020-12-02T20:24:23Z", + "pushed_at": "2020-12-02T20:27:05Z", + "git_url": "git://github.com/tahoe-lafs/tahoe-lafs.git", + "ssh_url": "git@github.com:tahoe-lafs/tahoe-lafs.git", + "clone_url": "https://github.com/tahoe-lafs/tahoe-lafs.git", + "svn_url": "https://github.com/tahoe-lafs/tahoe-lafs", + "homepage": "https://tahoe-lafs.org/", + "size": 73606, + "stargazers_count": 1018, + "watchers_count": 1018, + "language": "Python", + "has_issues": false, + "has_projects": false, + "has_downloads": true, + "has_wiki": false, + "has_pages": false, + "forks_count": 236, + "mirror_url": null, + "archived": false, + "disabled": false, + "open_issues_count": 21, + "license": { + "key": "other", + "name": "Other", + "spdx_id": "NOASSERTION", + "url": null, + "node_id": "MDc6TGljZW5zZTA=" + }, + "forks": 236, + "open_issues": 21, + "watchers": 1018, + "default_branch": "master" + } + }, + "_links": { + "self": { + "href": "https://api.github.com/repos/tahoe-lafs/tahoe-lafs/pulls/910" + }, + "html": { + "href": "https://github.com/tahoe-lafs/tahoe-lafs/pull/910" + }, + "issue": { + "href": "https://api.github.com/repos/tahoe-lafs/tahoe-lafs/issues/910" + }, + "comments": { + "href": "https://api.github.com/repos/tahoe-lafs/tahoe-lafs/issues/910/comments" + }, + "review_comments": { + "href": "https://api.github.com/repos/tahoe-lafs/tahoe-lafs/pulls/910/comments" + }, + "review_comment": { + "href": "https://api.github.com/repos/tahoe-lafs/tahoe-lafs/pulls/comments{/number}" + }, + "commits": { + "href": "https://api.github.com/repos/tahoe-lafs/tahoe-lafs/pulls/910/commits" + }, + "statuses": { + "href": "https://api.github.com/repos/tahoe-lafs/tahoe-lafs/statuses/ef2f7e61364c6a3187d2ab4859adfc4031213bdd" + } + }, + "author_association": "MEMBER", + "active_lock_reason": null, + "merged": false, + "mergeable": true, + "rebaseable": true, + "mergeable_state": "clean", + "merged_by": null, + "comments": 1, + "review_comments": 0, + "maintainer_can_modify": false, + "commits": 5, + "additions": 223, + "deletions": 4, + "changed_files": 5 +} diff --git a/fixtures/user-bot.json b/fixtures/user-bot.json new file mode 100644 --- /dev/null +++ b/fixtures/user-bot.json @@ -0,0 +1,32 @@ +{ + "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" +} diff --git a/github.cabal b/github.cabal --- a/github.cabal +++ b/github.cabal @@ -1,6 +1,8 @@ -name: github -version: 0.19 -synopsis: Access to the GitHub API, v3. +cabal-version: 2.4 +name: github +version: 0.30.0.2 +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 @@ -13,68 +15,97 @@ > > main :: IO () > main = do - > possibleUser <- GH.executeRequest' $ GH.userInfoR "phadej" + > possibleUser <- GH.github' 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 -copyright: Copyright 2012-2013 Mike Burns, Copyright 2013-2015 John Wiegley, Copyright 2016 Oleg Grenrus -category: Network -build-type: Simple -tested-with: GHC==7.8.4, GHC==7.10.3, GHC==8.0.2, GHC==8.2.2 -cabal-version: >=1.10 -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 + For more of an overview please see the README: -flag aeson-compat - description: Whether to use aeson-compat or aeson-extra - default: True - manual: False +license: BSD-3-Clause +license-file: LICENSE +author: Mike Burns, John Wiegley, Oleg Grenrus +maintainer: Andreas Abel +homepage: https://github.com/haskell-github/github +build-type: Simple +copyright: + Copyright 2012-2013 Mike Burns, Copyright 2013-2015 John Wiegley, Copyright 2016-2021 Oleg Grenrus +tested-with: + GHC == 9.14.1 + GHC == 9.12.2 + GHC == 9.10.3 + GHC == 9.8.4 + GHC == 9.6.7 + GHC == 9.4.8 + GHC == 9.2.8 + GHC == 9.0.2 + GHC == 8.10.7 + GHC == 8.8.4 + GHC == 8.6.5 + GHC == 8.4.4 + GHC == 8.2.2 + +extra-doc-files: + README.md + CHANGELOG.md + +extra-source-files: + fixtures/**/*.json + source-repository head - type: git - location: git://github.com/phadej/github.git + type: git + location: https://github.com/haskell-github/github.git -Library - default-language: Haskell2010 - ghc-options: -Wall - hs-source-dirs: src +flag openssl + description: "Use http-client-openssl" + manual: True + default: False + +library + default-language: Haskell2010 + ghc-options: + -Wall + -Wcompat + -Wno-star-is-type + -- The star-is-type warning cannot be sensiblity addressed while supporting GHC 7. + hs-source-dirs: src default-extensions: DataKinds DeriveDataTypeable DeriveGeneric + LambdaCase OverloadedStrings ScopedTypeVariables + TypeOperators + other-extensions: CPP FlexibleContexts FlexibleInstances GADTs KindSignatures + RecordWildCards StandaloneDeriving + exposed-modules: GitHub - GitHub.Internal.Prelude GitHub.Auth GitHub.Data + GitHub.Data.Actions.Common + GitHub.Data.Actions.Artifacts + GitHub.Data.Actions.Cache + GitHub.Data.Actions.Secrets + GitHub.Data.Actions.Workflows + GitHub.Data.Actions.WorkflowJobs + GitHub.Data.Actions.WorkflowRuns GitHub.Data.Activities GitHub.Data.Comments GitHub.Data.Content GitHub.Data.Definitions GitHub.Data.DeployKeys + GitHub.Data.Deployments GitHub.Data.Email + GitHub.Data.Enterprise + GitHub.Data.Enterprise.Organizations GitHub.Data.Events GitHub.Data.Gists GitHub.Data.GitData @@ -84,7 +115,10 @@ GitHub.Data.Milestone GitHub.Data.Name GitHub.Data.Options + GitHub.Data.PublicSSHKeys GitHub.Data.PullRequests + GitHub.Data.RateLimit + GitHub.Data.Reactions GitHub.Data.Releases GitHub.Data.Repos GitHub.Data.Request @@ -95,9 +129,17 @@ GitHub.Data.URL GitHub.Data.Webhooks GitHub.Data.Webhooks.Validate + GitHub.Endpoints.Actions.Artifacts + GitHub.Endpoints.Actions.Cache + GitHub.Endpoints.Actions.Secrets + GitHub.Endpoints.Actions.Workflows + GitHub.Endpoints.Actions.WorkflowJobs + GitHub.Endpoints.Actions.WorkflowRuns GitHub.Endpoints.Activity.Events + GitHub.Endpoints.Activity.Notifications GitHub.Endpoints.Activity.Starring GitHub.Endpoints.Activity.Watching + GitHub.Endpoints.Enterprise.Organizations GitHub.Endpoints.Gists GitHub.Endpoints.Gists.Comments GitHub.Endpoints.GitData.Blobs @@ -111,17 +153,22 @@ GitHub.Endpoints.Issues.Milestones GitHub.Endpoints.Organizations GitHub.Endpoints.Organizations.Members + GitHub.Endpoints.Organizations.OutsideCollaborators GitHub.Endpoints.Organizations.Teams GitHub.Endpoints.PullRequests - GitHub.Endpoints.PullRequests.Reviews GitHub.Endpoints.PullRequests.Comments + GitHub.Endpoints.PullRequests.Reviews + GitHub.Endpoints.RateLimit + GitHub.Endpoints.Reactions 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 @@ -129,81 +176,96 @@ GitHub.Endpoints.Users GitHub.Endpoints.Users.Emails GitHub.Endpoints.Users.Followers + GitHub.Endpoints.Users.PublicSSHKeys + GitHub.Enterprise + GitHub.Internal.Prelude GitHub.Request + other-modules: Paths_github + autogen-modules: Paths_github + -- Packages bundles with GHC, mtl and text are also here + -- Lower bounds at least those of https://www.stackage.org/lts-10.0 (GHC 8.2.2) build-depends: - base >=4.7 && <4.11, - bytestring >=0.10.4.0 && <0.11, - containers >=0.5.5.1 && <0.6, - 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 + base >=4.10 && <5 + , binary >=0.8.5.1 && <0.11 + , bytestring >=0.10.8.2 && <0.13 + , containers >=0.5.10.2 && <1 + , deepseq >=1.4.3.0 && <1.6 + , exceptions >=0.10.2 && <0.11 + , mtl >=2.2.1 && <2.4 + , text >=1.2.2.2 && <2.2 + , time >=1.8.0.2 && <2 + , transformers >=0.5.2.0 && <0.7 -- other packages build-depends: - aeson >=0.7.0.6 && <1.3, - base-compat >=0.9.1 && <0.10, - base16-bytestring >=0.1.1.6 && <0.2, - binary >=0.7.1.0 && <0.10, - binary-orphans >=0.1.0.0 && <0.2, - byteable >=0.1.1 && <0.2, - cryptohash >=0.11 && <0.12, - deepseq-generics >=0.1.1.2 && <0.3, - exceptions >=0.8.0.2 && <0.9, - hashable >=1.2.3.3 && <1.3, - http-client >=0.4.8.1 && <0.6, - http-client-tls >=0.2.2 && <0.4, - http-link-header >=1.0.1 && <1.1, - http-types >=0.12.1 && <0.13, - iso8601-time >=0.1.4 && <0.2, - network-uri >=2.6.0.3 && <2.7, - semigroups >=0.16.2.2 && <0.19, - transformers-compat >=0.4.0.3 && <0.6, - unordered-containers >=0.2 && <0.3, - vector >=0.10.12.3 && <0.13, - vector-instances >=3.3.0.1 && <3.5, + aeson >=1.4.0.0 && <1.6 || >=2.0.1.0 && <2.3 + , base-compat >=0.11.1 && <1 + , base16-bytestring >=0.1.1.6 && <1.1 + , binary-instances >=1 && <1.1 + , cryptohash-sha1 >=0.11.100.1 && <0.12 + , hashable >=1.2.7.0 && <2 + , http-client >=0.5.12 && <0.8 + , http-link-header >=1.0.3.1 && <1.3 + , 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 + , unordered-containers >=0.2.10.0 && <0.3 + , vector >=0.12.0.1 && <0.14 - tls >=1.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 - if flag(aeson-compat) - build-depends: aeson-compat >=0.3.0.0 && <0.4 else - build-depends: aeson-extra >=0.2.0.0 && <0.3 + build-depends: + http-client-tls >=0.3.5.3 && <0.5 + , tls >=1.4.1 test-suite github-test - default-language: Haskell2010 - type: exitcode-stdio-1.0 - hs-source-dirs: spec - other-extensions: - TemplateHaskell + 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.12 + other-extensions: TemplateHaskell other-modules: + GitHub.Actions.ArtifactsSpec + GitHub.Actions.CacheSpec + GitHub.Actions.SecretsSpec + GitHub.Actions.WorkflowJobSpec + GitHub.Actions.WorkflowRunsSpec + GitHub.Actions.WorkflowSpec GitHub.ActivitySpec GitHub.CommitsSpec - GitHub.OrganizationsSpec + GitHub.EventsSpec GitHub.IssuesSpec - GitHub.PullRequestsSpec + GitHub.OrganizationsSpec + GitHub.PublicSSHKeysSpec GitHub.PullRequestReviewsSpec + GitHub.PullRequestsSpec + GitHub.RateLimitSpec GitHub.ReleasesSpec GitHub.ReposSpec + GitHub.ReviewDecodeSpec GitHub.SearchSpec GitHub.UsersSpec - GitHub.EventsSpec - main-is: Spec.hs - ghc-options: -Wall - build-tool-depends: hspec-discover:hspec-discover - build-depends: base, - base-compat, - bytestring, - github, - vector, - unordered-containers, - file-embed, - hspec - if flag(aeson-compat) - build-depends: aeson-compat - else - build-depends: aeson-extra + build-depends: + aeson + , base + , base-compat + , bytestring + , file-embed + , github + , hspec >=2.6.1 && <2.12 + , http-client + , tagged + , text + , unordered-containers + , vector diff --git a/spec/GitHub/Actions/ArtifactsSpec.hs b/spec/GitHub/Actions/ArtifactsSpec.hs new file mode 100644 --- /dev/null +++ b/spec/GitHub/Actions/ArtifactsSpec.hs @@ -0,0 +1,66 @@ +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE TemplateHaskell #-} +module GitHub.Actions.ArtifactsSpec where + +import qualified GitHub as GH + +import Prelude () +import Prelude.Compat + +import Data.Aeson (eitherDecodeStrict) +import Data.ByteString (ByteString) +import Data.Either.Compat (isRight) +import Data.FileEmbed (embedFile) +import Data.Foldable (for_) +import Data.String (fromString) +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 "artifactsForR" $ do + it "works" $ withAuth $ \auth -> for_ repos $ \(owner, repo) -> do + cs <- GH.executeRequest auth $ + GH.artifactsForR owner repo mempty GH.FetchAll + cs `shouldSatisfy` isRight + + describe "decoding artifacts payloads" $ do + it "decodes artifacts list payload" $ do + GH.withTotalCountTotalCount artifactList `shouldBe` 23809 + V.length (GH.withTotalCountItems artifactList) `shouldBe` 2 + it "decodes signle artifact payload" $ do + GH.artifactName artifact `shouldBe` "dist-without-markdown" + GH.artifactWorkflowRunHeadSha (GH.artifactWorkflowRun artifact) `shouldBe` "601593ecb1d8a57a04700fdb445a28d4186b8954" + + where + repos = + [ ("thoughtbot", "paperclip") + , ("phadej", "github") + ] + + artifactList :: GH.WithTotalCount GH.Artifact + artifactList = + fromRightS (eitherDecodeStrict artifactsListPayload) + + artifact :: GH.Artifact + artifact = + fromRightS (eitherDecodeStrict artifactPayload) + + artifactsListPayload :: ByteString + artifactsListPayload = $(embedFile "fixtures/actions/artifacts-list.json") + + artifactPayload :: ByteString + artifactPayload = $(embedFile "fixtures/actions/artifact.json") diff --git a/spec/GitHub/Actions/CacheSpec.hs b/spec/GitHub/Actions/CacheSpec.hs new file mode 100644 --- /dev/null +++ b/spec/GitHub/Actions/CacheSpec.hs @@ -0,0 +1,53 @@ +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE TemplateHaskell #-} +module GitHub.Actions.CacheSpec where + +import qualified GitHub as GH + +import Prelude () +import Prelude.Compat + +import Data.Aeson (eitherDecodeStrict) +import Data.ByteString (ByteString) +import Data.FileEmbed (embedFile) +import qualified Data.Vector as V +import Test.Hspec (Spec, describe, it, shouldBe) + +fromRightS :: Show a => Either a b -> b +fromRightS (Right b) = b +fromRightS (Left a) = error $ "Expected a Right and got a Left" ++ show a + +spec :: Spec +spec = do + describe "decoding cache payloads" $ do + it "decodes cache list payload" $ do + V.length (GH.withTotalCountItems cacheList) `shouldBe` 1 + it "decodes cache usage for repo" $ do + GH.repositoryCacheUsageFullName repoCacheUsage `shouldBe` "python/cpython" + GH.repositoryCacheUsageActiveCachesSizeInBytes repoCacheUsage `shouldBe` 55000268087 + GH.repositoryCacheUsageActiveCachesCount repoCacheUsage `shouldBe` 171 + it "decodes cache usage for org" $ do + GH.organizationCacheUsageTotalActiveCachesSizeInBytes orgCacheUsage `shouldBe` 26586 + GH.organizationCacheUsageTotalActiveCachesCount orgCacheUsage `shouldBe` 1 + + where + cacheList :: GH.WithTotalCount GH.Cache + cacheList = + fromRightS (eitherDecodeStrict cacheListPayload) + + repoCacheUsage :: GH.RepositoryCacheUsage + repoCacheUsage = + fromRightS (eitherDecodeStrict repoCacheUsagePayload) + + orgCacheUsage :: GH.OrganizationCacheUsage + orgCacheUsage = + fromRightS (eitherDecodeStrict orgCacheUsagePayload) + + cacheListPayload :: ByteString + cacheListPayload = $(embedFile "fixtures/actions/cache-list.json") + + repoCacheUsagePayload :: ByteString + repoCacheUsagePayload = $(embedFile "fixtures/actions/repo-cache-usage.json") + + orgCacheUsagePayload :: ByteString + orgCacheUsagePayload = $(embedFile "fixtures/actions/org-cache-usage.json") diff --git a/spec/GitHub/Actions/SecretsSpec.hs b/spec/GitHub/Actions/SecretsSpec.hs new file mode 100644 --- /dev/null +++ b/spec/GitHub/Actions/SecretsSpec.hs @@ -0,0 +1,50 @@ +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE TemplateHaskell #-} +module GitHub.Actions.SecretsSpec where + +import qualified GitHub as GH + +import Prelude () +import Prelude.Compat + +import Data.Aeson (eitherDecodeStrict) +import Data.ByteString (ByteString) +import Data.FileEmbed (embedFile) +import qualified Data.Vector as V +import Test.Hspec (Spec, describe, it, shouldBe) + +fromRightS :: Show a => Either a b -> b +fromRightS (Right b) = b +fromRightS (Left a) = error $ "Expected a Right and got a Left" ++ show a + +spec :: Spec +spec = do + describe "decoding secrets payloads" $ do + it "decodes selected repo list payload" $ do + V.length (GH.withTotalCountItems repoList) `shouldBe` 1 + it "decodes secret list payload" $ do + V.length (GH.withTotalCountItems orgSecretList) `shouldBe` 2 + it "decodes public key payload" $ do + GH.publicKeyId orgPublicKey `shouldBe` "568250167242549743" + + where + repoList :: GH.WithTotalCount GH.SelectedRepo + repoList = + fromRightS (eitherDecodeStrict repoListPayload) + + orgSecretList:: GH.WithTotalCount GH.OrganizationSecret + orgSecretList= + fromRightS (eitherDecodeStrict orgSecretListPayload) + + orgPublicKey:: GH.PublicKey + orgPublicKey= + fromRightS (eitherDecodeStrict orgPublicKeyPayload) + + repoListPayload :: ByteString + repoListPayload = $(embedFile "fixtures/actions/selected-repositories-for-secret.json") + + orgSecretListPayload :: ByteString + orgSecretListPayload = $(embedFile "fixtures/actions/org-secrets-list.json") + + orgPublicKeyPayload :: ByteString + orgPublicKeyPayload = $(embedFile "fixtures/actions/org-public-key.json") diff --git a/spec/GitHub/Actions/WorkflowJobSpec.hs b/spec/GitHub/Actions/WorkflowJobSpec.hs new file mode 100644 --- /dev/null +++ b/spec/GitHub/Actions/WorkflowJobSpec.hs @@ -0,0 +1,32 @@ +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE TemplateHaskell #-} +module GitHub.Actions.WorkflowJobSpec where + +import qualified GitHub as GH +import GitHub.Data.Id + +import Prelude () +import Prelude.Compat + +import Data.Aeson (eitherDecodeStrict) +import Data.ByteString (ByteString) +import Data.FileEmbed (embedFile) +import Test.Hspec (Spec, describe, it, shouldBe) + +fromRightS :: Show a => Either a b -> b +fromRightS (Right b) = b +fromRightS (Left a) = error $ "Expected a Right and got a Left" ++ show a + +spec :: Spec +spec = do + describe "decoding workflow jobs payloads" $ do + it "decodes workflow job" $ do + GH.jobId workflowJob `shouldBe` Id 9183275828 + + where + workflowJob:: GH.Job + workflowJob= + fromRightS (eitherDecodeStrict workflowJobPayload) + + workflowJobPayload :: ByteString + workflowJobPayload = $(embedFile "fixtures/actions/workflow-job.json") diff --git a/spec/GitHub/Actions/WorkflowRunsSpec.hs b/spec/GitHub/Actions/WorkflowRunsSpec.hs new file mode 100644 --- /dev/null +++ b/spec/GitHub/Actions/WorkflowRunsSpec.hs @@ -0,0 +1,32 @@ +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE TemplateHaskell #-} +module GitHub.Actions.WorkflowRunsSpec where + +import qualified GitHub as GH + +import Prelude () +import Prelude.Compat + +import Data.Aeson (eitherDecodeStrict) +import Data.ByteString (ByteString) +import Data.FileEmbed (embedFile) +import qualified Data.Vector as V +import Test.Hspec (Spec, describe, it, shouldBe) + +fromRightS :: Show a => Either a b -> b +fromRightS (Right b) = b +fromRightS (Left a) = error $ "Expected a Right and got a Left" ++ show a + +spec :: Spec +spec = do + describe "decoding workflow runs payloads" $ do + it "decodes workflow runs list" $ do + V.length (GH.withTotalCountItems workflowRunsList) `shouldBe` 3 + + where + workflowRunsList:: GH.WithTotalCount GH.WorkflowRun + workflowRunsList = + fromRightS (eitherDecodeStrict workflowRunsPayload) + + workflowRunsPayload :: ByteString + workflowRunsPayload = $(embedFile "fixtures/actions/workflow-runs-list.json") diff --git a/spec/GitHub/Actions/WorkflowSpec.hs b/spec/GitHub/Actions/WorkflowSpec.hs new file mode 100644 --- /dev/null +++ b/spec/GitHub/Actions/WorkflowSpec.hs @@ -0,0 +1,32 @@ +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE TemplateHaskell #-} +module GitHub.Actions.WorkflowSpec where + +import qualified GitHub as GH + +import Prelude () +import Prelude.Compat + +import Data.Aeson (eitherDecodeStrict) +import Data.ByteString (ByteString) +import Data.FileEmbed (embedFile) +import qualified Data.Vector as V +import Test.Hspec (Spec, describe, it, shouldBe) + +fromRightS :: Show a => Either a b -> b +fromRightS (Right b) = b +fromRightS (Left a) = error $ "Expected a Right and got a Left" ++ show a + +spec :: Spec +spec = do + describe "decoding workflow payloads" $ do + it "decodes workflow list" $ do + V.length (GH.withTotalCountItems workflowList) `shouldBe` 1 + + where + workflowList:: GH.WithTotalCount GH.Workflow + workflowList = + fromRightS (eitherDecodeStrict workflowPayload) + + workflowPayload :: ByteString + workflowPayload = $(embedFile "fixtures/actions/workflow-list.json") diff --git a/spec/GitHub/ActivitySpec.hs b/spec/GitHub/ActivitySpec.hs --- a/spec/GitHub/ActivitySpec.hs +++ b/spec/GitHub/ActivitySpec.hs @@ -1,5 +1,4 @@ {-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE TemplateHaskell #-} module GitHub.ActivitySpec where import qualified GitHub @@ -31,7 +30,7 @@ spec = do describe "watchersForR" $ do it "works" $ withAuth $ \auth -> do - cs <- executeRequest auth $ watchersForR "phadej" "github" GitHub.FetchAll + cs <- executeRequest auth $ watchersForR "haskell-github" "github" GitHub.FetchAll cs `shouldSatisfy` isRight V.length (fromRightS cs) `shouldSatisfy` (> 10) describe "myStarredR" $ do diff --git a/spec/GitHub/CommitsSpec.hs b/spec/GitHub/CommitsSpec.hs --- a/spec/GitHub/CommitsSpec.hs +++ b/spec/GitHub/CommitsSpec.hs @@ -1,13 +1,9 @@ {-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE TemplateHaskell #-} module GitHub.CommitsSpec where -import qualified GitHub - import GitHub.Auth (Auth (..)) -import GitHub.Endpoints.Repos.Commits (Commit, commitSha, commitsFor', - commitsForR, diffR, mkCommitName) -import GitHub.Request (executeRequest) +import GitHub.Endpoints.Repos.Commits (commitSha, commitsForR, diffR, mkCommitName, FetchCount (..)) +import GitHub.Request (github) import Control.Monad (forM_) import Data.Either.Compat (isRight) @@ -34,13 +30,13 @@ spec = do describe "commitsFor" $ do it "works" $ withAuth $ \auth -> do - cs <- commitsFor' (Just auth) "phadej" "github" + cs <- github auth commitsForR "haskell-github" "github" FetchAll 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 <- github auth commitsForR "haskell-github" "github" (FetchAtLeast 40) cs `shouldSatisfy` isRight let cs' = fromRightS cs V.length cs' `shouldSatisfy` (< 70) @@ -49,14 +45,19 @@ describe "diff" $ do it "works" $ withAuth $ \auth -> do - cs <- executeRequest auth $ commitsForR "phadej" "github" (GitHub.FetchAtLeast 30) + cs <- github auth commitsForR "haskell-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 <- github auth diffR "haskell-github" "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 <- github 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 <- github auth diffR "scott-fleischman" "repo-remove-submodule" "d03c152482169d809be9b1eab71dcf64d7405f76" "42cfd732b20cd093534f246e630b309186eb485d" d `shouldSatisfy` isRight diff --git a/spec/GitHub/EventsSpec.hs b/spec/GitHub/EventsSpec.hs --- a/spec/GitHub/EventsSpec.hs +++ b/spec/GitHub/EventsSpec.hs @@ -27,9 +27,9 @@ spec = do describe "repositoryEventsR" $ do it "returns non empty list of events" $ shouldSucceed $ - GitHub.repositoryEventsR "phadej" "github" 1 + GitHub.repositoryEventsR "haskell-github" "github" 1 describe "userEventsR" $ do - it "returns non empty list of events" $ shouldSucceed $ GitHub.userEventsR "phadej" 1 + 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 diff --git a/spec/GitHub/IssuesSpec.hs b/spec/GitHub/IssuesSpec.hs --- a/spec/GitHub/IssuesSpec.hs +++ b/spec/GitHub/IssuesSpec.hs @@ -6,12 +6,14 @@ 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) +import Data.Either.Compat (isRight) +import Data.Foldable (for_) +import Data.String (fromString) +import Network.HTTP.Client (newManager, responseBody) +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 @@ -28,11 +30,41 @@ describe "issuesForRepoR" $ do it "works" $ withAuth $ \auth -> for_ repos $ \(owner, repo) -> do cs <- GitHub.executeRequest auth $ - GitHub.issuesForRepoR owner repo mempty GitHub.FetchAll - cs `shouldSatisfy` isRight + 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 + + describe "issuesForRepoR paged" $ do + it "works" $ withAuth $ \auth -> for_ repos $ \(owner, repo) -> do + mgr <- newManager GitHub.tlsManagerSettings + ret <- GitHub.executeRequestWithMgrAndRes mgr auth $ + GitHub.issuesForRepoR owner repo mempty (GitHub.FetchPage (GitHub.PageParams (Just 2) (Just 1))) + + case ret of + Left e -> + expectationFailure . show $ e + Right res -> do + let issues = responseBody res + length issues `shouldSatisfy` (<= 2) + + for_ issues $ \i -> do + cms <- GitHub.executeRequest auth $ + GitHub.commentsR owner repo (GitHub.issueNumber i) 1 + cms `shouldSatisfy` isRight + + describe "issueR" $ do + it "fetches issue #428" $ withAuth $ \auth -> do + resIss <- GitHub.executeRequest auth $ + GitHub.issueR "haskell-github" "github" (GitHub.IssueNumber 428) + resIss `shouldSatisfy` isRight where repos = [ ("thoughtbot", "paperclip") - , ("phadej", "github") - , ("haskell", "cabal") + , ("haskell-github", "github") ] diff --git a/spec/GitHub/OrganizationsSpec.hs b/spec/GitHub/OrganizationsSpec.hs --- a/spec/GitHub/OrganizationsSpec.hs +++ b/spec/GitHub/OrganizationsSpec.hs @@ -2,20 +2,20 @@ {-# LANGUAGE TemplateHaskell #-} module GitHub.OrganizationsSpec where +import GitHub (FetchCount (..), github) import GitHub.Auth (Auth (..)) -import GitHub.Data (SimpleOrganization (..), - SimpleOwner (..), - SimpleTeam (..)) -import GitHub.Endpoints.Organizations (publicOrganizationsFor') -import GitHub.Endpoints.Organizations.Members (membersOf') +import GitHub.Data + (SimpleOrganization (..), SimpleOwner (..), SimpleTeam (..)) +import GitHub.Endpoints.Organizations (publicOrganizationsForR) +import GitHub.Endpoints.Organizations.Members (membersOfR) -import Data.Aeson.Compat (eitherDecodeStrict) +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) +import Test.Hspec + (Spec, describe, it, pendingWith, shouldBe, shouldSatisfy) fromRightS :: Show a => Either a b -> b fromRightS (Right b) = b @@ -36,7 +36,7 @@ simpleOrganizationLogin (head $ fromRightS orgs) `shouldBe` "github" it "returns information about the user's organizations" $ withAuth $ \auth -> do - orgs <- publicOrganizationsFor' (Just auth) "mike-burns" + orgs <- github auth publicOrganizationsForR "mike-burns" FetchAll orgs `shouldSatisfy` isRight describe "teamsOf" $ do @@ -50,5 +50,5 @@ simpleOwnerLogin (head $ fromRightS ms) `shouldBe` "octocat" it "works" $ withAuth $ \auth -> do - ms <- membersOf' (Just auth) "haskell" + ms <- github auth membersOfR "haskell" FetchAll ms `shouldSatisfy` isRight diff --git a/spec/GitHub/PublicSSHKeysSpec.hs b/spec/GitHub/PublicSSHKeysSpec.hs new file mode 100644 --- /dev/null +++ b/spec/GitHub/PublicSSHKeysSpec.hs @@ -0,0 +1,40 @@ +{-# LANGUAGE OverloadedStrings #-} +module GitHub.PublicSSHKeysSpec where + +import GitHub + (Auth (..), FetchCount (..), PublicSSHKey (..),github) +import GitHub.Endpoints.Users.PublicSSHKeys + (publicSSHKeyR, publicSSHKeysR, 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 <- github auth publicSSHKeysForR "phadej" FetchAll + V.length (fromRightS keys) `shouldSatisfy` (> 1) + + describe "publicSSHKeys' and publicSSHKey'" $ do + it "works" $ withAuth $ \auth -> do + keys <- github auth publicSSHKeysR + V.length (fromRightS keys) `shouldSatisfy` (> 1) + + key <- github auth publicSSHKeyR (publicSSHKeyId $ V.head (fromRightS keys)) + key `shouldSatisfy` isRight diff --git a/spec/GitHub/PullRequestReviewsSpec.hs b/spec/GitHub/PullRequestReviewsSpec.hs --- a/spec/GitHub/PullRequestReviewsSpec.hs +++ b/spec/GitHub/PullRequestReviewsSpec.hs @@ -2,16 +2,16 @@ module GitHub.PullRequestReviewsSpec where import qualified GitHub -import GitHub.Data.Id (Id(Id)) +import GitHub.Data (IssueNumber (IssueNumber)) 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) +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 @@ -29,4 +29,4 @@ cs `shouldSatisfy` isRight where prs = - [("phadej", "github", Id 268)] + [("haskell-github", "github", IssueNumber 268)] diff --git a/spec/GitHub/PullRequestsSpec.hs b/spec/GitHub/PullRequestsSpec.hs --- a/spec/GitHub/PullRequestsSpec.hs +++ b/spec/GitHub/PullRequestsSpec.hs @@ -1,89 +1,164 @@ -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE TemplateHaskell #-} module GitHub.PullRequestsSpec where -import qualified GitHub -import GitHub.Data.Id (Id(Id)) +import qualified GitHub as GH import Prelude () import Prelude.Compat -import Data.Aeson.Compat (eitherDecodeStrict) -import Data.ByteString (ByteString) -import Data.Either.Compat (isRight) -import Data.FileEmbed (embedFile) -import Data.Foldable (for_) -import Data.String (fromString) -import qualified Data.Vector as V -import System.Environment (lookupEnv) -import Test.Hspec (Spec, describe, it, pendingWith, shouldBe, shouldSatisfy) +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 :: (GitHub.Auth -> IO ()) -> IO () +withAuth :: (GH.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) + Just token -> action (GH.OAuth $ fromString token) spec :: Spec spec = do describe "pullRequestsForR" $ do it "works" $ withAuth $ \auth -> for_ repos $ \(owner, repo) -> do - cs <- GitHub.executeRequest auth $ - GitHub.pullRequestsForR owner repo opts GitHub.FetchAll + 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 "haskell-github" "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 (GitHub.simplePullRequestRequestedReviewers simplePullRequestOpened) + V.length (GH.simplePullRequestRequestedReviewers simplePullRequestOpened) `shouldBe` 0 - V.length (GitHub.pullRequestRequestedReviewers pullRequestOpened) + V.length (GH.pullRequestRequestedReviewers pullRequestOpened) `shouldBe` 0 it "decodes a pull request 'review_requested' payload" $ do - V.length (GitHub.simplePullRequestRequestedReviewers simplePullRequestReviewRequested) + V.length (GH.simplePullRequestRequestedReviewers simplePullRequestReviewRequested) `shouldBe` 1 - V.length (GitHub.pullRequestRequestedReviewers pullRequestReviewRequested) + V.length (GH.pullRequestRequestedReviewers pullRequestReviewRequested) `shouldBe` 1 + it "decodes a pull request 'team_requested' payload" $ do + V.length (GH.simplePullRequestRequestedTeamReviewers simplePullRequestTeamReviewRequested) + `shouldBe` 1 + + V.length (GH.pullRequestRequestedTeamReviewers pullRequestTeamReviewRequested) + `shouldBe` 1 + describe "checking if a pull request is merged" $ do it "works" $ withAuth $ \auth -> do - b <- GitHub.executeRequest auth $ GitHub.isPullRequestMergedR "phadej" "github" (Id 14) + b <- GH.executeRequest auth $ GH.isPullRequestMergedR "haskell-github" "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 "haskell-github" "github" opts GH.FetchAll + + cs `shouldSatisfy` isRight + where repos = [ ("thoughtbot", "paperclip") - , ("phadej", "github") - , ("haskell", "cabal") + , ("haskell-github", "github") ] - opts = GitHub.stateClosed + opts = GH.stateClosed - simplePullRequestOpened :: GitHub.SimplePullRequest + simplePullRequestOpened :: GH.SimplePullRequest simplePullRequestOpened = fromRightS (eitherDecodeStrict prOpenedPayload) - pullRequestOpened :: GitHub.PullRequest + pullRequestOpened :: GH.PullRequest pullRequestOpened = fromRightS (eitherDecodeStrict prOpenedPayload) - simplePullRequestReviewRequested :: GitHub.SimplePullRequest + simplePullRequestReviewRequested :: GH.SimplePullRequest simplePullRequestReviewRequested = fromRightS (eitherDecodeStrict prReviewRequestedPayload) - pullRequestReviewRequested :: GitHub.PullRequest + simplePullRequestTeamReviewRequested :: GH.SimplePullRequest + simplePullRequestTeamReviewRequested = + fromRightS (eitherDecodeStrict prTeamReviewRequestedPayload) + + pullRequestReviewRequested :: GH.PullRequest pullRequestReviewRequested = fromRightS (eitherDecodeStrict prReviewRequestedPayload) + pullRequestTeamReviewRequested :: GH.PullRequest + pullRequestTeamReviewRequested = + fromRightS (eitherDecodeStrict prTeamReviewRequestedPayload) + prOpenedPayload :: ByteString prOpenedPayload = $(embedFile "fixtures/pull-request-opened.json") prReviewRequestedPayload :: ByteString prReviewRequestedPayload = $(embedFile "fixtures/pull-request-review-requested.json") + + prTeamReviewRequestedPayload :: ByteString + prTeamReviewRequestedPayload = $(embedFile "fixtures/pull-request-team-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) diff --git a/spec/GitHub/RateLimitSpec.hs b/spec/GitHub/RateLimitSpec.hs new file mode 100644 --- /dev/null +++ b/spec/GitHub/RateLimitSpec.hs @@ -0,0 +1,29 @@ +{-# 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 diff --git a/spec/GitHub/ReleasesSpec.hs b/spec/GitHub/ReleasesSpec.hs --- a/spec/GitHub/ReleasesSpec.hs +++ b/spec/GitHub/ReleasesSpec.hs @@ -1,5 +1,4 @@ {-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE TemplateHaskell #-} module GitHub.ReleasesSpec where import qualified GitHub diff --git a/spec/GitHub/ReposSpec.hs b/spec/GitHub/ReposSpec.hs --- a/spec/GitHub/ReposSpec.hs +++ b/spec/GitHub/ReposSpec.hs @@ -1,16 +1,22 @@ +{-# LANGUAGE CPP #-} {-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE TemplateHaskell #-} + +#if __GLASGOW_HASKELL__ >= 900 +{-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-} +#endif + module GitHub.ReposSpec where -import GitHub (Auth (..), Repo (..), RepoPublicity (..), - executeRequest, repositoryR) -import GitHub.Endpoints.Repos (currentUserRepos, languagesFor', userRepos') +import GitHub + (Auth (..), FetchCount (..), Repo (..), RepoPublicity (..), github, + repositoryR) +import GitHub.Endpoints.Repos (currentUserReposR, languagesForR, userReposR) import Data.Either.Compat (isRight) import Data.String (fromString) import System.Environment (lookupEnv) -import Test.Hspec (Spec, describe, it, pendingWith, shouldBe, - shouldSatisfy) +import Test.Hspec + (Spec, describe, it, pendingWith, shouldBe, shouldSatisfy) import qualified Data.HashMap.Strict as HM @@ -29,24 +35,24 @@ spec = do describe "repositoryR" $ do it "works" $ withAuth $ \auth -> do - er <- executeRequest auth $ repositoryR "phadej" "github" + er <- github auth repositoryR "haskell-github" "github" er `shouldSatisfy` isRight let Right r = er - -- https://github.com/phadej/github/pull/219 + -- https://github.com/haskell-github/github/pull/219 repoDefaultBranch r `shouldBe` Just "master" describe "currentUserRepos" $ do it "works" $ withAuth $ \auth -> do - cs <- currentUserRepos auth RepoPublicityAll + cs <- github auth currentUserReposR RepoPublicityAll FetchAll cs `shouldSatisfy` isRight describe "userRepos" $ do it "works" $ withAuth $ \auth -> do - cs <- userRepos' (Just auth) "phadej" RepoPublicityAll + cs <- github auth userReposR "phadej" RepoPublicityAll FetchAll cs `shouldSatisfy` isRight describe "languagesFor'" $ do it "works" $ withAuth $ \auth -> do - ls <- languagesFor' (Just auth) "phadej" "github" + ls <- github auth languagesForR "haskell-github" "github" ls `shouldSatisfy` isRight fromRightS ls `shouldSatisfy` HM.member "Haskell" diff --git a/spec/GitHub/ReviewDecodeSpec.hs b/spec/GitHub/ReviewDecodeSpec.hs new file mode 100644 --- /dev/null +++ b/spec/GitHub/ReviewDecodeSpec.hs @@ -0,0 +1,25 @@ +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE TemplateHaskell #-} +module GitHub.ReviewDecodeSpec where + +import Data.Aeson (eitherDecodeStrict) +import Data.Either.Compat (isRight) +import Data.FileEmbed (embedFile) +import Test.Hspec + (Spec, describe, it, shouldSatisfy) + +import GitHub.Data (Review) + +spec :: Spec +spec = do + describe "PENDING state" $ do + -- https://docs.github.com/en/rest/reference/pulls#create-a-review-for-a-pull-request + -- > Pull request reviews created in the PENDING state do not include the submitted_at property in the response. + it "decodes review when submitted_at is missing" $ do + let reviewInfo = eitherDecodeStrict $(embedFile "fixtures/pull-request-pending-review.json") :: Either String Review + reviewInfo `shouldSatisfy` isRight + + describe "Other states" $ do + it "decodes review" $ do + let reviewInfo = eitherDecodeStrict $(embedFile "fixtures/pull-request-approved-review.json") :: Either String Review + reviewInfo `shouldSatisfy` isRight diff --git a/spec/GitHub/SearchSpec.hs b/spec/GitHub/SearchSpec.hs --- a/spec/GitHub/SearchSpec.hs +++ b/spec/GitHub/SearchSpec.hs @@ -2,10 +2,10 @@ {-# LANGUAGE TemplateHaskell #-} module GitHub.SearchSpec where -import Prelude () +import Prelude () import Prelude.Compat -import Data.Aeson.Compat (eitherDecodeStrict) +import Data.Aeson (eitherDecodeStrict) import Data.FileEmbed (embedFile) import Data.Proxy (Proxy (..)) import Data.String (fromString) @@ -14,8 +14,11 @@ import qualified Data.Vector as V -import GitHub.Data (Auth (..), Issue (..), mkId, IssueState (..)) -import GitHub.Endpoints.Search (SearchResult (..), searchIssues') +import GitHub (github) +import GitHub.Data + (Auth (..), Issue (..), IssueNumber (..), IssueState (..), + SimpleUser (..), User, mkId) +import GitHub.Endpoints.Search (SearchResult' (..), SearchResult, searchIssuesR, searchUsersR) fromRightS :: Show a => Either a b -> b fromRightS (Right b) = b @@ -40,18 +43,25 @@ let issue1 = issues V.! 0 issueId issue1 `shouldBe` mkId (Proxy :: Proxy Issue) 123898390 - issueNumber issue1 `shouldBe` 130 + 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` 127 + 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 + let query = "Decouple in:title repo:haskell-github/github created:<=2015-12-01" + issues <- fmap (searchResultResults . fromRightS) <$> github auth $ searchIssuesR query 5 length issues `shouldBe` 1 issueId (V.head issues) `shouldBe` mkId (Proxy :: Proxy Issue) 119694665 + + describe "searchUsers" $ + it "performs a user search via the API" $ withAuth $ \auth -> do + let query = "oleg.grenrus@iki.fi created:<2020-01-01" + users <- fmap (searchResultResults . fromRightS) <$> github auth $ searchUsersR query 5 + length users `shouldBe` 1 + simpleUserId (V.head users) `shouldBe` mkId (Proxy :: Proxy User) 51087 diff --git a/spec/GitHub/UsersSpec.hs b/spec/GitHub/UsersSpec.hs --- a/spec/GitHub/UsersSpec.hs +++ b/spec/GitHub/UsersSpec.hs @@ -2,22 +2,22 @@ {-# LANGUAGE TemplateHaskell #-} module GitHub.UsersSpec where -import Data.Aeson.Compat (eitherDecodeStrict) +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 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.Data + (Auth (..), Organization (..), User (..), fromOwner) +import GitHub.Endpoints.Users + (ownerInfoForR, userInfoCurrentR, userInfoForR) import GitHub.Endpoints.Users.Followers (usersFollowedByR, usersFollowingR) -import GitHub.Request (executeRequest) +import GitHub.Request (github) fromRightS :: Show a => Either a b -> b fromRightS (Right b) = b @@ -41,38 +41,42 @@ 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" + userInfo <- github auth userInfoForR "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 <- github auth userInfoForR "i-hope-this-user-will-never-exist" userInfo `shouldSatisfy` isLeft it "should fail for organization" $ withAuth $ \auth -> do - userInfo <- userInfoFor' (Just auth) "haskell" + userInfo <- github auth userInfoForR "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 <- github auth ownerInfoForR "haskell" + b <- github 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 + describe "userInfoCurrentR" $ do + it "returns information about the authenticated user" $ withAuth $ \auth -> do + userInfo <- github auth userInfoCurrentR userInfo `shouldSatisfy` isRight describe "usersFollowing" $ do it "works" $ withAuth $ \auth -> do - us <- executeRequest auth $ usersFollowingR "phadej" (GitHub.FetchAtLeast 10) + us <- github 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 <- github auth usersFollowedByR "phadej" (GitHub.FetchAtLeast 10) us `shouldSatisfy` isRight diff --git a/src/GitHub.hs b/src/GitHub.hs --- a/src/GitHub.hs +++ b/src/GitHub.hs @@ -1,24 +1,33 @@ ------------------------------------------------------------------------------ -- | --- License : BSD-3-Clause --- Maintainer : Oleg Grenrus --- --- This module re-exports all request constructrors and data definitions from +-- This module re-exports all request constructors and data definitions from -- this package. -- --- See "GitHub.Request" module for executing 'Request', or other modules --- of this package (e.g. "GitHub.Users") for already composed versions. +-- See "GitHub.Request" module for executing 'Request', in short +-- use @'github' request@, for example -- +-- @ +-- 'github' 'userInfoForR' +-- :: 'AuthMethod' am => am -> 'Name' 'User' -> IO (Either 'Error' 'User') +-- @ +-- -- The missing endpoints lists show which endpoints we know are missing, there -- might be more. + module GitHub ( -- * Activity -- | See -- ** Events - -- | See https://developer.github.com/v3/activity/events/#events + -- | See repositoryEventsR, userEventsR, + + -- ** Notifications + -- | See + getNotificationsR, + markNotificationAsReadR, + markAllNotificationsAsReadR, + -- ** Starring -- | See -- @@ -39,9 +48,9 @@ -- -- * Query a Repository Subscription -- * Set a Repository Subscription - -- * Delete a Repository Subscription watchersForR, reposWatchedByR, + unwatchRepoR, -- * Gists -- | See @@ -49,7 +58,6 @@ -- Missing endpoints: -- -- * Query a specific revision of a gist - -- * Create a gist -- * Edit a gist -- * List gist commits -- * Check if a gist is starred @@ -57,6 +65,7 @@ -- * List gist forks gistsR, gistR, + createGistR, starGistR, unstarGistR, deleteGistR, @@ -87,6 +96,8 @@ referenceR, referencesR, createReferenceR, + deleteReferenceR, + namespacedReferencesR, -- ** Trees -- | See @@ -137,13 +148,11 @@ -- ** Milestone -- | See -- - -- Missing endpoints: - -- - -- * Create a milestone - -- * Update a milestone - -- * Delete a milestone milestonesR, milestoneR, + createMilestoneR, + updateMilestoneR, + deleteMilestoneR, -- * Organizations -- | See @@ -155,6 +164,7 @@ -- * Edit an organization publicOrganizationsForR, publicOrganizationR, + organizationsR, -- ** Members -- | See -- @@ -163,6 +173,12 @@ membersOfWithR, isMemberOfR, orgInvitationsR, + orgMembershipR, + -- ** Outside Collaborators + -- | See + -- + -- Missing endpoints: All except /Outside Collaborator List/ + outsideCollaboratorsR, -- ** Teams -- | See @@ -191,6 +207,8 @@ -- | See pullRequestsForR, pullRequestR, + pullRequestPatchR, + pullRequestDiffR, createPullRequestR, updatePullRequestR, pullRequestCommitsR, @@ -204,11 +222,12 @@ -- Missing endpoints: -- -- * List comments in a repository - -- * Create a comment -- * Edit a comment -- * Delete a comment pullRequestCommentsR, pullRequestCommentR, + createPullCommentR, + createPullCommentReplyR, -- ** Pull request reviews -- | See @@ -220,14 +239,8 @@ -- * Submit a pull request review -- * Dismiss a pull request review pullRequestReviewsR, - pullRequestReviews, - pullRequestReviews', pullRequestReviewR, - pullRequestReview, - pullRequestReview', pullRequestReviewCommentsR, - pullRequestReviewCommentsIO, - pullRequestReviewCommentsIO', -- * Repositories -- | See @@ -250,7 +263,9 @@ -- ** Collaborators -- | See collaboratorsOnR, + collaboratorPermissionOnR, isCollaboratorOnR, + addCollaboratorR, -- ** Comments -- | See @@ -259,7 +274,7 @@ -- -- * Create a commit comment -- * Update a commit comment - -- * Delete a commit comment + -- * Delete a commit comment commentsForR, commitCommentsForR, commitCommentForR, @@ -271,6 +286,43 @@ commitR, diffR, + -- ** Reactions + -- | See + issueReactionsR, + createIssueReactionR, + deleteIssueReactionR, + commentReactionsR, + createCommentReactionR, + deleteCommentReactionR, + + -- ** Contents + -- | See + contentsForR, + readmeForR, + archiveForR, + createFileR, + updateFileR, + deleteFileR, + + -- ** Deploy Keys + -- | See + deployKeysForR, + deployKeyForR, + createRepoDeployKeyR, + deleteRepoDeployKeyR, + + -- ** Deployments + -- | See + -- + -- Missing endpoints: + -- * Get a single deployment + -- * Update a deployment + -- * Get a single deployment status + deploymentsWithOptionsForR, + createDeploymentR, + deploymentStatusesForR, + createDeploymentStatusR, + -- ** Forks -- | See -- @@ -279,6 +331,12 @@ -- * Create a fork forksForR, + -- ** Statuses + -- | See + createStatusR, + statusesForR, + statusForR, + -- ** Webhooks -- | See webhooksForR, @@ -295,15 +353,25 @@ 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, + searchUsersR, -- * Users -- | See @@ -339,12 +407,88 @@ usersFollowingR, usersFollowedByR, - -- ** Statuses - -- | See - createStatusR, - statusesForR, - statusForR, + -- ** Git SSH Keys + -- | See + publicSSHKeysR, + publicSSHKeysForR, + publicSSHKeyR, + createUserPublicSSHKeyR, + deleteUserPublicSSHKeyR, + -- ** Rate Limit + -- | See + rateLimitR, + + -- ** Actions - artifacts + -- | See + artifactsForR, + artifactR, + deleteArtifactR, + downloadArtifactR, + artifactsForWorkflowRunR, + + -- ** Actions - cache + -- | See + cacheUsageOrganizationR, + cacheUsageByRepositoryR, + cacheUsageR, + cachesForRepoR, + deleteCacheR, + + -- ** Actions - secrets + -- | See + organizationSecretsR, + organizationPublicKeyR, + organizationSecretR, + setOrganizationSecretR, + deleteOrganizationSecretR, + organizationSelectedRepositoriesForSecretR, + setOrganizationSelectedRepositoriesForSecretR, + addOrganizationSelectedRepositoriesForSecretR, + removeOrganizationSelectedRepositoriesForSecretR, + repoSecretsR, + repoPublicKeyR, + repoSecretR, + setRepoSecretR, + deleteRepoSecretR, + environmentSecretsR, + environmentPublicKeyR, + environmentSecretR, + setEnvironmentSecretR, + deleteEnvironmentSecretR, + + -- ** Actions - workflow jobs + -- | See + jobR, + downloadJobLogsR, + jobsForWorkflowRunAttemptR, + jobsForWorkflowRunR, + + -- ** Actions - workflow runs + -- | See + reRunJobR, + workflowRunsR, + workflowRunR, + deleteWorkflowRunR, + workflowRunReviewHistoryR, + approveWorkflowRunR, + workflowRunAttemptR, + downloadWorkflowRunAttemptLogsR, + cancelWorkflowRunR, + downloadWorkflowRunLogsR, + deleteWorkflowRunLogsR, + reRunWorkflowR, + reRunFailedJobsR, + workflowRunsForWorkflowR, + + -- ** Actions - workflows + -- | See + repositoryWorkflowsR, + workflowR, + disableWorkflowR, + triggerWorkflowR, + enableWorkflowR, + -- * Data definitions module GitHub.Data, -- * Request handling @@ -352,7 +496,14 @@ ) where import GitHub.Data +import GitHub.Endpoints.Actions.Artifacts +import GitHub.Endpoints.Actions.Cache +import GitHub.Endpoints.Actions.Secrets +import GitHub.Endpoints.Actions.WorkflowJobs +import GitHub.Endpoints.Actions.WorkflowRuns +import GitHub.Endpoints.Actions.Workflows import GitHub.Endpoints.Activity.Events +import GitHub.Endpoints.Activity.Notifications import GitHub.Endpoints.Activity.Starring import GitHub.Endpoints.Activity.Watching import GitHub.Endpoints.Gists @@ -368,15 +519,22 @@ import GitHub.Endpoints.Issues.Milestones import GitHub.Endpoints.Organizations import GitHub.Endpoints.Organizations.Members +import GitHub.Endpoints.Organizations.OutsideCollaborators import GitHub.Endpoints.Organizations.Teams import GitHub.Endpoints.PullRequests -import GitHub.Endpoints.PullRequests.Reviews import GitHub.Endpoints.PullRequests.Comments +import GitHub.Endpoints.PullRequests.Reviews +import GitHub.Endpoints.Reactions +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.Contents +import GitHub.Endpoints.Repos.DeployKeys +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 @@ -384,4 +542,5 @@ import GitHub.Endpoints.Users import GitHub.Endpoints.Users.Emails import GitHub.Endpoints.Users.Followers +import GitHub.Endpoints.Users.PublicSSHKeys import GitHub.Request diff --git a/src/GitHub/Auth.hs b/src/GitHub/Auth.hs --- a/src/GitHub/Auth.hs +++ b/src/GitHub/Auth.hs @@ -1,26 +1,58 @@ ------------------------------------------------------------------------------ --- | --- License : BSD-3-Clause --- Maintainer : Oleg Grenrus --- -module GitHub.Auth where +module GitHub.Auth ( + Auth (..), + Token, + JWTToken, + AuthMethod, + endpoint, + setAuthRequest + ) where import GitHub.Internal.Prelude import Prelude () -import qualified Data.ByteString as BS +import qualified Data.ByteString as BS +import qualified Data.Text.Encoding as TE +import qualified Network.HTTP.Client as HTTP type Token = BS.ByteString +type JWTToken = Text -- | The Github auth data type data Auth - = BasicAuth BS.ByteString BS.ByteString - | OAuth Token -- ^ token - | EnterpriseOAuth Text -- custom API endpoint without - -- trailing slash - Token -- token - deriving (Show, Data, Typeable, Eq, Ord, Generic) + = BasicAuth BS.ByteString BS.ByteString -- ^ Username and password + | OAuth Token -- ^ OAuth token + | JWT JWTToken -- ^ JWT Token + | EnterpriseOAuth Text Token -- ^ Custom endpoint and OAuth token + deriving (Show, Data, Eq, Ord, Generic) -instance NFData Auth where rnf = genericRnf +instance NFData Auth instance Binary Auth instance Hashable Auth + +-- | A type class for different authentication methods +-- +-- Note the '()' intance, which doee nothing, i.e. is unauthenticated. +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 () where + endpoint _ = Nothing + setAuthRequest _ = id + +instance AuthMethod Auth where + endpoint (BasicAuth _ _) = Nothing + endpoint (OAuth _) = Nothing + endpoint (JWT _) = Nothing + endpoint (EnterpriseOAuth e _) = Just e + + setAuthRequest (BasicAuth u p) = HTTP.applyBasicAuth u p + setAuthRequest (OAuth t) = setAuthHeader $ "token " <> t + setAuthRequest (JWT t) = setAuthHeader $ "Bearer " <> TE.encodeUtf8 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 } diff --git a/src/GitHub/Data.hs b/src/GitHub/Data.hs --- a/src/GitHub/Data.hs +++ b/src/GitHub/Data.hs @@ -1,10 +1,6 @@ -{-# LANGUAGE CPP #-} ------------------------------------------------------------------------------ -- | --- License : BSD-3-Clause --- Maintainer : Oleg Grenrus --- --- This module re-exports the @GitHub.Data.@ and "Github.Auth" submodules. +-- This module re-exports the @GitHub.Data.@ and "GitHub.Auth" submodules. + module GitHub.Data ( -- * Tagged types -- ** Name @@ -30,13 +26,23 @@ mkRepoId, fromUserId, fromOrganizationId, + -- * IssueNumber + IssueNumber (..), -- * Module re-exports module GitHub.Auth, + module GitHub.Data.Actions.Common, + module GitHub.Data.Actions.Artifacts, + module GitHub.Data.Actions.Cache, + module GitHub.Data.Actions.Secrets, + module GitHub.Data.Actions.Workflows, + module GitHub.Data.Actions.WorkflowJobs, + module GitHub.Data.Actions.WorkflowRuns, 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, @@ -45,8 +51,11 @@ 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.Reactions, module GitHub.Data.Repos, module GitHub.Data.Request, module GitHub.Data.Reviews, @@ -54,18 +63,27 @@ module GitHub.Data.Statuses, module GitHub.Data.Teams, module GitHub.Data.URL, - module GitHub.Data.Webhooks + module GitHub.Data.Webhooks, + module GitHub.Data.Webhooks.Validate, ) where import GitHub.Internal.Prelude import Prelude () import GitHub.Auth +import GitHub.Data.Actions.Common +import GitHub.Data.Actions.Artifacts +import GitHub.Data.Actions.Secrets +import GitHub.Data.Actions.Cache +import GitHub.Data.Actions.Workflows +import GitHub.Data.Actions.WorkflowJobs +import GitHub.Data.Actions.WorkflowRuns 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 @@ -76,8 +94,11 @@ 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.Reactions import GitHub.Data.Repos import GitHub.Data.Request import GitHub.Data.Reviews @@ -86,6 +107,7 @@ import GitHub.Data.Teams import GitHub.Data.URL import GitHub.Data.Webhooks +import GitHub.Data.Webhooks.Validate mkOwnerId :: Int -> Id Owner mkOwnerId = Id diff --git a/src/GitHub/Data/Actions/Artifacts.hs b/src/GitHub/Data/Actions/Artifacts.hs new file mode 100644 --- /dev/null +++ b/src/GitHub/Data/Actions/Artifacts.hs @@ -0,0 +1,76 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE KindSignatures #-} + +module GitHub.Data.Actions.Artifacts ( + Artifact(..), + ArtifactWorkflowRun(..), + ) where + +import GitHub.Data.Id (Id) +import GitHub.Data.URL (URL) +import GitHub.Internal.Prelude +import Prelude () + +import GitHub.Data.Actions.Common (WithTotalCount (WithTotalCount)) +import GitHub.Data.Actions.WorkflowRuns (WorkflowRun) +import GitHub.Data.Repos (Repo) + +------------------------------------------------------------------------------- +-- Artifact +------------------------------------------------------------------------------- + +data ArtifactWorkflowRun = ArtifactWorkflowRun + { artifactWorkflowRunWorkflowRunId :: !(Id WorkflowRun) + , artifactWorkflowRunRepositoryId :: !(Id Repo) + , artifactWorkflowRunHeadRepositoryId :: !(Id Repo) + , artifactWorkflowRunHeadBranch :: !Text + , artifactWorkflowRunHeadSha :: !Text + } + deriving (Show, Data, Eq, Ord, Generic) + +data Artifact = Artifact + { artifactArchiveDownloadUrl :: !URL + , artifactCreatedAt :: !UTCTime + , artifactExpired :: !Bool + , artifactExpiresAt :: !UTCTime + , artifactId :: !(Id Artifact) + , artifactName :: !Text + , artifactNodeId :: !Text + , artifactSizeInBytes :: !Int + , artifactUpdatedAt :: !UTCTime + , artifactUrl :: !URL + , artifactWorkflowRun :: !ArtifactWorkflowRun + } + deriving (Show, Data, Eq, Ord, Generic) + +------------------------------------------------------------------------------- +-- JSON instances +------------------------------------------------------------------------------- + +instance FromJSON ArtifactWorkflowRun where + parseJSON = withObject "ArtifactWorkflowRun" $ \o -> ArtifactWorkflowRun + <$> o .: "id" + <*> o .: "repository_id" + <*> o .: "head_repository_id" + <*> o .: "head_branch" + <*> o .: "head_sha" + +instance FromJSON Artifact where + parseJSON = withObject "Artifact" $ \o -> Artifact + <$> o .: "archive_download_url" + <*> o .: "created_at" + <*> o .: "expired" + <*> o .: "expires_at" + <*> o .: "id" + <*> o .: "name" + <*> o .: "node_id" + <*> o .: "size_in_bytes" + <*> o .: "updated_at" + <*> o .: "url" + <*> o .: "workflow_run" + +instance FromJSON (WithTotalCount Artifact) where + parseJSON = withObject "ArtifactList" $ \o -> WithTotalCount + <$> o .: "artifacts" + <*> o .: "total_count" diff --git a/src/GitHub/Data/Actions/Cache.hs b/src/GitHub/Data/Actions/Cache.hs new file mode 100644 --- /dev/null +++ b/src/GitHub/Data/Actions/Cache.hs @@ -0,0 +1,78 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE KindSignatures #-} + +module GitHub.Data.Actions.Cache ( + Cache(..), + RepositoryCacheUsage(..), + OrganizationCacheUsage(..) + ) where + +import GitHub.Data.Id (Id) +import GitHub.Internal.Prelude +import Prelude () + +import GitHub.Data.Actions.Common (WithTotalCount (WithTotalCount)) + +------------------------------------------------------------------------------- +-- Cache +------------------------------------------------------------------------------- + +data Cache = Cache + { cacheId :: !(Id Cache) + , cacheRef :: !Text + , cacheKey :: !Text + , cacheVersion :: !Text + , cacheLastAccessedAt :: !UTCTime + , cacheCreatedAt :: !UTCTime + , cacheSizeInBytes :: !Int + } + deriving (Show, Data, Eq, Ord, Generic) + +data RepositoryCacheUsage = RepositoryCacheUsage + { repositoryCacheUsageFullName :: !Text + , repositoryCacheUsageActiveCachesSizeInBytes :: !Int + , repositoryCacheUsageActiveCachesCount :: !Int + } + deriving (Show, Data, Eq, Ord, Generic) + +data OrganizationCacheUsage = OrganizationCacheUsage + { organizationCacheUsageTotalActiveCachesSizeInBytes :: !Int + , organizationCacheUsageTotalActiveCachesCount :: !Int + } + deriving (Show, Data, Eq, Ord, Generic) + +------------------------------------------------------------------------------- +-- JSON instances +------------------------------------------------------------------------------- + +instance FromJSON Cache where + parseJSON = withObject "Cache" $ \o -> Cache + <$> o .: "id" + <*> o .: "ref" + <*> o .: "key" + <*> o .: "version" + <*> o .: "last_accessed_at" + <*> o .: "created_at" + <*> o .: "size_in_bytes" + +instance FromJSON (WithTotalCount Cache) where + parseJSON = withObject "CacheList" $ \o -> WithTotalCount + <$> o .: "actions_caches" + <*> o .: "total_count" + +instance FromJSON OrganizationCacheUsage where + parseJSON = withObject "OrganizationCacheUsage" $ \o -> OrganizationCacheUsage + <$> o .: "total_active_caches_size_in_bytes" + <*> o .: "total_active_caches_count" + +instance FromJSON RepositoryCacheUsage where + parseJSON = withObject "RepositoryCacheUsage" $ \o -> RepositoryCacheUsage + <$> o .: "full_name" + <*> o .: "active_caches_size_in_bytes" + <*> o .: "active_caches_count" + +instance FromJSON (WithTotalCount RepositoryCacheUsage) where + parseJSON = withObject "CacheUsageList" $ \o -> WithTotalCount + <$> o .: "repository_cache_usages" + <*> o .: "total_count" diff --git a/src/GitHub/Data/Actions/Common.hs b/src/GitHub/Data/Actions/Common.hs new file mode 100644 --- /dev/null +++ b/src/GitHub/Data/Actions/Common.hs @@ -0,0 +1,33 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE KindSignatures #-} + +module GitHub.Data.Actions.Common ( + WithTotalCount(..), + ) where + +import GitHub.Internal.Prelude +import Prelude () + +------------------------------------------------------------------------------- +-- Common +------------------------------------------------------------------------------- + +-- | A page of a paginated response. +data WithTotalCount a = WithTotalCount + { withTotalCountItems :: !(Vector a) + -- ^ A snippet of the answer. + , withTotalCountTotalCount :: !Int + -- ^ The total size of the answer. + } + deriving (Show, Data, Eq, Ord, Generic) + +-- | Joining two pages of a paginated response. +-- The 'withTotalCountTotalCount' is assumed to be the same in both pages, +-- but this is not checked. +instance Semigroup (WithTotalCount a) where + WithTotalCount items1 count1 <> WithTotalCount items2 _ = + WithTotalCount (items1 <> items2) count1 + +instance Foldable WithTotalCount where + foldMap f (WithTotalCount items _) = foldMap f items diff --git a/src/GitHub/Data/Actions/Secrets.hs b/src/GitHub/Data/Actions/Secrets.hs new file mode 100644 --- /dev/null +++ b/src/GitHub/Data/Actions/Secrets.hs @@ -0,0 +1,141 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE KindSignatures #-} +{-# LANGUAGE RecordWildCards #-} + +module GitHub.Data.Actions.Secrets ( + OrganizationSecret(..), + PublicKey(..), + SetSecret(..), + SetRepoSecret(..), + SelectedRepo(..), + SetSelectedRepositories(..), + RepoSecret(..), + Environment(..), + ) where + +import GitHub.Data.Id (Id) +import GitHub.Internal.Prelude +import Prelude () + +import Data.Maybe (maybeToList) +import GitHub.Data.Actions.Common (WithTotalCount (WithTotalCount)) +import GitHub.Data.Name (Name) +import GitHub.Data.Repos (Repo) + +------------------------------------------------------------------------------- +-- Secret +------------------------------------------------------------------------------- + +data OrganizationSecret = OrganizationSecret + { organizationSecretName :: !(Name OrganizationSecret) + , organizationSecretCreatedAt :: !UTCTime + , organizationSecretUpdatedAt :: !UTCTime + , organizationSecretVisibility :: !Text + } + deriving (Show, Data, Eq, Ord, Generic) + +data PublicKey = PublicKey + { publicKeyId :: !Text + , publicKeyKey :: !Text + } + deriving (Show, Data, Eq, Ord, Generic) + +data SetSecret = SetSecret + { setSecretPublicKeyId :: !Text + , setSecretEncryptedValue :: !Text + , setSecretVisibility :: !Text + , setSecretSelectedRepositoryIds :: !(Maybe [Id Repo]) + } + deriving (Show, Data, Eq, Ord, Generic) + +data SetRepoSecret = SetRepoSecret + { setRepoSecretPublicKeyId :: !Text + , setRepoSecretEncryptedValue :: !Text + } + deriving (Show, Data, Eq, Ord, Generic) + +data SelectedRepo = SelectedRepo + { selectedRepoRepoId :: !(Id Repo) + , selectedRepoRepoName :: !(Name Repo) + } + deriving (Show, Data, Eq, Ord, Generic) + +data SetSelectedRepositories = SetSelectedRepositories + { setSelectedRepositoriesRepositoryIds :: ![Id Repo] + } + deriving (Show, Data, Eq, Ord, Generic) + +data RepoSecret = RepoSecret + { repoSecretName :: !(Name RepoSecret) + , repoSecretCreatedAt :: !UTCTime + , repoSecretUpdatedAt :: !UTCTime + } + deriving (Show, Data, Eq, Ord, Generic) + +-- TODO move somewhere else? +data Environment = Environment + deriving (Show, Data, Eq, Ord, Generic) + +------------------------------------------------------------------------------- +-- JSON instances +------------------------------------------------------------------------------- + +instance FromJSON OrganizationSecret where + parseJSON = withObject "Secret" $ \o -> OrganizationSecret + <$> o .: "name" + <*> o .: "created_at" + <*> o .: "updated_at" + <*> o .: "visibility" + +instance FromJSON (WithTotalCount OrganizationSecret) where + parseJSON = withObject "SecretList" $ \o -> WithTotalCount + <$> o .: "secrets" + <*> o .: "total_count" + +instance FromJSON PublicKey where + parseJSON = withObject "PublicKey" $ \o -> PublicKey + <$> o .: "key_id" + <*> o .: "key" + +instance FromJSON SelectedRepo where + parseJSON = withObject "SelectedRepo" $ \o -> SelectedRepo + <$> o .: "id" + <*> o .: "name" + +instance ToJSON SetSelectedRepositories where + toJSON SetSelectedRepositories{..} = + object + [ "selected_repository_ids" .= setSelectedRepositoriesRepositoryIds + ] + +instance ToJSON SetSecret where + toJSON SetSecret{..} = + object $ + [ "encrypted_value" .= setSecretEncryptedValue + , "key_id" .= setSecretPublicKeyId + , "visibility" .= setSecretVisibility + ] <> maybeToList (fmap ("selected_repository_ids" .=) setSecretSelectedRepositoryIds) + +instance ToJSON SetRepoSecret where + toJSON SetRepoSecret{..} = + object + [ "encrypted_value" .= setRepoSecretEncryptedValue + , "key_id" .= setRepoSecretPublicKeyId + ] + +instance FromJSON (WithTotalCount SelectedRepo) where + parseJSON = withObject "SelectedRepoList" $ \o -> WithTotalCount + <$> o .: "repositories" + <*> o .: "total_count" + +instance FromJSON RepoSecret where + parseJSON = withObject "RepoSecret" $ \o -> RepoSecret + <$> o .: "name" + <*> o .: "created_at" + <*> o .: "updated_at" + +instance FromJSON (WithTotalCount RepoSecret) where + parseJSON = withObject "RepoSecretList" $ \o -> WithTotalCount + <$> o .: "secrets" + <*> o .: "total_count" diff --git a/src/GitHub/Data/Actions/WorkflowJobs.hs b/src/GitHub/Data/Actions/WorkflowJobs.hs new file mode 100644 --- /dev/null +++ b/src/GitHub/Data/Actions/WorkflowJobs.hs @@ -0,0 +1,100 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE KindSignatures #-} + +module GitHub.Data.Actions.WorkflowJobs ( + JobStep(..), + Job(..), + ) where + +import Prelude () +import GitHub.Internal.Prelude + (Applicative ((<*>)), Data, Eq, FromJSON (parseJSON), Generic, Integer, + Ord, Show, Text, UTCTime, Vector, withObject, ($), (.:), + (<$>)) + +import GitHub.Data.Id (Id) +import GitHub.Data.Name (Name) +import GitHub.Data.URL (URL) + +import GitHub.Data.Actions.Common (WithTotalCount (WithTotalCount)) +import GitHub.Data.Actions.WorkflowRuns (WorkflowRun) + +------------------------------------------------------------------------------- +-- Workflow jobs +------------------------------------------------------------------------------- + +data JobStep = JobStep + { jobStepName :: !(Name JobStep) + , jobStepStatus :: !Text + , jobStepConclusion :: !Text + , jobStepNumber :: !Integer + , jobStepStartedAt :: !UTCTime + , jobStepCompletedAt :: !UTCTime + } + deriving (Show, Data, Eq, Ord, Generic) + +data Job = Job + { jobId :: !(Id Job) + , jobRunId :: !(Id WorkflowRun) + , jobRunUrl :: !URL + , jobRunAttempt :: !Integer + , jobNodeId :: !Text + , jobHeadSha :: !Text + , jobUrl :: !URL + , jobHtmlUrl :: !URL + , jobStatus :: !Text + , jobConclusion :: !Text + , jobStartedAt :: !UTCTime + , jobCompletedAt :: !UTCTime + , jobName :: !(Name Job) + , jobSteps :: !(Vector JobStep) + , jobRunCheckUrl :: !URL + , jobLabels :: !(Vector Text) + , jobRunnerId :: !Integer + , jobRunnerName :: !Text + , jobRunnerGroupId :: !Integer + , jobRunnerGroupName :: !Text + } + deriving (Show, Data, Eq, Ord, Generic) + +------------------------------------------------------------------------------- +-- JSON instances +------------------------------------------------------------------------------- + +instance FromJSON JobStep where + parseJSON = withObject "JobStep" $ \o -> JobStep + <$> o .: "name" + <*> o .: "status" + <*> o .: "conclusion" + <*> o .: "number" + <*> o .: "started_at" + <*> o .: "completed_at" + +instance FromJSON Job where + parseJSON = withObject "Job" $ \o -> Job + <$> o .: "id" + <*> o .: "run_id" + <*> o .: "run_url" + <*> o .: "run_attempt" + <*> o .: "node_id" + <*> o .: "head_sha" + <*> o .: "url" + <*> o .: "html_url" + <*> o .: "status" + <*> o .: "conclusion" + <*> o .: "started_at" + <*> o .: "completed_at" + <*> o .: "name" + <*> o .: "steps" + <*> o .: "check_run_url" + <*> o .: "labels" + <*> o .: "runner_id" + <*> o .: "runner_name" + <*> o .: "runner_group_id" + <*> o .: "runner_group_name" + +instance FromJSON (WithTotalCount Job) where + parseJSON = withObject "JobList" $ \o -> WithTotalCount + <$> o .: "jobs" + <*> o .: "total_count" diff --git a/src/GitHub/Data/Actions/WorkflowRuns.hs b/src/GitHub/Data/Actions/WorkflowRuns.hs new file mode 100644 --- /dev/null +++ b/src/GitHub/Data/Actions/WorkflowRuns.hs @@ -0,0 +1,91 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE KindSignatures #-} + +module GitHub.Data.Actions.WorkflowRuns ( + WorkflowRun(..), + RunAttempt(..), + ReviewHistory(..), + ) where + +import GitHub.Data.Actions.Common (WithTotalCount (WithTotalCount)) +import GitHub.Data.Definitions +import GitHub.Data.URL (URL) +import GitHub.Internal.Prelude +import Prelude () + +import GitHub.Data.Id (Id) +import GitHub.Data.Name (Name) + +------------------------------------------------------------------------------- +-- Workflow runs +------------------------------------------------------------------------------- + +data WorkflowRun = WorkflowRun + { workflowRunWorkflowRunId :: !(Id WorkflowRun) + , workflowRunName :: !(Name WorkflowRun) + , workflowRunHeadBranch :: !Text + , workflowRunHeadSha :: !Text + , workflowRunPath :: !Text + , workflowRunDisplayTitle :: !Text + , workflowRunRunNumber :: !Integer + , workflowRunEvent :: !Text + , workflowRunStatus :: !Text + , workflowRunConclusion :: !(Maybe Text) + , workflowRunWorkflowId :: !Integer + , workflowRunUrl :: !URL + , workflowRunHtmlUrl :: !URL + , workflowRunCreatedAt :: !UTCTime + , workflowRunUpdatedAt :: !UTCTime + , workflowRunActor :: !SimpleUser + , workflowRunAttempt :: !Integer + , workflowRunStartedAt :: !UTCTime + } + deriving (Show, Data, Eq, Ord, Generic) + +data RunAttempt = RunAttempt + deriving (Show, Data, Eq, Ord, Generic) + +data ReviewHistory = ReviewHistory + { reviewHistoryState :: !Text + , reviewHistoryComment :: !Text + , reviewHistoryUser :: !SimpleUser + + } + deriving (Show, Data, Eq, Ord, Generic) + +------------------------------------------------------------------------------- +-- JSON instances +------------------------------------------------------------------------------- + +instance FromJSON WorkflowRun where + parseJSON = withObject "WorkflowRun" $ \o -> WorkflowRun + <$> o .: "id" + <*> o .: "name" + <*> o .: "head_branch" + <*> o .: "head_sha" + <*> o .: "path" + <*> o .: "display_title" + <*> o .: "run_number" + <*> o .: "event" + <*> o .: "status" + <*> o .: "conclusion" + <*> o .: "workflow_id" + <*> o .: "url" + <*> o .: "html_url" + <*> o .: "created_at" + <*> o .: "updated_at" + <*> o .: "actor" + <*> o .: "run_attempt" + <*> o .: "run_started_at" + +instance FromJSON (WithTotalCount WorkflowRun) where + parseJSON = withObject "WorkflowRunList" $ \o -> WithTotalCount + <$> o .: "workflow_runs" + <*> o .: "total_count" + +instance FromJSON ReviewHistory where + parseJSON = withObject "ReviewHistory" $ \o -> ReviewHistory + <$> o .: "state" + <*> o .: "comment" + <*> o .: "user" diff --git a/src/GitHub/Data/Actions/Workflows.hs b/src/GitHub/Data/Actions/Workflows.hs new file mode 100644 --- /dev/null +++ b/src/GitHub/Data/Actions/Workflows.hs @@ -0,0 +1,62 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE KindSignatures #-} + +module GitHub.Data.Actions.Workflows ( + Workflow(..), + CreateWorkflowDispatchEvent(..), + ) where + +import Prelude () +import GitHub.Internal.Prelude + +import GitHub.Data.Actions.Common (WithTotalCount (WithTotalCount)) +import GitHub.Data.Id (Id) +import GitHub.Data.URL (URL) + +data Workflow = Workflow + { workflowWorkflowId :: !(Id Workflow) + , workflowName :: !Text + , workflowPath :: !Text + , workflowState :: !Text + , workflowCreatedAt :: !UTCTime + , workflowUpdatedAt :: !UTCTime + , workflowUrl :: !URL + , workflowHtmlUrl :: !URL + , workflowBadgeUrl :: !URL + } + deriving (Show, Data, Eq, Ord, Generic) + +data CreateWorkflowDispatchEvent a = CreateWorkflowDispatchEvent + { createWorkflowDispatchEventRef :: !Text + , createWorkflowDispatchEventInputs :: !a + } + deriving (Show, Generic) + +instance (NFData a) => NFData (CreateWorkflowDispatchEvent a) +instance (Binary a) => Binary (CreateWorkflowDispatchEvent a) + +------------------------------------------------------------------------------- +-- JSON instances +------------------------------------------------------------------------------- + +instance FromJSON Workflow where + parseJSON = withObject "Workflow" $ \o -> Workflow + <$> o .: "id" + <*> o .: "name" + <*> o .: "path" + <*> o .: "state" + <*> o .: "created_at" + <*> o .: "updated_at" + <*> o .: "url" + <*> o .: "html_url" + <*> o .: "badge_url" + +instance FromJSON (WithTotalCount Workflow) where + parseJSON = withObject "WorkflowList" $ \o -> WithTotalCount + <$> o .: "workflows" + <*> o .: "total_count" + +instance ToJSON a => ToJSON (CreateWorkflowDispatchEvent a) where + toJSON (CreateWorkflowDispatchEvent ref inputs) = + object [ "ref" .= ref, "inputs" .= inputs ] diff --git a/src/GitHub/Data/Activities.hs b/src/GitHub/Data/Activities.hs --- a/src/GitHub/Data/Activities.hs +++ b/src/GitHub/Data/Activities.hs @@ -1,21 +1,21 @@ ------------------------------------------------------------------------------ --- | --- License : BSD-3-Clause --- Maintainer : Oleg Grenrus --- module GitHub.Data.Activities where -import GitHub.Data.Repos (Repo) +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) + deriving (Show, Data, Eq, Ord, Generic) -instance NFData RepoStarred where rnf = genericRnf +instance NFData RepoStarred instance Binary RepoStarred -- JSON Instances @@ -24,3 +24,91 @@ <$> o .: "starred_at" <*> o .: "repo" +data Subject = Subject + { subjectTitle :: !Text + , subjectURL :: !(Maybe 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, Eq, Ord, Generic) + +instance NFData Subject +instance Binary Subject + +instance FromJSON Subject where + parseJSON = withObject "Subject" $ \o -> Subject + <$> o .: "title" + <*> o .: "url" + <*> o .:? "latest_comment_url" + <*> o .: "type" + +data NotificationReason + = ApprovalRequestedReason + | AssignReason + | AuthorReason + | CommentReason + | CiActivityReason + | InvitationReason + | ManualReason + | MemberFeatureRequestedReason + | MentionReason + | ReviewRequestedReason + | SecurityAlertReason + | SecurityAdvisoryCreditReason + | StateChangeReason + | SubscribedReason + | TeamMentionReason + deriving (Show, Data, Enum, Bounded, Eq, Ord, Generic) + +instance NFData NotificationReason +instance Binary NotificationReason + +instance FromJSON NotificationReason where + parseJSON = withText "NotificationReason" $ \t -> case T.toLower t of + "approval_requested" -> pure ApprovalRequestedReason + "assign" -> pure AssignReason + "author" -> pure AuthorReason + "comment" -> pure CommentReason + "ci_activity" -> pure CiActivityReason + "invitation" -> pure InvitationReason + "manual" -> pure ManualReason + "member_feature_requested" -> pure MemberFeatureRequestedReason + "mention" -> pure MentionReason + "review_requested" -> pure ReviewRequestedReason + "security_alert" -> pure SecurityAlertReason + "security_advisory_credit" -> pure SecurityAdvisoryCreditReason + "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, Eq, Ord, Generic) + +instance NFData Notification +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" diff --git a/src/GitHub/Data/Comments.hs b/src/GitHub/Data/Comments.hs --- a/src/GitHub/Data/Comments.hs +++ b/src/GitHub/Data/Comments.hs @@ -1,8 +1,3 @@ ------------------------------------------------------------------------------ --- | --- License : BSD-3-Clause --- Maintainer : Oleg Grenrus --- module GitHub.Data.Comments where import GitHub.Data.Definitions @@ -24,9 +19,9 @@ , commentUser :: !SimpleUser , commentId :: !(Id Comment) } - deriving (Show, Data, Typeable, Eq, Ord, Generic) + deriving (Show, Data, Eq, Ord, Generic) -instance NFData Comment where rnf = genericRnf +instance NFData Comment instance Binary Comment instance FromJSON Comment where @@ -46,9 +41,9 @@ data NewComment = NewComment { newCommentBody :: !Text } - deriving (Show, Data, Typeable, Eq, Ord, Generic) + deriving (Show, Data, Eq, Ord, Generic) -instance NFData NewComment where rnf = genericRnf +instance NFData NewComment instance Binary NewComment instance ToJSON NewComment where @@ -57,10 +52,41 @@ data EditComment = EditComment { editCommentBody :: !Text } - deriving (Show, Data, Typeable, Eq, Ord, Generic) + deriving (Show, Data, Eq, Ord, Generic) -instance NFData EditComment where rnf = genericRnf +instance NFData EditComment 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, Eq, Ord, Generic) + +instance NFData NewPullComment +instance Binary NewPullComment + +instance ToJSON NewPullComment where + toJSON (NewPullComment c path pos b) = + object [ "body" .= b + , "commit_id" .= c + , "path" .= path + , "position" .= pos + ] + +data PullCommentReply = PullCommentReply + { pullCommentReplyBody :: Text + } + deriving (Show, Data, Eq, Ord, Generic) + +instance NFData PullCommentReply + +instance ToJSON PullCommentReply where + toJSON (PullCommentReply b) = + object [ "body" .= b + ] diff --git a/src/GitHub/Data/Content.hs b/src/GitHub/Data/Content.hs --- a/src/GitHub/Data/Content.hs +++ b/src/GitHub/Data/Content.hs @@ -1,24 +1,26 @@ {-# LANGUAGE RecordWildCards #-} ------------------------------------------------------------------------------ --- | --- License : BSD-3-Clause --- Maintainer : Oleg Grenrus --- +{-# LANGUAGE CPP #-} + module GitHub.Data.Content where -import Data.Aeson.Types (Pair) -import Data.Maybe (maybe) import GitHub.Data.GitData import GitHub.Data.URL import GitHub.Internal.Prelude import Prelude () +import Data.Aeson.Types (Pair) +import qualified Data.Text as T + +#if MIN_VERSION_aeson(2,0,0) +import Data.Aeson (Key) +#endif + data Content = ContentFile !ContentFileData | ContentDirectory !(Vector ContentItem) - deriving (Show, Data, Typeable, Eq, Ord, Generic) + deriving (Show, Data, Eq, Ord, Generic) -instance NFData Content where rnf = genericRnf +instance NFData Content instance Binary Content data ContentFileData = ContentFileData { @@ -26,24 +28,24 @@ ,contentFileEncoding :: !Text ,contentFileSize :: !Int ,contentFileContent :: !Text -} deriving (Show, Data, Typeable, Eq, Ord, Generic) +} deriving (Show, Data, Eq, Ord, Generic) -instance NFData ContentFileData where rnf = genericRnf +instance NFData ContentFileData instance Binary ContentFileData -- | An item in a directory listing. data ContentItem = ContentItem { contentItemType :: !ContentItemType ,contentItemInfo :: !ContentInfo -} deriving (Show, Data, Typeable, Eq, Ord, Generic) +} deriving (Show, Data, Eq, Ord, Generic) -instance NFData ContentItem where rnf = genericRnf +instance NFData ContentItem instance Binary ContentItem data ContentItemType = ItemFile | ItemDir - deriving (Show, Data, Typeable, Eq, Ord, Generic) + deriving (Show, Data, Eq, Ord, Generic) -instance NFData ContentItemType where rnf = genericRnf +instance NFData ContentItemType instance Binary ContentItemType -- | Information common to both kinds of Content: files and directories. @@ -54,34 +56,34 @@ ,contentUrl :: !URL ,contentGitUrl :: !URL ,contentHtmlUrl :: !URL -} deriving (Show, Data, Typeable, Eq, Ord, Generic) +} deriving (Show, Data, Eq, Ord, Generic) -instance NFData ContentInfo where rnf = genericRnf +instance NFData ContentInfo instance Binary ContentInfo data ContentResultInfo = ContentResultInfo { contentResultInfo :: !ContentInfo , contentResultSize :: !Int - } deriving (Show, Data, Typeable, Eq, Ord, Generic) + } deriving (Show, Data, Eq, Ord, Generic) -instance NFData ContentResultInfo where rnf = genericRnf +instance NFData ContentResultInfo instance Binary ContentResultInfo data ContentResult = ContentResult { contentResultContent :: !ContentResultInfo , contentResultCommit :: !GitCommit - } deriving (Show, Data, Typeable, Eq, Ord, Generic) + } deriving (Show, Data, Eq, Ord, Generic) -instance NFData ContentResult where rnf = genericRnf +instance NFData ContentResult instance Binary ContentResult data Author = Author { authorName :: !Text , authorEmail :: !Text } - deriving (Eq, Ord, Show, Data, Typeable, Generic) + deriving (Eq, Ord, Show, Data, Generic) -instance NFData Author where rnf = genericRnf +instance NFData Author instance Binary Author data CreateFile = CreateFile @@ -92,9 +94,9 @@ , createFileAuthor :: !(Maybe Author) , createFileCommitter :: !(Maybe Author) } - deriving (Eq, Ord, Show, Data, Typeable, Generic) + deriving (Eq, Ord, Show, Data, Generic) -instance NFData CreateFile where rnf = genericRnf +instance NFData CreateFile instance Binary CreateFile data UpdateFile = UpdateFile @@ -106,9 +108,9 @@ , updateFileAuthor :: !(Maybe Author) , updateFileCommitter :: !(Maybe Author) } - deriving (Eq, Ord, Show, Data, Typeable, Generic) + deriving (Eq, Ord, Show, Data, Generic) -instance NFData UpdateFile where rnf = genericRnf +instance NFData UpdateFile instance Binary UpdateFile data DeleteFile = DeleteFile @@ -119,9 +121,9 @@ , deleteFileAuthor :: !(Maybe Author) , deleteFileCommitter :: !(Maybe Author) } - deriving (Eq, Ord, Show, Data, Typeable, Generic) + deriving (Eq, Ord, Show, Data, Generic) -instance NFData DeleteFile where rnf = genericRnf +instance NFData DeleteFile instance Binary DeleteFile instance FromJSON Content where @@ -142,11 +144,10 @@ <*> parseJSON (Object o) instance FromJSON ContentItemType where - parseJSON = withText "ContentItemType" $ \t -> - case t of - "file" -> return ItemFile - "dir" -> return ItemDir - _ -> fail $ "Invalid ContentItemType: " ++ unpack t + 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 -> @@ -204,5 +205,9 @@ ++ "author" .=? deleteFileAuthor ++ "committer" .=? deleteFileCommitter +#if MIN_VERSION_aeson(2,0,0) +(.=?) :: ToJSON v => Key -> Maybe v -> [Pair] +#else (.=?) :: ToJSON v => Text -> Maybe v -> [Pair] +#endif name .=? value = maybe [] (pure . (name .=)) value diff --git a/src/GitHub/Data/Definitions.hs b/src/GitHub/Data/Definitions.hs --- a/src/GitHub/Data/Definitions.hs +++ b/src/GitHub/Data/Definitions.hs @@ -1,8 +1,3 @@ ------------------------------------------------------------------------------ --- | --- License : BSD-3-Clause --- Maintainer : Oleg Grenrus --- module GitHub.Data.Definitions where import GitHub.Internal.Prelude @@ -27,13 +22,13 @@ | ParseError !Text -- ^ An error in the parser itself. | JsonError !Text -- ^ The JSON is malformed or unexpected. | UserError !Text -- ^ Incorrect input. - deriving (Show, Typeable) + deriving (Show) instance E.Exception Error -- | Type of the repository owners. -data OwnerType = OwnerUser | OwnerOrganization - deriving (Eq, Ord, Enum, Bounded, Show, Read, Generic, Typeable, Data) +data OwnerType = OwnerUser | OwnerOrganization | OwnerBot + deriving (Eq, Ord, Enum, Bounded, Show, Read, Generic, Data) instance NFData OwnerType instance Binary OwnerType @@ -44,9 +39,9 @@ , simpleUserAvatarUrl :: !URL , simpleUserUrl :: !URL } - deriving (Show, Data, Typeable, Eq, Ord, Generic) + deriving (Show, Data, Eq, Ord, Generic) -instance NFData SimpleUser where rnf = genericRnf +instance NFData SimpleUser instance Binary SimpleUser data SimpleOrganization = SimpleOrganization @@ -55,9 +50,9 @@ , simpleOrganizationUrl :: !URL , simpleOrganizationAvatarUrl :: !URL } - deriving (Show, Data, Typeable, Eq, Ord, Generic) + deriving (Show, Data, Eq, Ord, Generic) -instance NFData SimpleOrganization where rnf = genericRnf +instance NFData SimpleOrganization instance Binary SimpleOrganization -- | Sometimes we don't know the type of the owner, e.g. in 'Repo' @@ -68,16 +63,16 @@ , simpleOwnerAvatarUrl :: !URL , simpleOwnerType :: !OwnerType } - deriving (Show, Data, Typeable, Eq, Ord, Generic) + deriving (Show, Data, Eq, Ord, Generic) -instance NFData SimpleOwner where rnf = genericRnf +instance NFData SimpleOwner instance Binary SimpleOwner data User = User { userId :: !(Id User) , userLogin :: !(Name User) , userName :: !(Maybe Text) - , userType :: !OwnerType -- ^ Should always be 'OwnerUser' + , userType :: !OwnerType -- ^ Should always be 'OwnerUser' or 'OwnerBot' , userCreatedAt :: !UTCTime , userPublicGists :: !Int , userAvatarUrl :: !URL @@ -93,9 +88,9 @@ , userUrl :: !URL , userHtmlUrl :: !URL } - deriving (Show, Data, Typeable, Eq, Ord, Generic) + deriving (Show, Data, Eq, Ord, Generic) -instance NFData User where rnf = genericRnf +instance NFData User instance Binary User data Organization = Organization @@ -116,16 +111,16 @@ , organizationUrl :: !URL , organizationCreatedAt :: !UTCTime } - deriving (Show, Data, Typeable, Eq, Ord, Generic) + deriving (Show, Data, Eq, Ord, Generic) -instance NFData Organization where rnf = genericRnf +instance NFData Organization instance Binary Organization --- | In practic, you cam't have concrete values of 'Owner'. +-- | In practice you can't have concrete values of 'Owner'. newtype Owner = Owner (Either User Organization) - deriving (Show, Data, Typeable, Eq, Ord, Generic) + deriving (Show, Data, Eq, Ord, Generic) -instance NFData Owner where rnf = genericRnf +instance NFData Owner instance Binary Owner fromOwner :: Owner -> Either User Organization @@ -134,11 +129,11 @@ -- JSON instances instance FromJSON OwnerType where - parseJSON = withText "Owner type" $ \t -> - case t of - "User" -> pure $ OwnerUser - "Organization" -> pure $ OwnerOrganization - _ -> fail $ "Unknown owner type: " ++ T.unpack t + 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 @@ -206,7 +201,7 @@ <*> obj .: "created_at" instance FromJSON User where - parseJSON = mfilter ((== OwnerUser) . userType) . withObject "User" parseUser + parseJSON = mfilter ((/= OwnerOrganization) . userType) . withObject "User" parseUser instance FromJSON Organization where parseJSON = withObject "Organization" parseOrganization @@ -216,20 +211,21 @@ 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) + deriving (Show, Eq, Ord, Enum, Bounded, 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) + deriving (Show, Eq, Ord, Enum, Bounded, Data, Generic) -- | Request query string type QueryString = [(BS.ByteString, Maybe BS.ByteString)] @@ -237,7 +233,86 @@ -- | Count of elements type Count = Int + + +data MembershipRole + = MembershipRoleMember + | MembershipRoleAdmin + | MembershipRoleBillingManager + deriving + (Eq, Ord, Show, Enum, Bounded, Generic, Data) + +instance NFData MembershipRole +instance Binary MembershipRole + +instance FromJSON MembershipRole where + parseJSON = withText "MembershipRole" $ \t -> case T.toLower t of + "member" -> pure MembershipRoleMember + "admin" -> pure MembershipRoleAdmin + "billing_manager" -> pure MembershipRoleBillingManager + _ -> fail $ "Unknown MembershipRole: " <> T.unpack t + +data MembershipState + = MembershipPending + | MembershipActive + deriving (Show, Data, Eq, Ord, Generic) + +instance NFData MembershipState +instance Binary MembershipState + +instance FromJSON MembershipState where + parseJSON = withText "MembershipState" $ \t -> case T.toLower t of + "active" -> pure MembershipActive + "pending" -> pure MembershipPending + _ -> fail $ "Unknown MembershipState: " <> T.unpack t + + +data Membership = Membership + { membershipUrl :: !URL + , membershipState :: !MembershipState + , membershipRole :: !MembershipRole + , membershipOrganizationUrl :: !URL + , membershipOrganization :: !SimpleOrganization + , membershipUser :: !SimpleUser + } + deriving (Show, Data, Eq, Ord, Generic) + +instance NFData Membership +instance Binary Membership + +instance FromJSON Membership where + parseJSON = withObject "Membership" $ \o -> Membership + <$> o .: "url" + <*> o .: "state" + <*> o .: "role" + <*> o .: "organization_url" + <*> o .: "organization" + <*> o .: "user" + + ------------------------------------------------------------------------------- +-- IssueNumber +------------------------------------------------------------------------------- + +newtype IssueNumber = IssueNumber Int + deriving (Eq, Ord, Show, Generic, 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 ------------------------------------------------------------------------------- @@ -245,10 +320,11 @@ { labelColor :: !Text , labelUrl :: !URL , labelName :: !(Name IssueLabel) + , labelDesc :: !(Maybe Text) } - deriving (Show, Data, Typeable, Eq, Ord, Generic) + deriving (Show, Data, Eq, Ord, Generic) -instance NFData IssueLabel where rnf = genericRnf +instance NFData IssueLabel instance Binary IssueLabel instance FromJSON IssueLabel where @@ -256,3 +332,57 @@ <$> o .: "color" <*> o .:? "url" .!= URL "" -- in events there aren't URL <*> o .: "name" + <*> o .:? "description" + + +------------------------------------------------------------------------------- +-- NewIssueLabel +------------------------------------------------------------------------------- + +data NewIssueLabel = NewIssueLabel + { newLabelColor :: !Text + , newLabelName :: !(Name NewIssueLabel) + , newLabelDesc :: !(Maybe Text) + } + deriving (Show, Data, Eq, Ord, Generic) + +instance NFData NewIssueLabel +instance Binary NewIssueLabel + + +instance ToJSON NewIssueLabel where + toJSON (NewIssueLabel color lblName lblDesc) = object $ filter notNull + [ "name" .= lblName + , "color" .= color + , "description" .= lblDesc + ] + where + notNull (_, Null) = False + notNull (_, _) = True + + + +------------------------------------------------------------------------------- +-- UpdateIssueLabel +------------------------------------------------------------------------------- + +data UpdateIssueLabel = UpdateIssueLabel + { updateLabelColor :: !Text + , updateLabelName :: !(Name UpdateIssueLabel) + , updateLabelDesc :: !(Maybe Text) + } + deriving (Show, Data, Eq, Ord, Generic) + +instance NFData UpdateIssueLabel +instance Binary UpdateIssueLabel + + +instance ToJSON UpdateIssueLabel where + toJSON (UpdateIssueLabel color lblName lblDesc) = object $ filter notNull + [ "new_name" .= lblName + , "color" .= color + , "description" .= lblDesc + ] + where + notNull (_, Null) = False + notNull (_, _) = True diff --git a/src/GitHub/Data/DeployKeys.hs b/src/GitHub/Data/DeployKeys.hs --- a/src/GitHub/Data/DeployKeys.hs +++ b/src/GitHub/Data/DeployKeys.hs @@ -19,7 +19,7 @@ , repoDeployKeyCreatedAt :: !UTCTime , repoDeployKeyReadOnly :: !Bool } - deriving (Show, Data, Typeable, Eq, Ord, Generic) + deriving (Show, Data, Eq, Ord, Generic) instance FromJSON RepoDeployKey where parseJSON = withObject "RepoDeployKey" $ \o -> RepoDeployKey @@ -36,7 +36,7 @@ , newRepoDeployKeyTitle :: !Text , newRepoDeployKeyReadOnly :: !Bool } - deriving (Show, Data, Typeable, Eq, Ord, Generic) + deriving (Show, Data, Eq, Ord, Generic) instance ToJSON NewRepoDeployKey where toJSON (NewRepoDeployKey key title readOnly) = object diff --git a/src/GitHub/Data/Deployments.hs b/src/GitHub/Data/Deployments.hs new file mode 100644 --- /dev/null +++ b/src/GitHub/Data/Deployments.hs @@ -0,0 +1,204 @@ +{-# 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 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, Eq, Ord, Generic) + +instance NFData DeploymentQueryOption +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, Eq, Ord, Generic) + +instance NFData a => NFData (Deployment a) +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, Eq, Ord, Generic) + +instance NFData a => NFData (CreateDeployment a) +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, Eq, Ord, Generic) + +instance NFData DeploymentStatus +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, Eq, Ord, Generic) + +instance NFData DeploymentStatusState +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, Eq, Ord, Generic) + +instance NFData CreateDeploymentStatus +instance Binary CreateDeploymentStatus + +instance ToJSON CreateDeploymentStatus where + toJSON x = + JSON.object $ catMaybes + [ Just ("state" .= createDeploymentStatusState x) + , ("target_url" .=) <$> createDeploymentStatusTargetUrl x + , ("description" .=) <$> createDeploymentStatusDescription x + ] diff --git a/src/GitHub/Data/Email.hs b/src/GitHub/Data/Email.hs --- a/src/GitHub/Data/Email.hs +++ b/src/GitHub/Data/Email.hs @@ -1,34 +1,32 @@ ------------------------------------------------------------------------------ --- | --- 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) + deriving (Show, Data, Enum, Bounded, Eq, Ord, Generic) -instance NFData EmailVisibility where rnf = genericRnf +instance NFData EmailVisibility instance Binary EmailVisibility instance FromJSON EmailVisibility where - parseJSON (String "private") = pure EmailVisibilityPrivate - parseJSON (String "public") = pure EmailVisibilityPublic - parseJSON _ = fail "Could not build an EmailVisibility" + 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) + } deriving (Show, Data, Eq, Ord, Generic) -instance NFData Email where rnf = genericRnf +instance NFData Email instance Binary Email instance FromJSON Email where diff --git a/src/GitHub/Data/Enterprise.hs b/src/GitHub/Data/Enterprise.hs new file mode 100644 --- /dev/null +++ b/src/GitHub/Data/Enterprise.hs @@ -0,0 +1,9 @@ +-- | +-- This module re-exports the @GitHub.Data.Enterprise.@ submodules. + +module GitHub.Data.Enterprise ( + -- * Module re-exports + module GitHub.Data.Enterprise.Organizations, + ) where + +import GitHub.Data.Enterprise.Organizations diff --git a/src/GitHub/Data/Enterprise/Organizations.hs b/src/GitHub/Data/Enterprise/Organizations.hs new file mode 100644 --- /dev/null +++ b/src/GitHub/Data/Enterprise/Organizations.hs @@ -0,0 +1,59 @@ +module GitHub.Data.Enterprise.Organizations where + +import GitHub.Data.Definitions +import GitHub.Data.Name (Name) +import GitHub.Data.URL (URL) +import GitHub.Internal.Prelude +import Prelude () + +data CreateOrganization = CreateOrganization + { createOrganizationLogin :: !(Name Organization) + , createOrganizationAdmin :: !(Name User) + , createOrganizationProfileName :: !(Maybe Text) + } + deriving (Show, Data, Eq, Ord, Generic) + +instance NFData CreateOrganization +instance Binary CreateOrganization + +data RenameOrganization = RenameOrganization + { renameOrganizationLogin :: !(Name Organization) + } + deriving (Show, Data, Eq, Ord, Generic) + +instance NFData RenameOrganization +instance Binary RenameOrganization + +data RenameOrganizationResponse = RenameOrganizationResponse + { renameOrganizationResponseMessage :: !Text + , renameOrganizationResponseUrl :: !URL + } + deriving (Show, Data, Eq, Ord, Generic) + +instance NFData RenameOrganizationResponse +instance Binary RenameOrganizationResponse + +-- JSON Instances + +instance ToJSON CreateOrganization where + toJSON (CreateOrganization login admin profileName) = + object $ filter notNull + [ "login" .= login + , "admin" .= admin + , "profile_name" .= profileName + ] + where + notNull (_, Null) = False + notNull (_, _) = True + +instance ToJSON RenameOrganization where + toJSON (RenameOrganization login) = + object + [ "login" .= login + ] + +instance FromJSON RenameOrganizationResponse where + parseJSON = withObject "RenameOrganizationResponse" $ \o -> + RenameOrganizationResponse + <$> o .: "message" + <*> o .: "url" diff --git a/src/GitHub/Data/Events.hs b/src/GitHub/Data/Events.hs --- a/src/GitHub/Data/Events.hs +++ b/src/GitHub/Data/Events.hs @@ -1,8 +1,3 @@ ------------------------------------------------------------------------------ --- | --- License : BSD-3-Clause --- Maintainer : Oleg Grenrus --- module GitHub.Data.Events where import GitHub.Data.Definitions @@ -14,19 +9,20 @@ -- /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) + deriving (Show, Data, Eq, Ord, Generic) -instance NFData Event where rnf = genericRnf -instance Binary Event +instance NFData Event +instance Binary Event instance FromJSON Event where - parseJSON = withObject "Event" $ \obj -> Event + parseJSON = withObject "Event" $ \obj -> Event -- <$> obj .: "id" <$> obj .: "actor" <*> obj .: "created_at" diff --git a/src/GitHub/Data/Gists.hs b/src/GitHub/Data/Gists.hs --- a/src/GitHub/Data/Gists.hs +++ b/src/GitHub/Data/Gists.hs @@ -1,8 +1,3 @@ ------------------------------------------------------------------------------ --- | --- License : BSD-3-Clause --- Maintainer : Oleg Grenrus --- module GitHub.Data.Gists where import GitHub.Data.Definitions @@ -26,9 +21,9 @@ , gistId :: !(Name Gist) , gistFiles :: !(HashMap Text GistFile) , gistGitPullUrl :: !URL - } deriving (Show, Data, Typeable, Eq, Generic) + } deriving (Show, Data, Eq, Generic) -instance NFData Gist where rnf = genericRnf +instance NFData Gist instance Binary Gist instance FromJSON Gist where @@ -54,9 +49,9 @@ , gistFileFilename :: !Text , gistFileContent :: !(Maybe Text) } - deriving (Show, Data, Typeable, Eq, Generic) + deriving (Show, Data, Eq, Generic) -instance NFData GistFile where rnf = genericRnf +instance NFData GistFile instance Binary GistFile instance FromJSON GistFile where @@ -76,9 +71,9 @@ , gistCommentUpdatedAt :: !UTCTime , gistCommentId :: !(Id GistComment) } - deriving (Show, Data, Typeable, Eq, Ord, Generic) + deriving (Show, Data, Eq, Ord, Generic) -instance NFData GistComment where rnf = genericRnf +instance NFData GistComment instance Binary GistComment instance FromJSON GistComment where @@ -89,3 +84,35 @@ <*> o .: "body" <*> o .: "updated_at" <*> o .: "id" + +data NewGist = NewGist + { newGistDescription :: !(Maybe Text) + , newGistFiles :: !(HashMap Text NewGistFile) + , newGistPublic :: !(Maybe Bool) + } deriving (Show, Data, Eq, Generic) + +instance NFData NewGist +instance Binary NewGist + +instance ToJSON NewGist where + toJSON NewGist { newGistDescription = description + , newGistFiles = files + , newGistPublic = public + } = object $ filter notNull + [ "description" .= description + , "files" .= files + , "public" .= public + ] + where + notNull (_, Null) = False + notNull (_, _) = True + +data NewGistFile = NewGistFile + { newGistFileContent :: !Text + } deriving (Show, Data, Eq, Generic) + +instance NFData NewGistFile +instance Binary NewGistFile + +instance ToJSON NewGistFile where + toJSON (NewGistFile c) = object ["content" .= c] diff --git a/src/GitHub/Data/GitData.hs b/src/GitHub/Data/GitData.hs --- a/src/GitHub/Data/GitData.hs +++ b/src/GitHub/Data/GitData.hs @@ -1,8 +1,3 @@ ------------------------------------------------------------------------------ --- | --- License : BSD-3-Clause --- Maintainer : Oleg Grenrus --- module GitHub.Data.GitData where import GitHub.Data.Definitions @@ -20,16 +15,16 @@ | CommitQueryAuthor !Text | CommitQuerySince !UTCTime | CommitQueryUntil !UTCTime - deriving (Show, Eq, Ord, Generic, Typeable, Data) + deriving (Show, Eq, Ord, Generic, Data) data Stats = Stats { statsAdditions :: !Int , statsTotal :: !Int , statsDeletions :: !Int } - deriving (Show, Data, Typeable, Eq, Ord, Generic) + deriving (Show, Data, Eq, Ord, Generic) -instance NFData Stats where rnf = genericRnf +instance NFData Stats instance Binary Stats data Commit = Commit @@ -42,9 +37,9 @@ , commitFiles :: !(Vector File) , commitStats :: !(Maybe Stats) } - deriving (Show, Data, Typeable, Eq, Ord, Generic) + deriving (Show, Data, Eq, Ord, Generic) -instance NFData Commit where rnf = genericRnf +instance NFData Commit instance Binary Commit data Tree = Tree @@ -52,9 +47,9 @@ , treeUrl :: !URL , treeGitTrees :: !(Vector GitTree) } - deriving (Show, Data, Typeable, Eq, Ord, Generic) + deriving (Show, Data, Eq, Ord, Generic) -instance NFData Tree where rnf = genericRnf +instance NFData Tree instance Binary Tree data GitTree = GitTree @@ -66,9 +61,9 @@ , gitTreePath :: !Text , gitTreeMode :: !Text } - deriving (Show, Data, Typeable, Eq, Ord, Generic) + deriving (Show, Data, Eq, Ord, Generic) -instance NFData GitTree where rnf = genericRnf +instance NFData GitTree instance Binary GitTree data GitCommit = GitCommit @@ -80,9 +75,9 @@ , gitCommitSha :: !(Maybe (Name GitCommit)) , gitCommitParents :: !(Vector Tree) } - deriving (Show, Data, Typeable, Eq, Ord, Generic) + deriving (Show, Data, Eq, Ord, Generic) -instance NFData GitCommit where rnf = genericRnf +instance NFData GitCommit instance Binary GitCommit data Blob = Blob @@ -92,9 +87,9 @@ , blobSha :: !(Name Blob) , blobSize :: !Int } - deriving (Show, Data, Typeable, Eq, Ord, Generic) + deriving (Show, Data, Eq, Ord, Generic) -instance NFData Blob where rnf = genericRnf +instance NFData Blob instance Binary Blob data Tag = Tag @@ -103,26 +98,26 @@ , tagTarballUrl :: !URL , tagCommit :: !BranchCommit } - deriving (Show, Data, Typeable, Eq, Ord, Generic) + deriving (Show, Data, Eq, Ord, Generic) -instance NFData Tag where rnf = genericRnf +instance NFData Tag instance Binary Tag data Branch = Branch { branchName :: !Text , branchCommit :: !BranchCommit } - deriving (Show, Data, Typeable, Eq, Ord, Generic) + deriving (Show, Data, Eq, Ord, Generic) -instance NFData Branch where rnf = genericRnf +instance NFData Branch data BranchCommit = BranchCommit { branchCommitSha :: !Text , branchCommitUrl :: !URL } - deriving (Show, Data, Typeable, Eq, Ord, Generic) + deriving (Show, Data, Eq, Ord, Generic) -instance NFData BranchCommit where rnf = genericRnf +instance NFData BranchCommit instance Binary BranchCommit data Diff = Diff @@ -139,28 +134,28 @@ , diffDiffUrl :: !URL , diffPermalinkUrl :: !URL } - deriving (Show, Data, Typeable, Eq, Ord, Generic) + deriving (Show, Data, Eq, Ord, Generic) -instance NFData Diff where rnf = genericRnf +instance NFData Diff instance Binary Diff data NewGitReference = NewGitReference { newGitReferenceRef :: !Text , newGitReferenceSha :: !Text } - deriving (Show, Data, Typeable, Eq, Ord, Generic) + deriving (Show, Data, Eq, Ord, Generic) -instance NFData NewGitReference where rnf = genericRnf +instance NFData NewGitReference instance Binary NewGitReference data GitReference = GitReference { gitReferenceObject :: !GitObject , gitReferenceUrl :: !URL - , gitReferenceRef :: !Text + , gitReferenceRef :: !(Name GitReference) } - deriving (Show, Data, Typeable, Eq, Ord, Generic) + deriving (Show, Data, Eq, Ord, Generic) -instance NFData GitReference where rnf = genericRnf +instance NFData GitReference instance Binary GitReference data GitObject = GitObject @@ -168,9 +163,9 @@ , gitObjectSha :: !Text , gitObjectUrl :: !URL } - deriving (Show, Data, Typeable, Eq, Ord, Generic) + deriving (Show, Data, Eq, Ord, Generic) -instance NFData GitObject where rnf = genericRnf +instance NFData GitObject instance Binary GitObject data GitUser = GitUser @@ -178,25 +173,25 @@ , gitUserEmail :: !Text , gitUserDate :: !UTCTime } - deriving (Show, Data, Typeable, Eq, Ord, Generic) + deriving (Show, Data, Eq, Ord, Generic) -instance NFData GitUser where rnf = genericRnf +instance NFData GitUser instance Binary GitUser data File = File - { fileBlobUrl :: !URL + { fileBlobUrl :: !(Maybe URL) , fileStatus :: !Text - , fileRawUrl :: !URL + , fileRawUrl :: !(Maybe URL) , fileAdditions :: !Int - , fileSha :: !Text + , fileSha :: !(Maybe Text) , fileChanges :: !Int , filePatch :: !(Maybe Text) , fileFilename :: !Text , fileDeletions :: !Int } - deriving (Show, Data, Typeable, Eq, Ord, Generic) + deriving (Show, Data, Eq, Ord, Generic) -instance NFData File where rnf = genericRnf +instance NFData File instance Binary File -- JSON instances @@ -213,8 +208,8 @@ <*> o .: "parents" <*> o .: "url" <*> o .: "commit" - <*> o .:? "committer" - <*> o .:? "author" + <*> (o .:? "committer" <|> pure Nothing) + <*> (o .:? "author" <|> pure Nothing) <*> o .:? "files" .!= V.empty <*> o .:? "stats" @@ -251,11 +246,11 @@ instance FromJSON File where parseJSON = withObject "File" $ \o -> File - <$> o .: "blob_url" + <$> o .:? "blob_url" <*> o .: "status" - <*> o .: "raw_url" + <*> o .:? "raw_url" <*> o .: "additions" - <*> o .: "sha" + <*> o .:? "sha" <*> o .: "changes" <*> o .:? "patch" <*> o .: "filename" diff --git a/src/GitHub/Data/Id.hs b/src/GitHub/Data/Id.hs --- a/src/GitHub/Data/Id.hs +++ b/src/GitHub/Data/Id.hs @@ -1,8 +1,3 @@ ------------------------------------------------------------------------------ --- | --- License : BSD-3-Clause --- Maintainer : Oleg Grenrus --- module GitHub.Data.Id ( Id(..), mkId, @@ -14,7 +9,7 @@ -- | Numeric identifier. newtype Id entity = Id Int - deriving (Eq, Ord, Show, Generic, Typeable, Data) + deriving (Eq, Ord, Show, Generic, Data) -- | Smart constructor for 'Id'. mkId :: proxy entity -> Int -> Id entity diff --git a/src/GitHub/Data/Invitation.hs b/src/GitHub/Data/Invitation.hs --- a/src/GitHub/Data/Invitation.hs +++ b/src/GitHub/Data/Invitation.hs @@ -1,16 +1,15 @@ ------------------------------------------------------------------------------ --- | --- 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` ? @@ -20,9 +19,9 @@ , invitationCreatedAt :: !UTCTime , inviter :: !SimpleUser } - deriving (Show, Data, Typeable, Eq, Ord, Generic) + deriving (Show, Data, Eq, Ord, Generic) -instance NFData Invitation where rnf = genericRnf +instance NFData Invitation instance Binary Invitation instance FromJSON Invitation where @@ -42,16 +41,42 @@ | InvitationRoleHiringManager | InvitationRoleReinstate deriving - (Eq, Ord, Show, Enum, Bounded, Generic, Typeable, Data) + (Eq, Ord, Show, Enum, Bounded, Generic, Data) -instance NFData InvitationRole where rnf = genericRnf +instance NFData InvitationRole instance Binary InvitationRole instance FromJSON InvitationRole where - parseJSON = withText "InvirationRole" $ \t -> case t of + 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 $ "Invalid role " ++ show t + _ -> 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, Eq, Ord, Generic) + +instance NFData RepoInvitation +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" diff --git a/src/GitHub/Data/Issues.hs b/src/GitHub/Data/Issues.hs --- a/src/GitHub/Data/Issues.hs +++ b/src/GitHub/Data/Issues.hs @@ -1,20 +1,17 @@ ------------------------------------------------------------------------------ --- | --- 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.Options (IssueState, IssueStateReason) import GitHub.Data.PullRequests import GitHub.Data.URL (URL) import GitHub.Internal.Prelude -import Prelude () +import Prelude () +import qualified Data.Text as T + data Issue = Issue { issueClosedAt :: !(Maybe UTCTime) , issueUpdatedAt :: !UTCTime @@ -22,7 +19,7 @@ , issueHtmlUrl :: !(Maybe URL) , issueClosedBy :: !(Maybe SimpleUser) , issueLabels :: !(Vector IssueLabel) - , issueNumber :: !Int + , issueNumber :: !IssueNumber , issueAssignees :: !(Vector SimpleUser) , issueUser :: !SimpleUser , issueTitle :: !Text @@ -34,35 +31,36 @@ , issueId :: !(Id Issue) , issueComments :: !Int , issueMilestone :: !(Maybe Milestone) + , issueStateReason :: !(Maybe IssueStateReason) } - deriving (Show, Data, Typeable, Eq, Ord, Generic) + deriving (Show, Data, Eq, Ord, Generic) -instance NFData Issue where rnf = genericRnf +instance NFData Issue instance Binary Issue data NewIssue = NewIssue { newIssueTitle :: !Text , newIssueBody :: !(Maybe Text) - , newIssueAssignee :: !(Maybe Text) + , newIssueAssignees :: !(Vector (Name User)) , newIssueMilestone :: !(Maybe (Id Milestone)) , newIssueLabels :: !(Maybe (Vector (Name IssueLabel))) } - deriving (Show, Data, Typeable, Eq, Ord, Generic) + deriving (Show, Data, Eq, Ord, Generic) -instance NFData NewIssue where rnf = genericRnf +instance NFData NewIssue instance Binary NewIssue data EditIssue = EditIssue { editIssueTitle :: !(Maybe Text) , editIssueBody :: !(Maybe Text) - , editIssueAssignee :: !(Maybe (Name User)) + , editIssueAssignees :: !(Maybe (Vector (Name User))) , editIssueState :: !(Maybe IssueState) , editIssueMilestone :: !(Maybe (Id Milestone)) , editIssueLabels :: !(Maybe (Vector (Name IssueLabel))) } - deriving (Show, Data, Typeable, Eq, Ord, Generic) + deriving (Show, Data, Eq, Ord, Generic) -instance NFData EditIssue where rnf = genericRnf +instance NFData EditIssue instance Binary EditIssue data IssueComment = IssueComment @@ -74,9 +72,9 @@ , issueCommentBody :: !Text , issueCommentId :: !Int } - deriving (Show, Data, Typeable, Eq, Ord, Generic) + deriving (Show, Data, Eq, Ord, Generic) -instance NFData IssueComment where rnf = genericRnf +instance NFData IssueComment instance Binary IssueComment -- | See @@ -108,9 +106,9 @@ | 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) + deriving (Show, Data, Enum, Bounded, Eq, Ord, Generic) -instance NFData EventType where rnf = genericRnf +instance NFData EventType instance Binary EventType -- | Issue event @@ -124,9 +122,9 @@ , issueEventIssue :: !(Maybe Issue) , issueEventLabel :: !(Maybe IssueLabel) } - deriving (Show, Data, Typeable, Eq, Ord, Generic) + deriving (Show, Data, Eq, Ord, Generic) -instance NFData IssueEvent where rnf = genericRnf +instance NFData IssueEvent instance Binary IssueEvent instance FromJSON IssueEvent where @@ -141,7 +139,7 @@ <*> o .:? "label" instance FromJSON EventType where - parseJSON = withText "EventType" $ \t -> case t of + parseJSON = withText "EventType" $ \t -> case T.toLower t of "closed" -> pure Closed "reopened" -> pure Reopened "subscribed" -> pure Subscribed @@ -169,7 +167,7 @@ "removed_from_project" -> pure RemovedFromProject "converted_note_to_issue" -> pure ConvertedNoteToIssue "unsubscribed" -> pure Unsubscribed -- not in api docs list - _ -> fail $ "Unknown EventType " ++ show t + _ -> fail $ "Unknown EventType: " <> T.unpack t instance FromJSON IssueComment where parseJSON = withObject "IssueComment" $ \o -> IssueComment @@ -201,21 +199,25 @@ <*> o .: "id" <*> o .: "comments" <*> o .:? "milestone" + <*> o .:? "state_reason" instance ToJSON NewIssue where - toJSON (NewIssue t b a m ls) = object + toJSON (NewIssue t b a m ls) = object $ filter notNull [ "title" .= t , "body" .= b - , "assignee" .= a + , "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 $ + toJSON (EditIssue t b a s m ls) = object $ filter notNull [ "title" .= t , "body" .= b - , "assignee" .= a + , "assignees" .= a , "state" .= s , "milestone" .= m , "labels" .= ls diff --git a/src/GitHub/Data/Milestone.hs b/src/GitHub/Data/Milestone.hs --- a/src/GitHub/Data/Milestone.hs +++ b/src/GitHub/Data/Milestone.hs @@ -1,8 +1,3 @@ ------------------------------------------------------------------------------ --- | --- License : BSD-3-Clause --- Maintainer : Oleg Grenrus --- module GitHub.Data.Milestone where import GitHub.Data.Definitions @@ -23,9 +18,9 @@ , milestoneCreatedAt :: !UTCTime , milestoneState :: !Text } - deriving (Show, Data, Typeable, Eq, Ord, Generic) + deriving (Show, Data, Eq, Ord, Generic) -instance NFData Milestone where rnf = genericRnf +instance NFData Milestone instance Binary Milestone instance FromJSON Milestone where @@ -40,3 +35,49 @@ <*> o .: "url" <*> o .: "created_at" <*> o .: "state" + +data NewMilestone = NewMilestone + { newMilestoneTitle :: !Text + , newMilestoneState :: !Text + , newMilestoneDescription :: !(Maybe Text) + , newMilestoneDueOn :: !(Maybe UTCTime) + } + deriving (Show, Data, Eq, Ord, Generic) + +instance NFData NewMilestone +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, Eq, Ord, Generic) + +instance NFData UpdateMilestone +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 diff --git a/src/GitHub/Data/Name.hs b/src/GitHub/Data/Name.hs --- a/src/GitHub/Data/Name.hs +++ b/src/GitHub/Data/Name.hs @@ -1,9 +1,3 @@ -{-# LANGUAGE CPP #-} ------------------------------------------------------------------------------ --- | --- License : BSD-3-Clause --- Maintainer : Oleg Grenrus --- module GitHub.Data.Name ( Name(..), mkName, @@ -13,13 +7,11 @@ 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) + deriving (Eq, Ord, Show, Generic, Data) -- | Smart constructor for 'Name' mkName :: proxy entity -> Text -> Name entity @@ -43,7 +35,6 @@ 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 @@ -51,4 +42,3 @@ -- | @since 0.15.0.0 instance FromJSONKey (Name entity) where fromJSONKey = fromJSONKeyCoerce -#endif diff --git a/src/GitHub/Data/Options.hs b/src/GitHub/Data/Options.hs --- a/src/GitHub/Data/Options.hs +++ b/src/GitHub/Data/Options.hs @@ -1,10 +1,9 @@ {-# LANGUAGE RecordWildCards #-} ------------------------------------------------------------------------------ +{-# LANGUAGE LambdaCase #-} + -- | --- License : BSD-3-Clause --- Maintainer : Oleg Grenrus --- -- Module with modifiers for pull requests' and issues' listings. + module GitHub.Data.Options ( -- * Common modifiers stateOpen, @@ -38,14 +37,44 @@ -- * Repo issues IssueRepoMod, issueRepoModToQueryString, + optionsCreator, + optionsMentioned, optionsIrrelevantMilestone, optionsAnyMilestone, optionsNoMilestone, + optionsMilestone, optionsIrrelevantAssignee, optionsAnyAssignee, optionsNoAssignee, + optionsAssignee, + -- * Actions artifacts + ArtifactMod, + artifactModToQueryString, + optionsArtifactName, + -- * Actions cache + CacheMod, + cacheModToQueryString, + optionsRef, + optionsNoRef, + optionsKey, + optionsNoKey, + optionsDirectionAsc, + optionsDirectionDesc, + sortByCreatedAt, + sortByLastAccessedAt, + sortBySizeInBytes, + -- * Actions workflow runs + WorkflowRunMod, + workflowRunModToQueryString, + optionsWorkflowRunActor, + optionsWorkflowRunBranch, + optionsWorkflowRunEvent, + optionsWorkflowRunStatus, + optionsWorkflowRunCreated, + optionsWorkflowRunHeadSha, -- * Data IssueState (..), + IssueStateReason (..), MergeableState (..), -- * Internal HasState, @@ -75,20 +104,48 @@ = StateOpen | StateClosed deriving - (Eq, Ord, Show, Enum, Bounded, Generic, Typeable, Data) + (Eq, Ord, Show, Enum, Bounded, Generic, Data) instance ToJSON IssueState where toJSON StateOpen = String "open" toJSON StateClosed = String "closed" instance FromJSON IssueState where - parseJSON (String "open") = pure StateOpen - parseJSON (String "closed") = pure StateClosed - parseJSON v = typeMismatch "IssueState" v + 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 NFData IssueState instance Binary IssueState +-- | 'GitHub.Data.Issues.Issue' state reason +data IssueStateReason + = StateReasonCompleted + | StateReasonDuplicate + | StateReasonNotPlanned + | StateReasonReopened + deriving + (Eq, Ord, Show, Enum, Bounded, Generic, Data) + +instance ToJSON IssueStateReason where + toJSON = String . \case + StateReasonCompleted -> "completed" + StateReasonDuplicate -> "duplicate" + StateReasonNotPlanned -> "not_planned" + StateReasonReopened -> "reopened" + +instance FromJSON IssueStateReason where + parseJSON = withText "IssueStateReason" $ \t -> case T.toLower t of + "completed" -> pure StateReasonCompleted + "duplicate" -> pure StateReasonDuplicate + "not_planned" -> pure StateReasonNotPlanned + "reopened" -> pure StateReasonReopened + _ -> fail $ "Unknown IssueStateReason: " <> T.unpack t + +instance NFData IssueStateReason +instance Binary IssueStateReason + -- | 'GitHub.Data.PullRequests.PullRequest' mergeable_state data MergeableState = StateUnknown @@ -97,8 +154,9 @@ | StateUnstable | StateBlocked | StateBehind + | StateDraft deriving - (Eq, Ord, Show, Enum, Bounded, Generic, Typeable, Data) + (Eq, Ord, Show, Enum, Bounded, Generic, Data) instance ToJSON MergeableState where toJSON StateUnknown = String "unknown" @@ -107,26 +165,29 @@ toJSON StateUnstable = String "unstable" toJSON StateBlocked = String "blocked" toJSON StateBehind = String "behind" + toJSON StateDraft = String "draft" instance FromJSON MergeableState where - parseJSON (String "unknown") = pure StateUnknown - parseJSON (String "clean") = pure StateClean - parseJSON (String "dirty") = pure StateDirty - parseJSON (String "unstable") = pure StateUnstable - parseJSON (String "blocked") = pure StateBlocked - parseJSON (String "behind") = pure StateBehind - parseJSON v = typeMismatch "MergeableState" v + 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 + "draft" -> pure StateDraft + _ -> fail $ "Unknown MergeableState: " <> T.unpack t -instance NFData MergeableState where rnf = genericRnf +instance NFData MergeableState instance Binary MergeableState data SortDirection = SortAscending | SortDescending deriving - (Eq, Ord, Show, Enum, Bounded, Generic, Typeable, Data) + (Eq, Ord, Show, Enum, Bounded, Generic, Data) -instance NFData SortDirection where rnf = genericRnf +instance NFData SortDirection instance Binary SortDirection -- PR @@ -137,9 +198,9 @@ | SortPRPopularity | SortPRLongRunning deriving - (Eq, Ord, Show, Enum, Bounded, Generic, Typeable, Data) + (Eq, Ord, Show, Enum, Bounded, Generic, Data) -instance NFData SortPR where rnf = genericRnf +instance NFData SortPR instance Binary SortPR -- Issue @@ -150,9 +211,9 @@ | IssueFilterSubscribed | IssueFilterAll deriving - (Eq, Ord, Show, Enum, Bounded, Generic, Typeable, Data) + (Eq, Ord, Show, Enum, Bounded, Generic, Data) -instance NFData IssueFilter where rnf = genericRnf +instance NFData IssueFilter instance Binary IssueFilter data SortIssue @@ -160,9 +221,9 @@ | SortIssueUpdated | SortIssueComments deriving - (Eq, Ord, Show, Enum, Bounded, Generic, Typeable, Data) + (Eq, Ord, Show, Enum, Bounded, Generic, Data) -instance NFData SortIssue where rnf = genericRnf +instance NFData SortIssue instance Binary SortIssue data FilterBy a @@ -173,8 +234,20 @@ -- ^ e.g. for milestones "any" means "any milestone". -- I.e. won't show issues without mileston specified deriving - (Eq, Ord, Show, Generic, Typeable, Data) + (Eq, Ord, Show, Generic, Data) +-- Actions cache + +data SortCache + = SortCacheCreatedAt + | SortCacheLastAccessedAt + | SortCacheSizeInBytes + deriving + (Eq, Ord, Show, Enum, Bounded, Generic, Data) + +instance NFData SortCache +instance Binary SortCache + ------------------------------------------------------------------------------- -- Classes ------------------------------------------------------------------------------- @@ -261,7 +334,7 @@ , pullRequestOptionsDirection :: !SortDirection } deriving - (Eq, Ord, Show, Generic, Typeable, Data) + (Eq, Ord, Show, Generic, Data) defaultPullRequestOptions :: PullRequestOptions defaultPullRequestOptions = PullRequestOptions @@ -346,7 +419,7 @@ -- Issues ------------------------------------------------------------------------------- --- | See . +-- | See . data IssueOptions = IssueOptions { issueOptionsFilter :: !IssueFilter , issueOptionsState :: !(Maybe IssueState) @@ -356,7 +429,7 @@ , issueOptionsSince :: !(Maybe UTCTime) } deriving - (Eq, Ord, Show, Generic, Typeable, Data) + (Eq, Ord, Show, Generic, Data) defaultIssueOptions :: IssueOptions defaultIssueOptions = IssueOptions @@ -368,7 +441,7 @@ , issueOptionsSince = Nothing } --- | See . +-- | See . newtype IssueMod = IssueMod (IssueOptions -> IssueOptions) instance Semigroup IssueMod where @@ -486,19 +559,23 @@ -- Issues repo ------------------------------------------------------------------------------- +-- | Parameters of "list repository issues" (@get /repos/{owner}/{repo}/issues@). +-- +-- See . +-- 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) + { issueRepoOptionsMilestone :: !(FilterBy (Id Milestone)) -- ^ 'optionsMilestone' etc. + , issueRepoOptionsState :: !(Maybe IssueState) -- ^ 'HasState' + , issueRepoOptionsAssignee :: !(FilterBy (Name User)) -- ^ 'optionsAssignee' etc. + , issueRepoOptionsCreator :: !(Maybe (Name User)) -- ^ 'optionsCreator' + , issueRepoOptionsMentioned :: !(Maybe (Name User)) -- ^ 'optionsMentioned' + , issueRepoOptionsLabels :: ![Name IssueLabel] -- ^ 'HasLabels' + , issueRepoOptionsSort :: !SortIssue -- ^ 'HasCreatedUpdated' and 'HasComments' + , issueRepoOptionsDirection :: !SortDirection -- ^ 'HasDirection' + , issueRepoOptionsSince :: !(Maybe UTCTime) -- ^ 'HasSince' } deriving - (Eq, Ord, Show, Generic, Typeable, Data) + (Eq, Ord, Show, Generic, Data) defaultIssueRepoOptions :: IssueRepoOptions defaultIssueRepoOptions = IssueRepoOptions @@ -574,7 +651,17 @@ -- Issues repo modifiers ------------------------------------------------------------------------------- --- | Don't care about milestones. +-- | Issues created by a certain user. +optionsCreator :: Name User -> IssueRepoMod +optionsCreator u = IssueRepoMod $ \opts -> + opts { issueRepoOptionsCreator = Just u } + +-- | Issue mentioning the given user. +optionsMentioned :: Name User -> IssueRepoMod +optionsMentioned u = IssueRepoMod $ \opts -> + opts { issueRepoOptionsMentioned = Just u } + +-- | Don't care about milestones (default). -- -- 'optionsAnyMilestone' means there should be some milestone, but it can be any. -- @@ -583,22 +670,270 @@ optionsIrrelevantMilestone = IssueRepoMod $ \opts -> opts { issueRepoOptionsMilestone = FilterNotSpecified } +-- | Issues that have a milestone. optionsAnyMilestone :: IssueRepoMod optionsAnyMilestone = IssueRepoMod $ \opts -> opts { issueRepoOptionsMilestone = FilterAny } +-- | Issues that have no milestone. optionsNoMilestone :: IssueRepoMod optionsNoMilestone = IssueRepoMod $ \opts -> opts { issueRepoOptionsMilestone = FilterNone } +-- | Issues with the given milestone. +optionsMilestone :: Id Milestone -> IssueRepoMod +optionsMilestone m = IssueRepoMod $ \opts -> + opts { issueRepoOptionsMilestone = FilterBy m } + +-- | Issues with or without assignee (default). optionsIrrelevantAssignee :: IssueRepoMod optionsIrrelevantAssignee = IssueRepoMod $ \opts -> opts { issueRepoOptionsAssignee = FilterNotSpecified } +-- | Issues assigned to someone. optionsAnyAssignee :: IssueRepoMod optionsAnyAssignee = IssueRepoMod $ \opts -> opts { issueRepoOptionsAssignee = FilterAny } +-- | Issues assigned to nobody. optionsNoAssignee :: IssueRepoMod optionsNoAssignee = IssueRepoMod $ \opts -> opts { issueRepoOptionsAssignee = FilterNone } + +-- | Issues assigned to a specific user. +optionsAssignee :: Name User -> IssueRepoMod +optionsAssignee u = IssueRepoMod $ \opts -> + opts { issueRepoOptionsAssignee = FilterBy u } + +------------------------------------------------------------------------------- +-- Actions artifacts +------------------------------------------------------------------------------- + +-- | See . +data ArtifactOptions = ArtifactOptions + { artifactOptionsName :: !(Maybe Text) + } + deriving + (Eq, Ord, Show, Generic, Data) + +defaultArtifactOptions :: ArtifactOptions +defaultArtifactOptions = ArtifactOptions + { artifactOptionsName = Nothing + } + +-- | See . +newtype ArtifactMod = ArtifactMod (ArtifactOptions -> ArtifactOptions) + +instance Semigroup ArtifactMod where + ArtifactMod f <> ArtifactMod g = ArtifactMod (g . f) + +instance Monoid ArtifactMod where + mempty = ArtifactMod id + mappend = (<>) + +-- | Filters artifacts by exact match on their name field. +optionsArtifactName :: Text -> ArtifactMod +optionsArtifactName n = ArtifactMod $ \opts -> + opts { artifactOptionsName = Just n } + +toArtifactOptions :: ArtifactMod -> ArtifactOptions +toArtifactOptions (ArtifactMod f) = f defaultArtifactOptions + +artifactModToQueryString :: ArtifactMod -> QueryString +artifactModToQueryString = artifactOptionsToQueryString . toArtifactOptions + +artifactOptionsToQueryString :: ArtifactOptions -> QueryString +artifactOptionsToQueryString (ArtifactOptions name) = + catMaybes + [ mk "name" <$> name' + ] + where + mk k v = (k, Just v) + name' = fmap TE.encodeUtf8 name + +------------------------------------------------------------------------------- +-- Actions cache +------------------------------------------------------------------------------- + +-- | See . +data CacheOptions = CacheOptions + { cacheOptionsRef :: !(Maybe Text) + , cacheOptionsKey :: !(Maybe Text) + , cacheOptionsSort :: !(Maybe SortCache) + , cacheOptionsDirection :: !(Maybe SortDirection) + } + deriving + (Eq, Ord, Show, Generic, Data) + +defaultCacheOptions :: CacheOptions +defaultCacheOptions = CacheOptions + { cacheOptionsRef = Nothing + , cacheOptionsKey = Nothing + , cacheOptionsSort = Nothing + , cacheOptionsDirection = Nothing + } + +-- | See . +newtype CacheMod = CacheMod (CacheOptions -> CacheOptions) + +instance Semigroup CacheMod where + CacheMod f <> CacheMod g = CacheMod (g . f) + +instance Monoid CacheMod where + mempty = CacheMod id + mappend = (<>) + +toCacheOptions :: CacheMod -> CacheOptions +toCacheOptions (CacheMod f) = f defaultCacheOptions + +cacheModToQueryString :: CacheMod -> QueryString +cacheModToQueryString = cacheOptionsToQueryString . toCacheOptions + +cacheOptionsToQueryString :: CacheOptions -> QueryString +cacheOptionsToQueryString (CacheOptions ref key sort dir) = + catMaybes + [ mk "ref" <$> ref' + , mk "key" <$> key' + , mk "sort" <$> sort' + , mk "directions" <$> direction' + ] + where + mk k v = (k, Just v) + sort' = sort <&> \case + SortCacheCreatedAt -> "created_at" + SortCacheLastAccessedAt -> "last_accessed_at" + SortCacheSizeInBytes -> "size_in_bytes" + direction' = dir <&> \case + SortDescending -> "desc" + SortAscending -> "asc" + ref' = fmap TE.encodeUtf8 ref + key' = fmap TE.encodeUtf8 key + +------------------------------------------------------------------------------- +-- Cache modifiers +------------------------------------------------------------------------------- + +optionsRef :: Text -> CacheMod +optionsRef x = CacheMod $ \opts -> + opts { cacheOptionsRef = Just x } + +optionsNoRef :: CacheMod +optionsNoRef = CacheMod $ \opts -> + opts { cacheOptionsRef = Nothing } + +optionsKey :: Text -> CacheMod +optionsKey x = CacheMod $ \opts -> + opts { cacheOptionsKey = Just x } + +optionsNoKey :: CacheMod +optionsNoKey = CacheMod $ \opts -> + opts { cacheOptionsKey = Nothing } + +optionsDirectionAsc :: CacheMod +optionsDirectionAsc = CacheMod $ \opts -> + opts { cacheOptionsDirection = Just SortAscending } + +optionsDirectionDesc :: CacheMod +optionsDirectionDesc = CacheMod $ \opts -> + opts { cacheOptionsDirection = Just SortDescending } + +sortByCreatedAt :: CacheMod +sortByCreatedAt = CacheMod $ \opts -> + opts { cacheOptionsSort = Just SortCacheCreatedAt } + +sortByLastAccessedAt :: CacheMod +sortByLastAccessedAt = CacheMod $ \opts -> + opts { cacheOptionsSort = Just SortCacheLastAccessedAt } + +sortBySizeInBytes :: CacheMod +sortBySizeInBytes = CacheMod $ \opts -> + opts { cacheOptionsSort = Just SortCacheSizeInBytes } + +------------------------------------------------------------------------------- +-- Actions workflow runs +------------------------------------------------------------------------------- + +-- | See . +data WorkflowRunOptions = WorkflowRunOptions + { workflowRunOptionsActor :: !(Maybe Text) + , workflowRunOptionsBranch :: !(Maybe Text) + , workflowRunOptionsEvent :: !(Maybe Text) + , workflowRunOptionsStatus :: !(Maybe Text) + , workflowRunOptionsCreated :: !(Maybe Text) + , workflowRunOptionsHeadSha :: !(Maybe Text) + } + deriving + (Eq, Ord, Show, Generic, Data) + +defaultWorkflowRunOptions :: WorkflowRunOptions +defaultWorkflowRunOptions = WorkflowRunOptions + { workflowRunOptionsActor = Nothing + , workflowRunOptionsBranch = Nothing + , workflowRunOptionsEvent = Nothing + , workflowRunOptionsStatus = Nothing + , workflowRunOptionsCreated = Nothing + , workflowRunOptionsHeadSha = Nothing + } + +-- | See . +newtype WorkflowRunMod = WorkflowRunMod (WorkflowRunOptions -> WorkflowRunOptions) + +instance Semigroup WorkflowRunMod where + WorkflowRunMod f <> WorkflowRunMod g = WorkflowRunMod (g . f) + +instance Monoid WorkflowRunMod where + mempty = WorkflowRunMod id + mappend = (<>) + +toWorkflowRunOptions :: WorkflowRunMod -> WorkflowRunOptions +toWorkflowRunOptions (WorkflowRunMod f) = f defaultWorkflowRunOptions + +workflowRunModToQueryString :: WorkflowRunMod -> QueryString +workflowRunModToQueryString = workflowRunOptionsToQueryString . toWorkflowRunOptions + +workflowRunOptionsToQueryString :: WorkflowRunOptions -> QueryString +workflowRunOptionsToQueryString (WorkflowRunOptions actor branch event status created headSha) = + catMaybes + [ mk "actor" <$> actor' + , mk "branch" <$> branch' + , mk "event" <$> event' + , mk "status" <$> status' + , mk "created" <$> created' + , mk "head_sha" <$> headSha' + ] + where + mk k v = (k, Just v) + actor' = fmap TE.encodeUtf8 actor + branch' = fmap TE.encodeUtf8 branch + event' = fmap TE.encodeUtf8 event + status' = fmap TE.encodeUtf8 status + created' = fmap TE.encodeUtf8 created + headSha' = fmap TE.encodeUtf8 headSha + +------------------------------------------------------------------------------- +-- Workflow run modifiers +------------------------------------------------------------------------------- + +optionsWorkflowRunActor :: Text -> WorkflowRunMod +optionsWorkflowRunActor x = WorkflowRunMod $ \opts -> + opts { workflowRunOptionsActor = Just x } + +optionsWorkflowRunBranch :: Text -> WorkflowRunMod +optionsWorkflowRunBranch x = WorkflowRunMod $ \opts -> + opts { workflowRunOptionsBranch = Just x } + +optionsWorkflowRunEvent :: Text -> WorkflowRunMod +optionsWorkflowRunEvent x = WorkflowRunMod $ \opts -> + opts { workflowRunOptionsEvent = Just x } + +optionsWorkflowRunStatus :: Text -> WorkflowRunMod +optionsWorkflowRunStatus x = WorkflowRunMod $ \opts -> + opts { workflowRunOptionsStatus = Just x } + +optionsWorkflowRunCreated :: Text -> WorkflowRunMod +optionsWorkflowRunCreated x = WorkflowRunMod $ \opts -> + opts { workflowRunOptionsCreated = Just x } + +optionsWorkflowRunHeadSha :: Text -> WorkflowRunMod +optionsWorkflowRunHeadSha x = WorkflowRunMod $ \opts -> + opts { workflowRunOptionsHeadSha = Just x } diff --git a/src/GitHub/Data/PublicSSHKeys.hs b/src/GitHub/Data/PublicSSHKeys.hs new file mode 100644 --- /dev/null +++ b/src/GitHub/Data/PublicSSHKeys.hs @@ -0,0 +1,60 @@ +----------------------------------------------------------------------------- +-- | +-- 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, 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, 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, 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" diff --git a/src/GitHub/Data/PullRequests.hs b/src/GitHub/Data/PullRequests.hs --- a/src/GitHub/Data/PullRequests.hs +++ b/src/GitHub/Data/PullRequests.hs @@ -1,8 +1,3 @@ ------------------------------------------------------------------------------ --- | --- License : BSD-3-Clause --- Maintainer : Oleg Grenrus --- module GitHub.Data.PullRequests ( SimplePullRequest(..), PullRequest(..), @@ -14,15 +9,14 @@ PullRequestEventType(..), PullRequestReference(..), MergeResult(..), - statusMerge, ) where import GitHub.Data.Definitions import GitHub.Data.Id (Id) import GitHub.Data.Options (IssueState (..), MergeableState (..)) import GitHub.Data.Repos (Repo) -import GitHub.Data.Request (StatusMap) import GitHub.Data.URL (URL) +import GitHub.Data.Teams (SimpleTeam) import GitHub.Internal.Prelude import Prelude () @@ -34,12 +28,13 @@ , simplePullRequestUser :: !SimpleUser , simplePullRequestPatchUrl :: !URL , simplePullRequestState :: !IssueState - , simplePullRequestNumber :: !Int + , simplePullRequestNumber :: !IssueNumber , simplePullRequestHtmlUrl :: !URL , simplePullRequestUpdatedAt :: !UTCTime , simplePullRequestBody :: !(Maybe Text) , simplePullRequestAssignees :: (Vector SimpleUser) , simplePullRequestRequestedReviewers :: (Vector SimpleUser) + , simplePullRequestRequestedTeamReviewers:: (Vector SimpleTeam) , simplePullRequestIssueUrl :: !URL , simplePullRequestDiffUrl :: !URL , simplePullRequestUrl :: !URL @@ -48,9 +43,9 @@ , simplePullRequestTitle :: !Text , simplePullRequestId :: !(Id PullRequest) } - deriving (Show, Data, Typeable, Eq, Ord, Generic) + deriving (Show, Data, Eq, Ord, Generic) -instance NFData SimplePullRequest where rnf = genericRnf +instance NFData SimplePullRequest instance Binary SimplePullRequest data PullRequest = PullRequest @@ -59,12 +54,13 @@ , pullRequestUser :: !SimpleUser , pullRequestPatchUrl :: !URL , pullRequestState :: !IssueState - , pullRequestNumber :: !Int + , pullRequestNumber :: !IssueNumber , pullRequestHtmlUrl :: !URL , pullRequestUpdatedAt :: !UTCTime , pullRequestBody :: !(Maybe Text) , pullRequestAssignees :: (Vector SimpleUser) , pullRequestRequestedReviewers :: (Vector SimpleUser) + , pullRequestRequestedTeamReviewers :: (Vector SimpleTeam) , pullRequestIssueUrl :: !URL , pullRequestDiffUrl :: !URL , pullRequestUrl :: !URL @@ -85,9 +81,9 @@ , pullRequestMergeable :: !(Maybe Bool) , pullRequestMergeableState :: !MergeableState } - deriving (Show, Data, Typeable, Eq, Ord, Generic) + deriving (Show, Data, Eq, Ord, Generic) -instance NFData PullRequest where rnf = genericRnf +instance NFData PullRequest instance Binary PullRequest data EditPullRequest = EditPullRequest @@ -100,7 +96,7 @@ } deriving (Show, Generic) -instance NFData EditPullRequest where rnf = genericRnf +instance NFData EditPullRequest instance Binary EditPullRequest data CreatePullRequest @@ -117,7 +113,7 @@ } deriving (Show, Generic) -instance NFData CreatePullRequest where rnf = genericRnf +instance NFData CreatePullRequest instance Binary CreatePullRequest data PullRequestLinks = PullRequestLinks @@ -126,9 +122,9 @@ , pullRequestLinksHtml :: !URL , pullRequestLinksSelf :: !URL } - deriving (Show, Data, Typeable, Eq, Ord, Generic) + deriving (Show, Data, Eq, Ord, Generic) -instance NFData PullRequestLinks where rnf = genericRnf +instance NFData PullRequestLinks instance Binary PullRequestLinks data PullRequestCommit = PullRequestCommit @@ -138,9 +134,9 @@ , pullRequestCommitUser :: !SimpleUser , pullRequestCommitRepo :: !(Maybe Repo) } - deriving (Show, Data, Typeable, Eq, Ord, Generic) + deriving (Show, Data, Eq, Ord, Generic) -instance NFData PullRequestCommit where rnf = genericRnf +instance NFData PullRequestCommit instance Binary PullRequestCommit data PullRequestEvent = PullRequestEvent @@ -150,9 +146,9 @@ , pullRequestRepository :: !Repo , pullRequestSender :: !SimpleUser } - deriving (Show, Data, Typeable, Eq, Ord, Generic) + deriving (Show, Data, Eq, Ord, Generic) -instance NFData PullRequestEvent where rnf = genericRnf +instance NFData PullRequestEvent instance Binary PullRequestEvent data PullRequestEventType @@ -167,9 +163,9 @@ | PullRequestReviewRequested | PullRequestReviewRequestRemoved | PullRequestEdited - deriving (Show, Data, Typeable, Eq, Ord, Generic) + deriving (Show, Data, Eq, Ord, Generic) -instance NFData PullRequestEventType where rnf = genericRnf +instance NFData PullRequestEventType instance Binary PullRequestEventType data PullRequestReference = PullRequestReference @@ -177,9 +173,9 @@ , pullRequestReferencePatchUrl :: !(Maybe URL) , pullRequestReferenceDiffUrl :: !(Maybe URL) } - deriving (Eq, Ord, Show, Generic, Typeable, Data) + deriving (Eq, Ord, Show, Generic, Data) -instance NFData PullRequestReference where rnf = genericRnf +instance NFData PullRequestReference instance Binary PullRequestReference @@ -200,6 +196,7 @@ <*> o .:? "body" <*> o .: "assignees" <*> o .:? "requested_reviewers" .!= mempty + <*> o .:? "requested_teams" .!= mempty <*> o .: "issue_url" <*> o .: "diff_url" <*> o .: "url" @@ -241,6 +238,7 @@ <*> o .:? "body" <*> o .: "assignees" <*> o .:? "requested_reviewers" .!= mempty + <*> o .:? "requested_teams" .!= mempty <*> o .: "issue_url" <*> o .: "diff_url" <*> o .: "url" @@ -285,19 +283,19 @@ <*> o .: "sender" instance FromJSON PullRequestEventType where - parseJSON (String "opened") = pure PullRequestOpened - parseJSON (String "closed") = pure PullRequestClosed - parseJSON (String "synchronize") = pure PullRequestSynchronized - parseJSON (String "reopened") = pure PullRequestReopened - parseJSON (String "assigned") = pure PullRequestAssigned - parseJSON (String "unassigned") = pure PullRequestUnassigned - parseJSON (String "labeled") = pure PullRequestLabeled - parseJSON (String "unlabeled") = pure PullRequestUnlabeled - parseJSON (String "review_requested") = pure PullRequestReviewRequested - parseJSON (String "review_request_removed") = pure PullRequestReviewRequestRemoved - parseJSON (String "edited") = pure PullRequestEdited - parseJSON (String s) = fail $ "Unknown action type " <> T.unpack s - parseJSON v = typeMismatch "Could not build a PullRequestEventType" v + 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 @@ -318,11 +316,4 @@ = MergeSuccessful | MergeCannotPerform | MergeConflict - deriving (Eq, Ord, Read, Show, Enum, Bounded, Generic, Typeable) - -statusMerge :: StatusMap MergeResult -statusMerge = - [ (200, MergeSuccessful) - , (405, MergeCannotPerform) - , (409, MergeConflict) - ] + deriving (Eq, Ord, Read, Show, Enum, Bounded, Generic) diff --git a/src/GitHub/Data/RateLimit.hs b/src/GitHub/Data/RateLimit.hs new file mode 100644 --- /dev/null +++ b/src/GitHub/Data/RateLimit.hs @@ -0,0 +1,61 @@ +module GitHub.Data.RateLimit where + +import GitHub.Internal.Prelude +import Prelude () + +import Data.Time.Clock.System (SystemTime (..)) + +import qualified Data.ByteString.Char8 as BS8 +import qualified Network.HTTP.Client as HTTP + +data Limits = Limits + { limitsMax :: !Int + , limitsRemaining :: !Int + , limitsReset :: !SystemTime + } + deriving (Show, Eq, Ord, Generic) + +instance NFData Limits +instance Binary Limits + +instance FromJSON Limits where + parseJSON = withObject "Limits" $ \obj -> Limits + <$> obj .: "limit" + <*> obj .: "remaining" + <*> fmap (\t -> MkSystemTime t 0) (obj .: "reset") + +data RateLimit = RateLimit + { rateLimitCore :: Limits + , rateLimitSearch :: Limits + , rateLimitGraphQL :: Limits + } + deriving (Show, Eq, Ord, Generic) + +instance NFData RateLimit +instance Binary RateLimit + +instance FromJSON RateLimit where + parseJSON = withObject "RateLimit" $ \obj -> do + resources <- obj .: "resources" + RateLimit + <$> resources .: "core" + <*> resources .: "search" + <*> resources .: "graphql" + +------------------------------------------------------------------------------- +-- Extras +------------------------------------------------------------------------------- + +-- | @since 0.24 +limitsFromHttpResponse :: HTTP.Response a -> Maybe Limits +limitsFromHttpResponse res = do + let hdrs = HTTP.responseHeaders res + m <- lookup "X-RateLimit-Limit" hdrs >>= readIntegral + r <- lookup "X-RateLimit-Remaining" hdrs >>= readIntegral + t <- lookup "X-RateLimit-Reset" hdrs >>= readIntegral + return (Limits m r (MkSystemTime t 0)) + where + readIntegral :: Num a => BS8.ByteString -> Maybe a + readIntegral bs = case BS8.readInt bs of + Just (n, bs') | BS8.null bs' -> Just (fromIntegral n) + _ -> Nothing diff --git a/src/GitHub/Data/Reactions.hs b/src/GitHub/Data/Reactions.hs new file mode 100644 --- /dev/null +++ b/src/GitHub/Data/Reactions.hs @@ -0,0 +1,78 @@ +{-# LANGUAGE InstanceSigs #-} +module GitHub.Data.Reactions where + +import qualified Data.Text as T +import GitHub.Data.Id (Id) +import GitHub.Data.Definitions (SimpleUser) +import GitHub.Internal.Prelude +import Prelude () + +data Reaction = Reaction + { reactionId :: Id Reaction + , reactionUser :: !(Maybe SimpleUser) + , reactionContent :: !ReactionContent + , reactionCreatedAt :: !UTCTime + } + deriving (Show, Data, Eq, Ord, Generic) + +instance NFData Reaction +instance Binary Reaction + +data NewReaction = NewReaction + { newReactionContent :: !ReactionContent + } + deriving (Show, Data, Eq, Ord, Generic) + +instance NFData NewReaction +instance Binary NewReaction + +-- | +-- +data ReactionContent + = PlusOne + | MinusOne + | Laugh + | Confused + | Heart + | Hooray + | Rocket + | Eyes + deriving (Show, Data, Eq, Ord, Enum, Bounded, Generic) + +instance NFData ReactionContent +instance Binary ReactionContent + +-- JSON instances + +instance FromJSON Reaction where + parseJSON = withObject "Reaction" $ \o -> + Reaction + <$> o .: "id" + <*> o .:? "user" + <*> o .: "content" + <*> o .: "created_at" + +instance ToJSON NewReaction where + toJSON (NewReaction content) = object ["content" .= content] + +instance FromJSON ReactionContent where + parseJSON = withText "ReactionContent" $ \case + "+1" -> pure PlusOne + "-1" -> pure MinusOne + "laugh" -> pure Laugh + "confused" -> pure Confused + "heart" -> pure Heart + "hooray" -> pure Hooray + "rocket" -> pure Rocket + "eyes" -> pure Eyes + t -> fail $ "Unknown ReactionContent: " <> T.unpack t + +instance ToJSON ReactionContent where + toJSON PlusOne = String "+1" + toJSON MinusOne = String "-1" + toJSON Laugh = String "laugh" + toJSON Confused = String "confused" + toJSON Heart = String "heart" + toJSON Hooray = String "hooray" + toJSON Rocket = String "rocket" + toJSON Eyes = String "eyes" diff --git a/src/GitHub/Data/Releases.hs b/src/GitHub/Data/Releases.hs --- a/src/GitHub/Data/Releases.hs +++ b/src/GitHub/Data/Releases.hs @@ -25,7 +25,7 @@ , releaseAuthor :: !SimpleUser , releaseAssets :: !(Vector ReleaseAsset) } - deriving (Show, Data, Typeable, Eq, Ord, Generic) + deriving (Show, Data, Eq, Ord, Generic) instance FromJSON Release where parseJSON = withObject "Event" $ \o -> Release @@ -47,7 +47,7 @@ <*> o .: "author" <*> o .: "assets" -instance NFData Release where rnf = genericRnf +instance NFData Release instance Binary Release data ReleaseAsset = ReleaseAsset @@ -64,7 +64,7 @@ , releaseAssetUpdatedAt :: !UTCTime , releaseAssetUploader :: !SimpleUser } - deriving (Show, Data, Typeable, Eq, Ord, Generic) + deriving (Show, Data, Eq, Ord, Generic) instance FromJSON ReleaseAsset where parseJSON = withObject "Event" $ \o -> ReleaseAsset @@ -81,5 +81,5 @@ <*> o .: "updated_at" <*> o .: "uploader" -instance NFData ReleaseAsset where rnf = genericRnf +instance NFData ReleaseAsset instance Binary ReleaseAsset diff --git a/src/GitHub/Data/Repos.hs b/src/GitHub/Data/Repos.hs --- a/src/GitHub/Data/Repos.hs +++ b/src/GitHub/Data/Repos.hs @@ -1,14 +1,10 @@ -{-# 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 @@ -20,88 +16,144 @@ import Prelude () import qualified Data.HashMap.Strict as HM -#if MIN_VERSION_aeson(1,0,0) +import qualified Data.Text as T 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) + { repoId :: !(Id Repo) + , repoName :: !(Name Repo) + , repoOwner :: !SimpleOwner + , repoPrivate :: !Bool , repoHtmlUrl :: !URL - , repoSvnUrl :: !(Maybe URL) - , repoForks :: !(Maybe Int) - , repoHomepage :: !(Maybe Text) + , repoDescription :: !(Maybe Text) , repoFork :: !(Maybe Bool) + , repoUrl :: !URL , repoGitUrl :: !(Maybe URL) - , repoPrivate :: !Bool - , repoArchived :: !Bool + , repoSshUrl :: !(Maybe URL) , repoCloneUrl :: !(Maybe URL) - , repoSize :: !(Maybe Int) - , repoUpdatedAt :: !(Maybe UTCTime) - , repoWatchers :: !(Maybe Int) - , repoOwner :: !SimpleOwner - , repoName :: !(Name Repo) + , repoHooksUrl :: !URL + , repoSvnUrl :: !(Maybe URL) + , repoHomepage :: !(Maybe Text) , repoLanguage :: !(Maybe Language) + , repoForksCount :: !Int + , repoStargazersCount :: !Int + , repoWatchersCount :: !Int + , repoSize :: !(Maybe Int) , repoDefaultBranch :: !(Maybe Text) - , repoPushedAt :: !(Maybe UTCTime) -- ^ this is Nothing for new repositories - , repoId :: !(Id Repo) - , repoUrl :: !URL - , repoOpenIssues :: !(Maybe Int) - , repoHasWiki :: !(Maybe Bool) + , repoOpenIssuesCount :: !Int , repoHasIssues :: !(Maybe Bool) + , repoHasProjects :: !(Maybe Bool) + , repoHasWiki :: !(Maybe Bool) + , repoHasPages :: !(Maybe Bool) , repoHasDownloads :: !(Maybe Bool) - , repoParent :: !(Maybe RepoRef) - , repoSource :: !(Maybe RepoRef) - , repoHooksUrl :: !URL - , repoStargazersCount :: !Int + , repoArchived :: !Bool + , repoDisabled :: !Bool + , repoPushedAt :: !(Maybe UTCTime) -- ^ this is Nothing for new repositories + , repoCreatedAt :: !(Maybe UTCTime) + , repoUpdatedAt :: !(Maybe UTCTime) + , repoPermissions :: !(Maybe RepoPermissions) -- ^ Repository permissions as they relate to the authenticated user. } - deriving (Show, Data, Typeable, Eq, Ord, Generic) + deriving (Show, Data, Eq, Ord, Generic) -instance NFData Repo where rnf = genericRnf +instance NFData Repo instance Binary Repo +data CodeSearchRepo = CodeSearchRepo + { codeSearchRepoId :: !(Id Repo) + , codeSearchRepoName :: !(Name Repo) + , codeSearchRepoOwner :: !SimpleOwner + , codeSearchRepoPrivate :: !Bool + , codeSearchRepoHtmlUrl :: !URL + , codeSearchRepoDescription :: !(Maybe Text) + , codeSearchRepoFork :: !(Maybe Bool) + , codeSearchRepoUrl :: !URL + , codeSearchRepoGitUrl :: !(Maybe URL) + , codeSearchRepoSshUrl :: !(Maybe URL) + , codeSearchRepoCloneUrl :: !(Maybe URL) + , codeSearchRepoHooksUrl :: !URL + , codeSearchRepoSvnUrl :: !(Maybe URL) + , codeSearchRepoHomepage :: !(Maybe Text) + , codeSearchRepoLanguage :: !(Maybe Language) + , codeSearchRepoSize :: !(Maybe Int) + , codeSearchRepoDefaultBranch :: !(Maybe Text) + , codeSearchRepoHasIssues :: !(Maybe Bool) + , codeSearchRepoHasProjects :: !(Maybe Bool) + , codeSearchRepoHasWiki :: !(Maybe Bool) + , codeSearchRepoHasPages :: !(Maybe Bool) + , codeSearchRepoHasDownloads :: !(Maybe Bool) + , codeSearchRepoArchived :: !Bool + , codeSearchRepoDisabled :: !Bool + , codeSearchRepoPushedAt :: !(Maybe UTCTime) -- ^ this is Nothing for new repositories + , codeSearchRepoCreatedAt :: !(Maybe UTCTime) + , codeSearchRepoUpdatedAt :: !(Maybe UTCTime) + , codeSearchRepoPermissions :: !(Maybe RepoPermissions) -- ^ Repository permissions as they relate to the authenticated user. + } + deriving (Show, Data, Eq, Ord, Generic) + +instance NFData CodeSearchRepo +instance Binary CodeSearchRepo + +-- | Repository permissions, as they relate to the authenticated user. +-- +-- Returned by for example 'GitHub.Endpoints.Repos.currentUserReposR' +data RepoPermissions = RepoPermissions + { repoPermissionAdmin :: !Bool + , repoPermissionPush :: !Bool + , repoPermissionPull :: !Bool + } + deriving (Show, Data, Eq, Ord, Generic) + +instance NFData RepoPermissions +instance Binary RepoPermissions + data RepoRef = RepoRef { repoRefOwner :: !SimpleOwner , repoRefRepo :: !(Name Repo) } - deriving (Show, Data, Typeable, Eq, Ord, Generic) + deriving (Show, Data, Eq, Ord, Generic) -instance NFData RepoRef where rnf = genericRnf +instance NFData RepoRef 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) + { newRepoName :: !(Name Repo) + , newRepoDescription :: !(Maybe Text) + , newRepoHomepage :: !(Maybe Text) + , newRepoPrivate :: !(Maybe Bool) + , newRepoHasIssues :: !(Maybe Bool) + , newRepoHasProjects :: !(Maybe Bool) + , newRepoHasWiki :: !(Maybe Bool) + , newRepoAutoInit :: !(Maybe Bool) + , newRepoGitignoreTemplate :: !(Maybe Text) + , newRepoLicenseTemplate :: !(Maybe Text) + , newRepoAllowSquashMerge :: !(Maybe Bool) + , newRepoAllowMergeCommit :: !(Maybe Bool) + , newRepoAllowRebaseMerge :: !(Maybe Bool) + } deriving (Eq, Ord, Show, Data, Generic) -instance NFData NewRepo where rnf = genericRnf +instance NFData NewRepo instance Binary NewRepo newRepo :: Name Repo -> NewRepo -newRepo name = NewRepo name Nothing Nothing Nothing Nothing Nothing Nothing +newRepo name = NewRepo name Nothing Nothing Nothing Nothing Nothing Nothing 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) + { editName :: !(Maybe (Name Repo)) + , editDescription :: !(Maybe Text) + , editHomepage :: !(Maybe Text) + , editPrivate :: !(Maybe Bool) + , editHasIssues :: !(Maybe Bool) + , editHasProjects :: !(Maybe Bool) + , editHasWiki :: !(Maybe Bool) + , editDefaultBranch :: !(Maybe Text) + , editAllowSquashMerge :: !(Maybe Bool) + , editAllowMergeCommit :: !(Maybe Bool) + , editAllowRebaseMerge :: !(Maybe Bool) + , editArchived :: !(Maybe Bool) } - deriving (Eq, Ord, Show, Data, Typeable, Generic) + deriving (Eq, Ord, Show, Data, Generic) -instance NFData EditRepo where rnf = genericRnf +instance NFData EditRepo instance Binary EditRepo -- | Filter the list of the user's repos using any of these constructors. @@ -111,19 +163,19 @@ | 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) + deriving (Show, Eq, Ord, Enum, Bounded, 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) + deriving (Show, Data, Eq, Ord, Generic) getLanguage :: Language -> Text getLanguage (Language l) = l -instance NFData Language where rnf = genericRnf +instance NFData Language instance Binary Language instance Hashable Language where hashWithSalt salt (Language l) = hashWithSalt salt l @@ -136,9 +188,9 @@ = 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) + deriving (Show, Data, Eq, Ord, Generic) -instance NFData Contributor where rnf = genericRnf +instance NFData Contributor instance Binary Contributor contributorToSimpleUser :: Contributor -> Maybe SimpleUser @@ -146,76 +198,157 @@ contributorToSimpleUser (KnownContributor _contributions avatarUrl name url uid _gravatarid) = Just $ SimpleUser uid name avatarUrl url +-- | The permission of a collaborator on a repository. +-- See +data CollaboratorPermission + = CollaboratorPermissionAdmin + | CollaboratorPermissionWrite + | CollaboratorPermissionRead + | CollaboratorPermissionNone + deriving (Show, Data, Enum, Bounded, Eq, Ord, Generic) + +instance NFData CollaboratorPermission +instance Binary CollaboratorPermission + +-- | A collaborator and its permission on a repository. +-- See +data CollaboratorWithPermission + = CollaboratorWithPermission SimpleUser CollaboratorPermission + deriving (Show, Data, Eq, Ord, Generic) + +instance NFData CollaboratorWithPermission +instance Binary CollaboratorWithPermission + -- JSON instances instance FromJSON Repo where - parseJSON = withObject "Repo" $ \o -> Repo <$> o .:? "ssh_url" - <*> o .: "description" - <*> o .:? "created_at" + parseJSON = withObject "Repo" $ \o -> Repo <$> o .: "id" + <*> o .: "name" + <*> o .: "owner" + <*> o .: "private" <*> o .: "html_url" - <*> o .:? "svn_url" - <*> o .:? "forks" - <*> o .:? "homepage" + <*> o .:? "description" <*> o .: "fork" + <*> o .: "url" <*> o .:? "git_url" - <*> o .: "private" - <*> o .:? "archived" .!= False + <*> o .:? "ssh_url" <*> o .:? "clone_url" + <*> o .: "hooks_url" + <*> o .:? "svn_url" + <*> o .:? "homepage" + <*> o .:? "language" + <*> o .: "forks_count" + <*> o .: "stargazers_count" + <*> o .: "watchers_count" <*> o .:? "size" + <*> o .:? "default_branch" + <*> o .: "open_issues_count" + <*> o .:? "has_issues" + <*> o .:? "has_projects" + <*> o .:? "has_wiki" + <*> o .:? "has_pages" + <*> o .:? "has_downloads" + <*> o .:? "archived" .!= False + <*> o .:? "disabled" .!= False + <*> o .:? "pushed_at" + <*> o .:? "created_at" <*> o .:? "updated_at" - <*> o .:? "watchers" - <*> o .: "owner" + <*> o .:? "permissions" + +instance FromJSON CodeSearchRepo where + parseJSON = withObject "Repo" $ \o -> CodeSearchRepo <$> o .: "id" <*> o .: "name" + <*> o .: "owner" + <*> o .: "private" + <*> o .: "html_url" + <*> o .:? "description" + <*> o .: "fork" + <*> o .: "url" + <*> o .:? "git_url" + <*> o .:? "ssh_url" + <*> o .:? "clone_url" + <*> o .: "hooks_url" + <*> o .:? "svn_url" + <*> o .:? "homepage" <*> o .:? "language" + <*> o .:? "size" <*> o .:? "default_branch" - <*> o .:? "pushed_at" - <*> o .: "id" - <*> o .: "url" - <*> o .:? "open_issues" - <*> o .:? "has_wiki" <*> o .:? "has_issues" + <*> o .:? "has_projects" + <*> o .:? "has_wiki" + <*> o .:? "has_pages" <*> o .:? "has_downloads" - <*> o .:? "parent" - <*> o .:? "source" - <*> o .: "hooks_url" - <*> o .: "stargazers_count" + <*> o .:? "archived" .!= False + <*> o .:? "disabled" .!= False + <*> o .:? "pushed_at" + <*> o .:? "created_at" + <*> o .:? "updated_at" + <*> o .:? "permissions" instance ToJSON NewRepo where - toJSON (NewRepo { newRepoName = name - , newRepoDescription = description - , newRepoHomepage = homepage - , newRepoPrivate = private - , newRepoHasIssues = hasIssues - , newRepoHasWiki = hasWiki - , newRepoAutoInit = autoInit + toJSON (NewRepo { newRepoName = name + , newRepoDescription = description + , newRepoHomepage = homepage + , newRepoPrivate = private + , newRepoHasIssues = hasIssues + , newRepoHasProjects = hasProjects + , newRepoHasWiki = hasWiki + , newRepoAutoInit = autoInit + , newRepoGitignoreTemplate = gitignoreTemplate + , newRepoLicenseTemplate = licenseTemplate + , newRepoAllowSquashMerge = allowSquashMerge + , newRepoAllowMergeCommit = allowMergeCommit + , newRepoAllowRebaseMerge = allowRebaseMerge }) = object [ "name" .= name , "description" .= description , "homepage" .= homepage , "private" .= private , "has_issues" .= hasIssues + , "has_projects" .= hasProjects , "has_wiki" .= hasWiki , "auto_init" .= autoInit + , "gitignore_template" .= gitignoreTemplate + , "license_template" .= licenseTemplate + , "allow_squash_merge" .= allowSquashMerge + , "allow_merge_commit" .= allowMergeCommit + , "allow_rebase_merge" .= allowRebaseMerge ] instance ToJSON EditRepo where - toJSON (EditRepo { editName = name - , editDescription = description - , editHomepage = homepage - , editPublic = public - , editHasIssues = hasIssues - , editHasWiki = hasWiki - , editHasDownloads = hasDownloads + toJSON (EditRepo { editName = name + , editDescription = description + , editHomepage = homepage + , editPrivate = private + , editHasIssues = hasIssues + , editHasProjects = hasProjects + , editHasWiki = hasWiki + , editDefaultBranch = defaultBranch + , editAllowSquashMerge = allowSquashMerge + , editAllowMergeCommit = allowMergeCommit + , editAllowRebaseMerge = allowRebaseMerge + , editArchived = archived }) = object - [ "name" .= name - , "description" .= description - , "homepage" .= homepage - , "public" .= public - , "has_issues" .= hasIssues - , "has_wiki" .= hasWiki - , "has_downloads" .= hasDownloads + [ "name" .= name + , "description" .= description + , "homepage" .= homepage + , "private" .= private + , "has_issues" .= hasIssues + , "has_projects" .= hasProjects + , "has_wiki" .= hasWiki + , "default_branch" .= defaultBranch + , "allow_squash_merge" .= allowSquashMerge + , "allow_merge_commit" .= allowMergeCommit + , "allow_rebase_merge" .= allowRebaseMerge + , "archived" .= archived ] +instance FromJSON RepoPermissions where + parseJSON = withObject "RepoPermissions" $ \o -> RepoPermissions + <$> o .: "admin" + <*> o .: "push" + <*> o .: "pull" + instance FromJSON RepoRef where parseJSON = withObject "RepoRef" $ \o -> RepoRef <$> o .: "owner" @@ -242,29 +375,34 @@ 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) + deriving (Show, Eq, Ord, Enum, Bounded, Data, Generic) instance IsPathPart ArchiveFormat where toPathPart af = case af of ArchiveFormatTarball -> "tarball" ArchiveFormatZipball -> "zipball" + +instance FromJSON CollaboratorPermission where + parseJSON = withText "CollaboratorPermission" $ \t -> case T.toLower t of + "admin" -> pure CollaboratorPermissionAdmin + "write" -> pure CollaboratorPermissionWrite + "read" -> pure CollaboratorPermissionRead + "none" -> pure CollaboratorPermissionNone + _ -> fail $ "Unknown CollaboratorPermission: " <> T.unpack t + +instance ToJSON CollaboratorPermission where + toJSON CollaboratorPermissionAdmin = "admin" + toJSON CollaboratorPermissionWrite = "write" + toJSON CollaboratorPermissionRead = "read" + toJSON CollaboratorPermissionNone = "none" + +instance FromJSON CollaboratorWithPermission where + parseJSON = withObject "CollaboratorWithPermission" $ \o -> CollaboratorWithPermission + <$> o .: "user" + <*> o .: "permission" diff --git a/src/GitHub/Data/Request.hs b/src/GitHub/Data/Request.hs --- a/src/GitHub/Data/Request.hs +++ b/src/GitHub/Data/Request.hs @@ -1,44 +1,40 @@ -{-# LANGUAGE CPP #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE KindSignatures #-} {-# LANGUAGE StandaloneDeriving #-} ------------------------------------------------------------------------------ --- | --- License : BSD-3-Clause --- Maintainer : Oleg Grenrus --- + module GitHub.Data.Request ( -- * Request - Request (..), - SimpleRequest (..), + Request, + GenRequest (..), -- * Smart constructors query, pagedQuery, command, -- * Auxiliary types RW(..), - StatusMap, - statusOnlyOk, CommandMethod(..), toMethod, FetchCount(..), + PageParams(..), + PageLinks(..), + MediaType (..), Paths, IsPathPart(..), QueryString, Count, ) where -import GitHub.Data.Definitions (Count, QueryString) +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 as Types import qualified Network.HTTP.Types.Method as Method -import Network.URI (URI) +import Network.URI (URI) + ------------------------------------------------------------------------------ --- Auxillary types +-- Path parts ------------------------------------------------------------------------------ type Paths = [Text] @@ -52,43 +48,40 @@ instance IsPathPart (Id a) where toPathPart = T.pack . show . untagId --- | Http method of requests with body. -data CommandMethod a where - Post :: CommandMethod a - Patch :: CommandMethod a - Put :: CommandMethod a - Put' :: CommandMethod () - Delete :: CommandMethod () - deriving (Typeable) +instance IsPathPart IssueNumber where + toPathPart = T.pack . show . unIssueNumber -deriving instance Eq (CommandMethod a) -deriving instance Ord (CommandMethod a) +------------------------------------------------------------------------------- +-- Command Method +------------------------------------------------------------------------------- -instance Show (CommandMethod a) where - showsPrec _ Post = showString "Post" - showsPrec _ Patch = showString "Patch" - showsPrec _ Put = showString "Put" - showsPrec _ Put' = showString "Put'" - showsPrec _ Delete = showString "Delete" +-- | Http method of requests with body. +data CommandMethod + = Post + | Patch + | Put + | Delete + deriving (Eq, Ord, Read, Show, Enum, Bounded, Data, Generic) -instance Hashable (CommandMethod a) where - hashWithSalt salt Post = hashWithSalt salt (0 :: Int) - hashWithSalt salt Patch = hashWithSalt salt (1 :: Int) - hashWithSalt salt Put = hashWithSalt salt (2 :: Int) - hashWithSalt salt Put' = hashWithSalt salt (3 :: Int) - hashWithSalt salt Delete = hashWithSalt salt (4 :: Int) +instance Hashable CommandMethod -toMethod :: CommandMethod a -> Method.Method +toMethod :: CommandMethod -> Method.Method toMethod Post = Method.methodPost toMethod Patch = Method.methodPatch toMethod Put = Method.methodPut -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) +data FetchCount = + FetchAtLeast !Word + | FetchAll + | FetchPage PageParams + deriving (Eq, Ord, Read, Show, Generic) -- | This instance is there mostly for 'fromInteger'. @@ -107,19 +100,67 @@ instance Hashable FetchCount instance Binary FetchCount -instance NFData FetchCount where rnf = genericRnf +instance NFData FetchCount +------------------------------------------------------------------------------- +-- PageParams +------------------------------------------------------------------------------- + +-- | Params for specifying the precise page and items per page. +data PageParams = PageParams { + pageParamsPerPage :: Maybe Int + , pageParamsPage :: Maybe Int + } + deriving (Eq, Ord, Read, Show, Generic) + +instance Hashable PageParams +instance Binary PageParams +instance NFData PageParams + +------------------------------------------------------------------------------- +-- PageLinks +------------------------------------------------------------------------------- + +-- | 'PagedQuery' returns just some results, using this data we can specify how +-- many pages we want to fetch. +data PageLinks = PageLinks { + pageLinksPrev :: Maybe URI + , pageLinksNext :: Maybe URI + , pageLinksLast :: Maybe URI + , pageLinksFirst :: Maybe URI + } + deriving (Eq, Ord, Show, Generic) + +instance NFData PageLinks + +------------------------------------------------------------------------------- +-- 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, Data, Generic) + ------------------------------------------------------------------------------ --- Github request +-- 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 autenticated/ + | RA -- ^ /Read authenticated/ | RW -- ^ /Read-write/, requires authentication - deriving (Eq, Ord, Read, Show, Enum, Bounded, Typeable, Data, Generic) + deriving (Eq, Ord, Read, Show, Enum, Bounded, Data, Generic) {- data SRO (rw :: RW) where @@ -132,100 +173,53 @@ instance IReadOnly 'RA where iro = ROA -} +------------------------------------------------------------------------------- +-- GitHub Request +------------------------------------------------------------------------------- + -- | Github request data type. -- --- * @k@ describes whether authentication is required. It's required for non-@GET@ requests. +-- * @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 Request (k :: RW) a where - SimpleQuery :: FromJSON a => SimpleRequest k a -> Request k a - StatusQuery :: StatusMap a -> SimpleRequest k () -> Request k a - HeaderQuery :: FromJSON a => Types.RequestHeaders -> SimpleRequest k a -> Request k a - RedirectQuery :: SimpleRequest k () -> Request k URI - deriving (Typeable) - -data SimpleRequest (k :: RW) a where - Query :: Paths -> QueryString -> SimpleRequest k a - PagedQuery :: Paths -> QueryString -> FetchCount -> SimpleRequest k (Vector a) - Command :: CommandMethod a -> Paths -> LBS.ByteString -> SimpleRequest 'RW a - deriving (Typeable) - -------------------------------------------------------------------------------- --- Status Map -------------------------------------------------------------------------------- +data GenRequest (mt :: MediaType *) (rw :: RW) a where + Query :: Paths -> QueryString -> GenRequest mt rw a + PagedQuery :: (a ~ t b, Foldable t, Semigroup a) => Paths -> QueryString -> FetchCount -> GenRequest mt rw a --- TODO: Change to 'Map' ? -type StatusMap a = [(Int, a)] + -- | Command + Command + :: CommandMethod -- ^ command + -> Paths -- ^ path + -> LBS.ByteString -- ^ body + -> GenRequest mt 'RW a -statusOnlyOk :: StatusMap Bool -statusOnlyOk = - [ (204, True) - , (404, False) - ] +-- | Most requests ask for @JSON@. +type Request = GenRequest 'MtJSON ------------------------------------------------------------------------------- -- Smart constructors ------------------------------------------------------------------------------- -query :: FromJSON a => Paths -> QueryString -> Request k a -query ps qs = SimpleQuery (Query ps qs) +query :: Paths -> QueryString -> Request mt a +query ps qs = Query ps qs -pagedQuery :: FromJSON a => Paths -> QueryString -> FetchCount -> Request k (Vector a) -pagedQuery ps qs fc = SimpleQuery (PagedQuery ps qs fc) +pagedQuery :: FromJSON a => Paths -> QueryString -> FetchCount -> Request mt (Vector a) +pagedQuery ps qs fc = PagedQuery ps qs fc -command :: FromJSON a => CommandMethod a -> Paths -> LBS.ByteString -> Request 'RW a -command m ps body = SimpleQuery (Command m ps body) +command :: CommandMethod -> Paths -> LBS.ByteString -> Request 'RW a +command m ps body = Command m ps body ------------------------------------------------------------------------------- -- Instances ------------------------------------------------------------------------------- -deriving instance Eq a => Eq (Request k a) -deriving instance Eq a => Eq (SimpleRequest k a) - -deriving instance Ord a => Ord (Request k a) -deriving instance Ord a => Ord (SimpleRequest k a) - -instance Show (SimpleRequest k a) where - showsPrec d r = showParen (d > appPrec) $ case r of - Query ps qs -> showString "Query " - . showsPrec (appPrec + 1) ps - . showString " " - . showsPrec (appPrec + 1) qs - PagedQuery ps qs l -> showString "PagedQuery " - . showsPrec (appPrec + 1) ps - . showString " " - . showsPrec (appPrec + 1) qs - . showString " " - . showsPrec (appPrec + 1) l - Command m ps body -> showString "Command " - . showsPrec (appPrec + 1) m - . showString " " - . showsPrec (appPrec + 1) ps - . showString " " - . showsPrec (appPrec + 1) body - where - appPrec = 10 :: Int - -instance Show (Request k a) where - showsPrec d r = showParen (d > appPrec) $ case r of - SimpleQuery req -> showString "SimpleQuery " - . showsPrec (appPrec + 1) req - StatusQuery m req -> showString "Status " - . showsPrec (appPrec + 1) (map fst m) -- !!! printing only keys - . showString " " - . showsPrec (appPrec + 1) req - HeaderQuery m req -> showString "Header " - . showsPrec (appPrec + 1) m - . showString " " - . showsPrec (appPrec + 1) req - RedirectQuery req -> showString "Redirect " - . showsPrec (appPrec + 1) req - where - appPrec = 10 :: Int +deriving instance Eq (GenRequest rw mt a) +deriving instance Ord (GenRequest rw mt a) +deriving instance Show (GenRequest rw mt a) -instance Hashable (SimpleRequest k a) where +instance Hashable (GenRequest rw mt a) where hashWithSalt salt (Query ps qs) = salt `hashWithSalt` (0 :: Int) `hashWithSalt` ps @@ -241,18 +235,4 @@ `hashWithSalt` ps `hashWithSalt` body -instance Hashable (Request k a) where - hashWithSalt salt (SimpleQuery req) = - salt `hashWithSalt` (0 :: Int) - `hashWithSalt` req - hashWithSalt salt (StatusQuery sm req) = - salt `hashWithSalt` (1 :: Int) - `hashWithSalt` map fst sm - `hashWithSalt` req - hashWithSalt salt (HeaderQuery h req) = - salt `hashWithSalt` (2 :: Int) - `hashWithSalt` h - `hashWithSalt` req - hashWithSalt salt (RedirectQuery req) = - salt `hashWithSalt` (3 :: Int) - `hashWithSalt` req +-- TODO: Binary diff --git a/src/GitHub/Data/Reviews.hs b/src/GitHub/Data/Reviews.hs --- a/src/GitHub/Data/Reviews.hs +++ b/src/GitHub/Data/Reviews.hs @@ -1,12 +1,13 @@ module GitHub.Data.Reviews where -import Data.Text (Text) import GitHub.Data.Definitions (SimpleUser) import GitHub.Data.Id (Id) import GitHub.Data.URL (URL) import GitHub.Internal.Prelude import Prelude () +import qualified Data.Text as T + data ReviewState = ReviewStatePending | ReviewStateApproved @@ -15,44 +16,41 @@ | ReviewStateChangesRequested deriving (Show, Enum, Bounded, Eq, Ord, Generic) -instance NFData ReviewState where - rnf = genericRnf - +instance NFData ReviewState instance Binary ReviewState instance FromJSON ReviewState where - parseJSON (String "APPROVED") = pure ReviewStateApproved - parseJSON (String "PENDING") = pure ReviewStatePending - parseJSON (String "DISMISSED") = pure ReviewStateDismissed - parseJSON (String "COMMENTED") = pure ReviewStateCommented - parseJSON (String "CHANGES_REQUESTED") = pure ReviewStateChangesRequested - parseJSON _ = fail "Unexpected ReviewState" + 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 + , reviewSubmittedAt :: !(Maybe UTCTime) , reviewPullRequestUrl :: !URL , reviewHtmlUrl :: !Text , reviewUser :: !SimpleUser , reviewId :: !(Id Review) } deriving (Show, Generic) -instance NFData Review where - rnf = genericRnf - +instance NFData Review 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" + o .:? "submitted_at" <*> + o .: "pull_request_url" <*> + o .: "html_url" <*> + o .: "user" <*> + o .: "id" data ReviewComment = ReviewComment { reviewCommentId :: !(Id ReviewComment) @@ -72,9 +70,7 @@ , reviewCommentPullRequestUrl :: !URL } deriving (Show, Generic) -instance NFData ReviewComment where - rnf = genericRnf - +instance NFData ReviewComment instance Binary ReviewComment instance FromJSON ReviewComment where diff --git a/src/GitHub/Data/Search.hs b/src/GitHub/Data/Search.hs --- a/src/GitHub/Data/Search.hs +++ b/src/GitHub/Data/Search.hs @@ -1,31 +1,34 @@ ------------------------------------------------------------------------------ --- | --- License : BSD-3-Clause --- Maintainer : Oleg Grenrus --- module GitHub.Data.Search where -import GitHub.Data.Repos (Repo) +import GitHub.Data.Repos (CodeSearchRepo) import GitHub.Data.URL (URL) import GitHub.Internal.Prelude import Prelude () import qualified Data.Vector as V -data SearchResult entity = SearchResult +data SearchResult' entities = SearchResult { searchResultTotalCount :: !Int - , searchResultResults :: !(Vector entity) + , searchResultResults :: !entities } - deriving (Show, Data, Typeable, Eq, Ord, Generic) + deriving (Show, Data, Eq, Ord, Generic) -instance NFData entity => NFData (SearchResult entity) where rnf = genericRnf -instance Binary entity => Binary (SearchResult entity) +type SearchResult entity = SearchResult' (V.Vector entity) -instance FromJSON entity => FromJSON (SearchResult entity) where +instance NFData entities => NFData (SearchResult' entities) +instance Binary entities => Binary (SearchResult' entities) + +instance (Monoid entities, FromJSON entities) => FromJSON (SearchResult' entities) where parseJSON = withObject "SearchResult" $ \o -> SearchResult <$> o .: "total_count" - <*> o .:? "items" .!= V.empty + <*> o .:? "items" .!= mempty +instance Semigroup res => Semigroup (SearchResult' res) where + (SearchResult count res) <> (SearchResult count' res') = SearchResult (max count count') (res <> res') + +instance Foldable SearchResult' where + foldMap f (SearchResult _count results) = f results + data Code = Code { codeName :: !Text , codePath :: !Text @@ -33,11 +36,11 @@ , codeUrl :: !URL , codeGitUrl :: !URL , codeHtmlUrl :: !URL - , codeRepo :: !Repo + , codeRepo :: !CodeSearchRepo } - deriving (Show, Data, Typeable, Eq, Ord, Generic) + deriving (Show, Data, Eq, Ord, Generic) -instance NFData Code where rnf = genericRnf +instance NFData Code instance Binary Code instance FromJSON Code where diff --git a/src/GitHub/Data/Statuses.hs b/src/GitHub/Data/Statuses.hs --- a/src/GitHub/Data/Statuses.hs +++ b/src/GitHub/Data/Statuses.hs @@ -1,7 +1,5 @@ -{-# LANGUAGE DeriveDataTypeable #-} -{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE NoImplicitPrelude #-} -{-# LANGUAGE OverloadedStrings #-} + module GitHub.Data.Statuses where import GitHub.Data.Definitions @@ -14,23 +12,25 @@ 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) + deriving (Show, Data, Enum, Bounded, Eq, Ord, Generic) -instance NFData StatusState where rnf = genericRnf +instance NFData StatusState instance Binary StatusState instance FromJSON StatusState where - parseJSON (String "pending") = pure StatusPending - parseJSON (String "success") = pure StatusSuccess - parseJSON (String "error") = pure StatusError - parseJSON (String "failure") = pure StatusFailure - parseJSON _ = fail "Could not build a StatusState" + 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" @@ -50,7 +50,7 @@ , statusContext :: !(Maybe Text) , statusCreator :: !(Maybe SimpleUser) } - deriving (Show, Data, Typeable, Eq, Ord, Generic) + deriving (Show, Data, Eq, Ord, Generic) instance FromJSON Status where parseJSON = withObject "Status" $ \o -> Status @@ -71,9 +71,9 @@ , newStatusDescription :: !(Maybe Text) , newStatusContext :: !(Maybe Text) } - deriving (Show, Data, Typeable, Eq, Ord, Generic) + deriving (Show, Data, Eq, Ord, Generic) -instance NFData NewStatus where rnf = genericRnf +instance NFData NewStatus instance Binary NewStatus instance ToJSON NewStatus where @@ -97,7 +97,7 @@ , combinedStatusCommitUrl :: !URL , combinedStatusUrl :: !URL } - deriving (Show, Data, Typeable, Eq, Ord, Generic) + deriving (Show, Data, Eq, Ord, Generic) instance FromJSON CombinedStatus where parseJSON = withObject "CombinedStatus" $ \o -> CombinedStatus diff --git a/src/GitHub/Data/Teams.hs b/src/GitHub/Data/Teams.hs --- a/src/GitHub/Data/Teams.hs +++ b/src/GitHub/Data/Teams.hs @@ -1,12 +1,5 @@ -{-# LANGUAGE DeriveDataTypeable #-} -{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE NoImplicitPrelude #-} -{-# LANGUAGE OverloadedStrings #-} ------------------------------------------------------------------------------ --- | --- License : BSD-3-Clause --- Maintainer : Oleg Grenrus --- + module GitHub.Data.Teams where import GitHub.Data.Definitions @@ -17,29 +10,31 @@ 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) + deriving (Show, Data, Enum, Bounded, Eq, Ord, Generic) -instance NFData Privacy where rnf = genericRnf +instance NFData Privacy instance Binary Privacy data Permission = PermissionPull | PermissionPush | PermissionAdmin - deriving (Show, Data, Enum, Bounded, Typeable, Eq, Ord, Generic) + deriving (Show, Data, Enum, Bounded, Eq, Ord, Generic) -instance NFData Permission where rnf = genericRnf +instance NFData Permission instance Binary Permission data AddTeamRepoPermission = AddTeamRepoPermission { addTeamRepoPermission :: !Permission } - deriving (Show, Data, Typeable, Eq, Ord, Generic) + deriving (Show, Data, Eq, Ord, Generic) -instance NFData AddTeamRepoPermission where rnf = genericRnf +instance NFData AddTeamRepoPermission instance Binary AddTeamRepoPermission data SimpleTeam = SimpleTeam @@ -48,14 +43,14 @@ , simpleTeamName :: !Text -- TODO (0.15.0): unify this and 'simpleTeamSlug' as in 'Team'. , simpleTeamSlug :: !(Name Team) , simpleTeamDescription :: !(Maybe Text) - , simpleTeamPrivacy :: !(Maybe Privacy) + , simpleTeamPrivacy :: !Privacy , simpleTeamPermission :: !Permission , simpleTeamMembersUrl :: !URL , simpleTeamRepositoriesUrl :: !URL } - deriving (Show, Data, Typeable, Eq, Ord, Generic) + deriving (Show, Data, Eq, Ord, Generic) -instance NFData SimpleTeam where rnf = genericRnf +instance NFData SimpleTeam instance Binary SimpleTeam data Team = Team @@ -64,7 +59,7 @@ , teamName :: !Text , teamSlug :: !(Name Team) , teamDescription :: !(Maybe Text) - , teamPrivacy :: !(Maybe Privacy) + , teamPrivacy :: !Privacy , teamPermission :: !Permission , teamMembersUrl :: !URL , teamRepositoriesUrl :: !URL @@ -72,38 +67,38 @@ , teamReposCount :: !Int , teamOrganization :: !SimpleOrganization } - deriving (Show, Data, Typeable, Eq, Ord, Generic) + deriving (Show, Data, Eq, Ord, Generic) -instance NFData Team where rnf = genericRnf +instance NFData Team instance Binary Team data CreateTeam = CreateTeam { createTeamName :: !(Name Team) , createTeamDescription :: !(Maybe Text) , createTeamRepoNames :: !(Vector (Name Repo)) - -- , createTeamPrivacy :: Privacy - , createTeamPermission :: Permission + , createTeamPrivacy :: !Privacy + , createTeamPermission :: !Permission } - deriving (Show, Data, Typeable, Eq, Ord, Generic) + deriving (Show, Data, Eq, Ord, Generic) -instance NFData CreateTeam where rnf = genericRnf +instance NFData CreateTeam instance Binary CreateTeam data EditTeam = EditTeam { editTeamName :: !(Name Team) , editTeamDescription :: !(Maybe Text) - -- , editTeamPrivacy :: Privacy - , editTeamPermission :: !Permission + , editTeamPrivacy :: !(Maybe Privacy) + , editTeamPermission :: !(Maybe Permission) } - deriving (Show, Data, Typeable, Eq, Ord, Generic) + deriving (Show, Data, Eq, Ord, Generic) -instance NFData EditTeam where rnf = genericRnf +instance NFData EditTeam instance Binary EditTeam data Role = RoleMaintainer | RoleMember - deriving (Show, Data, Typeable, Eq, Ord, Generic) + deriving (Show, Data, Eq, Ord, Generic) instance NFData Role instance Binary Role @@ -111,9 +106,9 @@ data ReqState = StatePending | StateActive - deriving (Show, Data, Typeable, Eq, Ord, Generic) + deriving (Show, Data, Eq, Ord, Generic) -instance NFData ReqState where rnf = genericRnf +instance NFData ReqState instance Binary ReqState data TeamMembership = TeamMembership @@ -121,16 +116,16 @@ , teamMembershipRole :: !Role , teamMembershipReqState :: !ReqState } - deriving (Show, Data, Typeable, Eq, Ord, Generic) + deriving (Show, Data, Eq, Ord, Generic) -instance NFData TeamMembership where rnf = genericRnf +instance NFData TeamMembership instance Binary TeamMembership data CreateTeamMembership = CreateTeamMembership { createTeamMembershipRole :: !Role -} deriving (Show, Data, Typeable, Eq, Ord, Generic) +} deriving (Show, Data, Eq, Ord, Generic) -instance NFData CreateTeamMembership where rnf = genericRnf +instance NFData CreateTeamMembership instance Binary CreateTeamMembership -- JSON Instances @@ -142,7 +137,7 @@ <*> o .: "name" <*> o .: "slug" <*> o .:?"description" .!= Nothing - <*> o .:?"privacy" .!= Nothing + <*> o .: "privacy" <*> o .: "permission" <*> o .: "members_url" <*> o .: "repositories_url" @@ -154,7 +149,7 @@ <*> o .: "name" <*> o .: "slug" <*> o .:?"description" .!= Nothing - <*> o .:?"privacy" .!= Nothing + <*> o .: "privacy" <*> o .: "permission" <*> o .: "members_url" <*> o .: "repositories_url" @@ -163,19 +158,29 @@ <*> 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 ] + toJSON (CreateTeam name desc repo_names privacy permission) = + object $ filter notNull + [ "name" .= name + , "description" .= desc + , "repo_names" .= repo_names + , "privacy" .= privacy + , "permission" .= permission + ] + where + notNull (_, Null) = False + notNull (_, _) = True instance ToJSON EditTeam where - toJSON (EditTeam name desc {-privacy-} permissions) = - object [ "name" .= name - , "description" .= desc - {-, "privacy" .= privacy-} - , "permissions" .= permissions ] + toJSON (EditTeam name desc privacy permission) = + object $ filter notNull + [ "name" .= name + , "description" .= desc + , "privacy" .= privacy + , "permission" .= permission + ] + where + notNull (_, Null) = False + notNull (_, _) = True instance FromJSON TeamMembership where parseJSON = withObject "TeamMembership" $ \o -> TeamMembership @@ -200,42 +205,42 @@ object [ "permission" .= permission ] instance FromJSON Role where - parseJSON = withText "Attribute" $ \attr -> case attr of - "maintainer" -> return RoleMaintainer - "member" -> return RoleMember - _ -> fail $ "Unknown Role: " ++ show attr + 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 Permission where - parseJSON = withText "Permission Attribute" $ \attr -> case attr of - "pull" -> return PermissionPull - "push" -> return PermissionPush - "admin" -> return PermissionAdmin - _ -> fail $ "Unknown Permission Attribute: " ++ show attr - instance FromJSON Privacy where - parseJSON = withText "Privacy Attribute" $ \attr -> case attr of - "secret" -> return PrivacySecret - "closed" -> return PrivacyClosed - _ -> fail $ "Unknown Privacy Attribute: " ++ show attr + 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" $ \attr -> case attr of - "active" -> return StateActive - "pending" -> return StatePending - _ -> fail $ "Unknown ReqState: " ++ show attr + 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" @@ -246,4 +251,4 @@ = TeamMemberRoleAll -- ^ all members of the team. | TeamMemberRoleMaintainer -- ^ team maintainers | TeamMemberRoleMember -- ^ normal members of the team. - deriving (Show, Eq, Ord, Enum, Bounded, Typeable, Data, Generic) + deriving (Show, Eq, Ord, Enum, Bounded, Data, Generic) diff --git a/src/GitHub/Data/URL.hs b/src/GitHub/Data/URL.hs --- a/src/GitHub/Data/URL.hs +++ b/src/GitHub/Data/URL.hs @@ -1,8 +1,3 @@ ------------------------------------------------------------------------------ --- | --- License : BSD-3-Clause --- Maintainer : Oleg Grenrus --- module GitHub.Data.URL ( URL(..), getUrl, @@ -15,12 +10,12 @@ -- -- /N.B./ syntactical validity is not verified. newtype URL = URL Text - deriving (Eq, Ord, Show, Generic, Typeable, Data) + deriving (Eq, Ord, Show, Generic, Data) getUrl :: URL -> Text getUrl (URL url) = url -instance NFData URL where rnf = genericRnf +instance NFData URL instance Binary URL instance ToJSON URL where diff --git a/src/GitHub/Data/Webhooks.hs b/src/GitHub/Data/Webhooks.hs --- a/src/GitHub/Data/Webhooks.hs +++ b/src/GitHub/Data/Webhooks.hs @@ -1,8 +1,3 @@ ------------------------------------------------------------------------------ --- | --- License : BSD-3-Clause --- Maintainer : Oleg Grenrus --- module GitHub.Data.Webhooks where import GitHub.Data.Id (Id) @@ -11,6 +6,7 @@ import Prelude () import qualified Data.Map as M +import qualified Data.Text as T data RepoWebhook = RepoWebhook { repoWebhookUrl :: !URL @@ -24,46 +20,84 @@ , repoWebhookUpdatedAt :: !UTCTime , repoWebhookCreatedAt :: !UTCTime } - deriving (Show, Data, Typeable, Eq, Ord, Generic) + deriving (Show, Data, Eq, Ord, Generic) -instance NFData RepoWebhook where rnf = genericRnf +instance NFData RepoWebhook instance Binary RepoWebhook +-- | See . data RepoWebhookEvent = WebhookWildcardEvent + | WebhookCheckRunEvent + | WebhookCheckSuiteEvent + | WebhookCodeScanningAlert | WebhookCommitCommentEvent + | WebhookContentReferenceEvent | WebhookCreateEvent | WebhookDeleteEvent + | WebhookDeployKeyEvent | WebhookDeploymentEvent | WebhookDeploymentStatusEvent + | WebhookDiscussion + | WebhookDiscussionComment + | WebhookDownloadEvent + | WebhookFollowEvent | WebhookForkEvent + | WebhookGistEvent + | WebhookGitHubAppAuthorizationEvent | WebhookGollumEvent + | WebhookInstallationEvent + | WebhookInstallationRepositoriesEvent | WebhookIssueCommentEvent | WebhookIssuesEvent + | WebhookLabelEvent + | WebhookMarketplacePurchaseEvent | WebhookMemberEvent + | WebhookMembershipEvent + | WebhookMetaEvent + | WebhookMilestoneEvent + | WebhookOrgBlockEvent + | WebhookOrganizationEvent + | WebhookPackage | WebhookPageBuildEvent | WebhookPingEvent + | WebhookProjectCardEvent + | WebhookProjectColumnEvent + | WebhookProjectEvent | WebhookPublicEvent - | WebhookPullRequestReviewCommentEvent | WebhookPullRequestEvent + | WebhookPullRequestReviewCommentEvent + | WebhookPullRequestReviewEvent | WebhookPushEvent + | WebhookRegistryPackageEvent | WebhookReleaseEvent + | WebhookRepositoryDispatch + | WebhookRepositoryEvent + | WebhookRepositoryImportEvent + | WebhookRepositoryVulnerabilityAlertEvent + | WebhookSecretScanningAlert + | WebhookSecurityAdvisoryEvent + | WebhookSponsorship + | WebhookStarEvent | WebhookStatusEvent | WebhookTeamAddEvent + | WebhookTeamEvent | WebhookWatchEvent - deriving (Show, Data, Typeable, Eq, Ord, Generic) + | WebhookWorkflowDispatch + | WebhookWorkflowRun + deriving (Show, Data, Eq, Ord, Generic) -instance NFData RepoWebhookEvent where rnf = genericRnf +instance NFData RepoWebhookEvent instance Binary RepoWebhookEvent data RepoWebhookResponse = RepoWebhookResponse { repoWebhookResponseCode :: !(Maybe Int) - , repoWebhookResponseStatus :: !Text + , repoWebhookResponseStatus :: !(Maybe Text) , repoWebhookResponseMessage :: !(Maybe Text) } - deriving (Show, Data, Typeable, Eq, Ord, Generic) + deriving (Show, Data, Eq, Ord, Generic) -instance NFData RepoWebhookResponse where rnf = genericRnf +instance NFData RepoWebhookResponse instance Binary RepoWebhookResponse data PingEvent = PingEvent @@ -71,9 +105,9 @@ , pingEventHook :: !RepoWebhook , pingEventHookId :: !(Id RepoWebhook) } - deriving (Show, Data, Typeable, Eq, Ord, Generic) + deriving (Show, Data, Eq, Ord, Generic) -instance NFData PingEvent where rnf = genericRnf +instance NFData PingEvent instance Binary PingEvent data NewRepoWebhook = NewRepoWebhook @@ -82,9 +116,9 @@ , newRepoWebhookEvents :: !(Maybe (Vector RepoWebhookEvent)) , newRepoWebhookActive :: !(Maybe Bool) } - deriving (Eq, Ord, Show, Typeable, Data, Generic) + deriving (Eq, Ord, Show, Data, Generic) -instance NFData NewRepoWebhook where rnf = genericRnf +instance NFData NewRepoWebhook instance Binary NewRepoWebhook data EditRepoWebhook = EditRepoWebhook @@ -94,59 +128,134 @@ , editRepoWebhookRemoveEvents :: !(Maybe (Vector RepoWebhookEvent)) , editRepoWebhookActive :: !(Maybe Bool) } - deriving (Eq, Ord, Show, Typeable, Data, Generic) + deriving (Eq, Ord, Show, Data, Generic) -instance NFData EditRepoWebhook where rnf = genericRnf +instance NFData EditRepoWebhook instance Binary EditRepoWebhook -- JSON instances instance FromJSON RepoWebhookEvent where - parseJSON (String "*") = pure WebhookWildcardEvent - parseJSON (String "commit_comment") = pure WebhookCommitCommentEvent - parseJSON (String "create") = pure WebhookCreateEvent - parseJSON (String "delete") = pure WebhookDeleteEvent - parseJSON (String "deployment") = pure WebhookDeploymentEvent - parseJSON (String "deployment_status") = pure WebhookDeploymentStatusEvent - parseJSON (String "fork") = pure WebhookForkEvent - parseJSON (String "gollum") = pure WebhookGollumEvent - parseJSON (String "issue_comment") = pure WebhookIssueCommentEvent - parseJSON (String "issues") = pure WebhookIssuesEvent - parseJSON (String "member") = pure WebhookMemberEvent - parseJSON (String "page_build") = pure WebhookPageBuildEvent - parseJSON (String "ping") = pure WebhookPingEvent - parseJSON (String "public") = pure WebhookPublicEvent - parseJSON (String "pull_request_review_comment") = pure WebhookPullRequestReviewCommentEvent - parseJSON (String "pull_request") = pure WebhookPullRequestEvent - parseJSON (String "push") = pure WebhookPushEvent - parseJSON (String "release") = pure WebhookReleaseEvent - parseJSON (String "status") = pure WebhookStatusEvent - parseJSON (String "team_add") = pure WebhookTeamAddEvent - parseJSON (String "watch") = pure WebhookWatchEvent - parseJSON _ = fail "Could not build a Webhook event" + parseJSON = withText "RepoWebhookEvent" $ \t -> case T.toLower t of + "*" -> pure WebhookWildcardEvent + "check_run" -> pure WebhookCheckRunEvent + "check_suite" -> pure WebhookCheckSuiteEvent + "code_scanning_alert" -> pure WebhookCodeScanningAlert + "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 + "discussion" -> pure WebhookDiscussion + "discussion_comment" -> pure WebhookDiscussionComment + "download" -> pure WebhookDownloadEvent + "follow" -> pure WebhookFollowEvent + "fork" -> pure WebhookForkEvent + "gist" -> pure WebhookGistEvent + "github_app_authorization" -> pure WebhookGitHubAppAuthorizationEvent + "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 + "org_block" -> pure WebhookOrgBlockEvent + "organization" -> pure WebhookOrganizationEvent + "package" -> pure WebhookPackage + "page_build" -> pure WebhookPageBuildEvent + "ping" -> pure WebhookPingEvent + "project" -> pure WebhookProjectEvent + "project_card" -> pure WebhookProjectCardEvent + "project_column" -> pure WebhookProjectColumnEvent + "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_dispatch" -> pure WebhookRepositoryDispatch + "repository_import" -> pure WebhookRepositoryImportEvent + "repository_vulnerability_alert" -> pure WebhookRepositoryVulnerabilityAlertEvent + "secret_scanning_alert" -> pure WebhookSecretScanningAlert + "security_advisory" -> pure WebhookSecurityAdvisoryEvent + "sponsorship" -> pure WebhookSponsorship + "star" -> pure WebhookStarEvent + "status" -> pure WebhookStatusEvent + "team" -> pure WebhookTeamEvent + "team_add" -> pure WebhookTeamAddEvent + "watch" -> pure WebhookWatchEvent + "workflow_dispatch" -> pure WebhookWorkflowDispatch + "workflow_run" -> pure WebhookWorkflowRun + _ -> fail $ "Unknown RepoWebhookEvent: " <> T.unpack t instance ToJSON RepoWebhookEvent where - toJSON WebhookWildcardEvent = String "*" - toJSON WebhookCommitCommentEvent = String "commit_comment" - toJSON WebhookCreateEvent = String "create" - toJSON WebhookDeleteEvent = String "delete" - toJSON WebhookDeploymentEvent = String "deployment" - toJSON WebhookDeploymentStatusEvent = String "deployment_status" - toJSON WebhookForkEvent = String "fork" - toJSON WebhookGollumEvent = String "gollum" - toJSON WebhookIssueCommentEvent = String "issue_comment" - toJSON WebhookIssuesEvent = String "issues" - toJSON WebhookMemberEvent = String "member" - toJSON WebhookPageBuildEvent = String "page_build" - toJSON WebhookPingEvent = String "ping" - toJSON WebhookPublicEvent = String "public" - toJSON WebhookPullRequestReviewCommentEvent = String "pull_request_review_comment" - toJSON WebhookPullRequestEvent = String "pull_request" - toJSON WebhookPushEvent = String "push" - toJSON WebhookReleaseEvent = String "release" - toJSON WebhookStatusEvent = String "status" - toJSON WebhookTeamAddEvent = String "team_add" - toJSON WebhookWatchEvent = String "watch" + toJSON WebhookWildcardEvent = String "*" + toJSON WebhookCheckRunEvent = String "check_run" + toJSON WebhookCheckSuiteEvent = String "check_suite" + toJSON WebhookCodeScanningAlert = String "code_scanning_alert" + 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 WebhookDiscussion = String "discussion" + toJSON WebhookDiscussionComment = String "discussion_comment" + toJSON WebhookDownloadEvent = String "download" + toJSON WebhookFollowEvent = String "follow" + toJSON WebhookForkEvent = String "fork" + toJSON WebhookGistEvent = String "gist" + toJSON WebhookGitHubAppAuthorizationEvent = String "github_app_authorization" + 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 WebhookOrgBlockEvent = String "org_block" + toJSON WebhookOrganizationEvent = String "organization" + toJSON WebhookPackage = String "package" + 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 WebhookPullRequestReviewCommentEvent = String "pull_request_review_comment" + toJSON WebhookPullRequestReviewEvent = String "pull_request_review" + toJSON WebhookPushEvent = String "push" + toJSON WebhookRegistryPackageEvent = String "registry_package" + toJSON WebhookReleaseEvent = String "release" + toJSON WebhookRepositoryDispatch = String "repository_dispatch" + toJSON WebhookRepositoryEvent = String "repository" + toJSON WebhookRepositoryImportEvent = String "repository_import" + toJSON WebhookRepositoryVulnerabilityAlertEvent = String "repository_vulnerability_alert" + toJSON WebhookSecretScanningAlert = String "secret_scanning_alert" + toJSON WebhookSecurityAdvisoryEvent = String "security_advisory" + toJSON WebhookSponsorship = String "sponsorship" + toJSON WebhookStarEvent = String "star" + toJSON WebhookStatusEvent = String "status" + toJSON WebhookTeamAddEvent = String "team_add" + toJSON WebhookTeamEvent = String "team" + toJSON WebhookWatchEvent = String "watch" + toJSON WebhookWorkflowDispatch = String "workflow_dispatch" + toJSON WebhookWorkflowRun = String "workflow_run" instance FromJSON RepoWebhook where parseJSON = withObject "RepoWebhook" $ \o -> RepoWebhook @@ -164,8 +273,8 @@ instance FromJSON RepoWebhookResponse where parseJSON = withObject "RepoWebhookResponse" $ \o -> RepoWebhookResponse <$> o .: "code" - <*> o .: "status" - <*> o .: "message" + <*> o .:? "status" + <*> o .:? "message" instance ToJSON NewRepoWebhook where toJSON (NewRepoWebhook { newRepoWebhookName = name diff --git a/src/GitHub/Data/Webhooks/Validate.hs b/src/GitHub/Data/Webhooks/Validate.hs --- a/src/GitHub/Data/Webhooks/Validate.hs +++ b/src/GitHub/Data/Webhooks/Validate.hs @@ -1,10 +1,7 @@ ------------------------------------------------------------------------------ -- | --- License : BSD-3-Clause --- Maintainer : Oleg Grenrus --- -- Verification of incomming webhook payloads, as described at -- + module GitHub.Data.Webhooks.Validate ( isValidPayload ) where @@ -12,9 +9,8 @@ import GitHub.Internal.Prelude import Prelude () -import Crypto.Hash (HMAC, SHA1, hmac, hmacGetDigest) -import Data.Byteable (constEqBytes, toBytes) -import Data.ByteString (ByteString) +import Crypto.Hash.SHA1 (hmac) +import Data.ByteString (ByteString) import qualified Data.ByteString.Base16 as Hex import qualified Data.Text.Encoding as TE @@ -30,10 +26,9 @@ -- including the 'sha1=...' prefix -> ByteString -- ^ the body -> Bool -isValidPayload secret shaOpt payload = maybe False (constEqBytes sign) shaOptBS +isValidPayload secret shaOpt payload = maybe False (sign ==) shaOptBS where shaOptBS = TE.encodeUtf8 <$> shaOpt - hexDigest = Hex.encode . toBytes . hmacGetDigest - - hm = hmac (TE.encodeUtf8 secret) payload :: HMAC SHA1 + hexDigest = Hex.encode + hm = hmac (TE.encodeUtf8 secret) payload sign = "sha1=" <> hexDigest hm diff --git a/src/GitHub/Endpoints/Actions/Artifacts.hs b/src/GitHub/Endpoints/Actions/Artifacts.hs new file mode 100644 --- /dev/null +++ b/src/GitHub/Endpoints/Actions/Artifacts.hs @@ -0,0 +1,61 @@ +-- | +-- The actions API as documented at +-- . + +module GitHub.Endpoints.Actions.Artifacts ( + artifactsForR, + artifactR, + deleteArtifactR, + downloadArtifactR, + artifactsForWorkflowRunR, + module GitHub.Data + ) where + +import GitHub.Data +import GitHub.Internal.Prelude +import Network.URI (URI) +import Prelude () + +-- | List artifacts for repository. +-- See +artifactsForR + :: Name Owner + -> Name Repo + -> ArtifactMod + -> FetchCount + -> Request 'RA (WithTotalCount Artifact) +artifactsForR user repo opts = PagedQuery + ["repos", toPathPart user, toPathPart repo, "actions", "artifacts"] + (artifactModToQueryString opts) + +-- | Get an artifact. +-- See +artifactR :: Name Owner -> Name Repo -> Id Artifact -> Request 'RA Artifact +artifactR user repo artid = + query ["repos", toPathPart user, toPathPart repo, "actions", "artifacts", toPathPart artid] [] + +-- | Delete an artifact. +-- See +deleteArtifactR :: Name Owner -> Name Repo -> Id Comment -> GenRequest 'MtUnit 'RW () +deleteArtifactR user repo artid = + Command Delete parts mempty + where + parts = ["repos", toPathPart user, toPathPart repo, "actions", "artifacts", toPathPart artid] + +-- | Download an artifact. +-- See +downloadArtifactR :: Name Owner -> Name Repo -> Id Artifact -> GenRequest 'MtRedirect 'RW URI +downloadArtifactR user repo artid = + Query ["repos", toPathPart user, toPathPart repo, "actions", "artifacts", toPathPart artid, "zip"] [] + +-- | List artifacts for a workflow run. +-- See +artifactsForWorkflowRunR + :: Name Owner + -> Name Repo + -> Id WorkflowRun + -> FetchCount + -> Request 'RA (WithTotalCount Artifact) +artifactsForWorkflowRunR user repo runid = PagedQuery + ["repos", toPathPart user, toPathPart repo, "actions", "runs", toPathPart runid, "artifacts"] + [] diff --git a/src/GitHub/Endpoints/Actions/Cache.hs b/src/GitHub/Endpoints/Actions/Cache.hs new file mode 100644 --- /dev/null +++ b/src/GitHub/Endpoints/Actions/Cache.hs @@ -0,0 +1,66 @@ +-- | +-- The actions API as documented at +-- . + +module GitHub.Endpoints.Actions.Cache ( + cacheUsageOrganizationR, + cacheUsageByRepositoryR, + cacheUsageR, + cachesForRepoR, + deleteCacheR, + module GitHub.Data + ) where + +import GitHub.Data +import GitHub.Internal.Prelude +import Prelude () + +-- | Get Actions cache usage for the organization. +-- See +cacheUsageOrganizationR + :: Name Organization + -> GenRequest 'MtJSON 'RA OrganizationCacheUsage +cacheUsageOrganizationR org = + Query ["orgs", toPathPart org, "actions", "cache", "usage"] [] + +-- | List repositories with GitHub Actions cache usage for an organization. +-- See +cacheUsageByRepositoryR + :: Name Organization + -> FetchCount + -> GenRequest 'MtJSON 'RA (WithTotalCount RepositoryCacheUsage) +cacheUsageByRepositoryR org = + PagedQuery ["orgs", toPathPart org, "actions", "cache", "usage-by-repository"] [] + +-- | Get GitHub Actions cache usage for a repository. +-- See +cacheUsageR + :: Name Owner + -> Name Repo + -> Request k RepositoryCacheUsage +cacheUsageR user repo = + Query ["repos", toPathPart user, toPathPart repo, "actions", "cache", "usage"] [] + +-- | List the GitHub Actions caches for a repository. +-- See +cachesForRepoR + :: Name Owner + -> Name Repo + -> CacheMod + -> FetchCount + -> GenRequest 'MtJSON 'RA (WithTotalCount Cache) +cachesForRepoR user repo opts = PagedQuery + ["repos", toPathPart user, toPathPart repo, "actions", "caches"] + (cacheModToQueryString opts) + +-- | Delete GitHub Actions cache for a repository. +-- See +deleteCacheR + :: Name Owner + -> Name Repo + -> Id Cache + -> GenRequest 'MtUnit 'RW () +deleteCacheR user repo cacheid = + Command Delete parts mempty + where + parts = ["repos", toPathPart user, toPathPart repo, "actions", "caches", toPathPart cacheid] diff --git a/src/GitHub/Endpoints/Actions/Secrets.hs b/src/GitHub/Endpoints/Actions/Secrets.hs new file mode 100644 --- /dev/null +++ b/src/GitHub/Endpoints/Actions/Secrets.hs @@ -0,0 +1,221 @@ +-- | +-- The actions API as documented at +-- . + +module GitHub.Endpoints.Actions.Secrets ( + organizationSecretsR, + organizationPublicKeyR, + organizationSecretR, + setOrganizationSecretR, + deleteOrganizationSecretR, + organizationSelectedRepositoriesForSecretR, + setOrganizationSelectedRepositoriesForSecretR, + addOrganizationSelectedRepositoriesForSecretR, + removeOrganizationSelectedRepositoriesForSecretR, + repoSecretsR, + repoPublicKeyR, + repoSecretR, + setRepoSecretR, + deleteRepoSecretR, + environmentSecretsR, + environmentPublicKeyR, + environmentSecretR, + setEnvironmentSecretR, + deleteEnvironmentSecretR, + module GitHub.Data + ) where + +import GitHub.Data +import GitHub.Internal.Prelude +import Prelude () + +-- | List organization secrets. +-- See +organizationSecretsR + :: Name Organization + -> FetchCount + -> GenRequest 'MtJSON 'RA (WithTotalCount OrganizationSecret) +organizationSecretsR org = + PagedQuery ["orgs", toPathPart org, "actions", "secrets"] [] + +-- | List organization secrets. +-- See +organizationPublicKeyR + :: Name Organization + -> GenRequest 'MtJSON 'RA PublicKey +organizationPublicKeyR org = + Query ["orgs", toPathPart org, "actions", "secrets", "public-key"] [] + +-- | Get an organization secret. +-- See +organizationSecretR + :: Name Organization + -> Name OrganizationSecret + -> GenRequest 'MtJSON 'RA OrganizationSecret +organizationSecretR org name = + Query ["orgs", toPathPart org, "actions", "secrets", toPathPart name] [] + +-- | Create or update an organization secret. +-- See +setOrganizationSecretR + :: Name Organization + -> Name OrganizationSecret + -> SetSecret + -> GenRequest 'MtUnit 'RW () +setOrganizationSecretR org name = + Command Put ["orgs", toPathPart org, "actions", "secrets", toPathPart name] . encode + +-- | Delete an organization secret. +-- See +deleteOrganizationSecretR + :: Name Organization + -> Name OrganizationSecret + -> GenRequest 'MtUnit 'RW () +deleteOrganizationSecretR org name = + Command Delete parts mempty + where + parts = ["orgs", toPathPart org, "actions", "secrets", toPathPart name] + +-- | Get selected repositories for an organization secret. +-- See +organizationSelectedRepositoriesForSecretR + :: Name Organization + -> Name OrganizationSecret + -> FetchCount + -> GenRequest 'MtJSON 'RA (WithTotalCount SelectedRepo) +organizationSelectedRepositoriesForSecretR org name = + PagedQuery ["orgs", toPathPart org, "actions", "secrets", toPathPart name, "repositories"] [] + +-- | Set selected repositories for an organization secret. +-- See +setOrganizationSelectedRepositoriesForSecretR + :: Name Organization + -> Name OrganizationSecret + -> SetSelectedRepositories + -> GenRequest 'MtUnit 'RW () +setOrganizationSelectedRepositoriesForSecretR org name = + Command Put ["orgs", toPathPart org, "actions", "secrets", toPathPart name, "repositories"] . encode + +-- | Add selected repository to an organization secret. +-- See +addOrganizationSelectedRepositoriesForSecretR + :: Name Organization + -> Name OrganizationSecret + -> Id Repo + -> GenRequest 'MtUnit 'RW () +addOrganizationSelectedRepositoriesForSecretR org name repo = + Command Put ["orgs", toPathPart org, "actions", "secrets", toPathPart name, "repositories", toPathPart repo] mempty + +-- | Remove selected repository from an organization secret. +-- See +removeOrganizationSelectedRepositoriesForSecretR + :: Name Organization + -> Name OrganizationSecret + -> Id Repo + -> GenRequest 'MtUnit 'RW () +removeOrganizationSelectedRepositoriesForSecretR org name repo = + Command Delete ["orgs", toPathPart org, "actions", "secrets", toPathPart name, "repositories", toPathPart repo] mempty + +-- | List repository secrets. +-- See +repoSecretsR + :: Name Owner + -> Name Repo + -> FetchCount + -> GenRequest 'MtJSON 'RA (WithTotalCount RepoSecret) +repoSecretsR user repo = + PagedQuery ["repos", toPathPart user, toPathPart repo, "actions", "secrets"] [] + +-- | Get a repository public key. +-- See +repoPublicKeyR + :: Name Owner + -> Name Organization + -> GenRequest 'MtJSON 'RA PublicKey +repoPublicKeyR user org = + Query ["repos", toPathPart user, toPathPart org, "actions", "secrets", "public-key"] [] + +-- | Get a repository secret. +-- See +repoSecretR + :: Name Owner + -> Name Organization + -> Name RepoSecret + -> GenRequest 'MtJSON 'RA RepoSecret +repoSecretR user org name = + Query ["repos", toPathPart user, toPathPart org, "actions", "secrets", toPathPart name] [] + +-- | Create or update a repository secret. +-- See +setRepoSecretR + :: Name Owner + -> Name Organization + -> Name RepoSecret + -> SetRepoSecret + -> GenRequest 'MtUnit 'RW () +setRepoSecretR user org name = + Command Put ["repos", toPathPart user, toPathPart org, "actions", "secrets", toPathPart name] . encode + +-- | Delete a repository secret. +-- See +deleteRepoSecretR + :: Name Owner + -> Name Organization + -> Name RepoSecret + -> GenRequest 'MtUnit 'RW () +deleteRepoSecretR user org name = + Command Delete parts mempty + where + parts = ["repos", toPathPart user, toPathPart org, "actions", "secrets", toPathPart name] + +-- | List environment secrets. +-- See +environmentSecretsR + :: Id Repo + -> Name Environment + -> FetchCount + -> GenRequest 'MtJSON 'RA (WithTotalCount RepoSecret) +environmentSecretsR repo env = + PagedQuery ["repositories", toPathPart repo, "environments", toPathPart env, "secrets"] [] + +-- | Get an environment public key. +-- See +environmentPublicKeyR + :: Id Repo + -> Name Environment + -> GenRequest 'MtJSON 'RA PublicKey +environmentPublicKeyR repo env = + Query ["repositories", toPathPart repo, "environments", toPathPart env, "secrets", "public-key"] [] + +-- | Get an environment secret +-- See +environmentSecretR + :: Id Repo + -> Name Environment + -> Name RepoSecret + -> GenRequest 'MtJSON 'RA RepoSecret +environmentSecretR repo env name = + Query ["repositories", toPathPart repo, "environments", toPathPart env, "secrets", toPathPart name] [] + +-- | Create or update an environment secret. +-- See +setEnvironmentSecretR + :: Id Repo + -> Name Environment + -> Name RepoSecret + -> SetRepoSecret + -> GenRequest 'MtUnit 'RW () +setEnvironmentSecretR repo env name = + Command Put ["repositories", toPathPart repo, "environments", toPathPart env, "secrets", toPathPart name] . encode + +-- | Delete an environment secret. +-- See +deleteEnvironmentSecretR + :: Id Repo + -> Name Environment + -> Name RepoSecret + -> GenRequest 'MtUnit 'RW () +deleteEnvironmentSecretR repo env name = + Command Delete parts mempty + where + parts = ["repositories", toPathPart repo, "environments", toPathPart env, "secrets", toPathPart name] diff --git a/src/GitHub/Endpoints/Actions/WorkflowJobs.hs b/src/GitHub/Endpoints/Actions/WorkflowJobs.hs new file mode 100644 --- /dev/null +++ b/src/GitHub/Endpoints/Actions/WorkflowJobs.hs @@ -0,0 +1,58 @@ +-- | +-- The actions API as documented at +-- . + +module GitHub.Endpoints.Actions.WorkflowJobs ( + jobR, + downloadJobLogsR, + jobsForWorkflowRunAttemptR, + jobsForWorkflowRunR, + module GitHub.Data + ) where + +import GitHub.Data +import Network.URI (URI) +import Prelude () + +-- | Get a job for a workflow run. +-- See +jobR + :: Name Owner + -> Name Repo + -> Id Job + -> Request 'RA Job +jobR owner repo job = + Query ["repos", toPathPart owner, toPathPart repo, "actions", "jobs", toPathPart job] [] + +-- | Download job logs for a workflow run. +-- See +downloadJobLogsR + :: Name Owner + -> Name Repo + -> Id Job + -> GenRequest 'MtRedirect 'RO URI +downloadJobLogsR owner repo job = + Query ["repos", toPathPart owner, toPathPart repo, "actions", "jobs", toPathPart job, "logs"] [] + +-- | List jobs for a workflow run attempt. +-- See +jobsForWorkflowRunAttemptR + :: Name Owner + -> Name Repo + -> Id WorkflowRun + -> Id RunAttempt + -> FetchCount + -> GenRequest 'MtJSON 'RA (WithTotalCount Job) +jobsForWorkflowRunAttemptR owner repo run attempt = + PagedQuery ["repos", toPathPart owner, toPathPart repo, "actions", "runs", toPathPart run, "attempts", toPathPart attempt, "jobs"] [] + +-- | List jobs for a workflow run. +-- See +jobsForWorkflowRunR + :: Name Owner + -> Name Repo + -> Id WorkflowRun + -> FetchCount + -> GenRequest 'MtJSON 'RA (WithTotalCount Job) +jobsForWorkflowRunR owner repo run = + PagedQuery ["repos", toPathPart owner, toPathPart repo, "actions", "runs", toPathPart run, "jobs"] [] diff --git a/src/GitHub/Endpoints/Actions/WorkflowRuns.hs b/src/GitHub/Endpoints/Actions/WorkflowRuns.hs new file mode 100644 --- /dev/null +++ b/src/GitHub/Endpoints/Actions/WorkflowRuns.hs @@ -0,0 +1,181 @@ +module GitHub.Endpoints.Actions.WorkflowRuns ( + reRunJobR, + workflowRunsR, + workflowRunR, + deleteWorkflowRunR, + workflowRunReviewHistoryR, + approveWorkflowRunR, + workflowRunAttemptR, + downloadWorkflowRunAttemptLogsR, + cancelWorkflowRunR, + downloadWorkflowRunLogsR, + deleteWorkflowRunLogsR, + reRunWorkflowR, + reRunFailedJobsR, + workflowRunsForWorkflowR, + module GitHub.Data + ) where + +import GitHub.Data +import GitHub.Internal.Prelude +import Network.URI (URI) +import Prelude () + +-- | Re-run a job from a workflow run. +-- See +reRunJobR + :: Name Owner + -> Name Repo + -> Id Job + -> GenRequest 'MtUnit 'RW () +reRunJobR user repo job = Command Post + ["repos", toPathPart user, toPathPart repo, "actions", "jobs", toPathPart job, "rerun"] + mempty + +-- | List workflow runs for a repository. +-- See +workflowRunsR + :: Name Owner + -> Name Repo + -> WorkflowRunMod + -> FetchCount + -> GenRequest 'MtJSON 'RA (WithTotalCount WorkflowRun) +workflowRunsR user repo runMod = PagedQuery + ["repos", toPathPart user, toPathPart repo, "actions", "runs"] + (workflowRunModToQueryString runMod) + +-- | Get a workflow run. +-- See +workflowRunR + :: Name Owner + -> Name Repo + -> Id WorkflowRun + -> GenRequest 'MtJSON 'RA WorkflowRun +workflowRunR user repo run = Query + ["repos", toPathPart user, toPathPart repo, "actions", "runs", toPathPart run] + [] + +-- | Delete a workflow run. +-- See +deleteWorkflowRunR + :: Name Owner + -> Name Repo + -> Id WorkflowRun + -> GenRequest 'MtUnit 'RW () +deleteWorkflowRunR user repo run = Command Delete + ["repos", toPathPart user, toPathPart repo, "actions", "runs", toPathPart run] + mempty + +-- | Get the review history for a workflow run. +-- See +workflowRunReviewHistoryR + :: Name Owner + -> Name Repo + -> Id WorkflowRun + -> GenRequest 'MtJSON 'RA (Vector ReviewHistory) +workflowRunReviewHistoryR user repo run = Query + ["repos", toPathPart user, toPathPart repo, "actions", "runs", toPathPart run, "approvals"] + [] + +-- | Approve a workflow run for a fork pull request. +-- See +approveWorkflowRunR + :: Name Owner + -> Name Repo + -> Id WorkflowRun + -> GenRequest 'MtUnit 'RW () +approveWorkflowRunR user repo run = Command Post + ["repos", toPathPart user, toPathPart repo, "actions", "runs", toPathPart run, "approve"] + mempty + +-- | Get a workflow run attempt. +-- See +workflowRunAttemptR + :: Name Owner + -> Name Repo + -> Id WorkflowRun + -> Id RunAttempt + -> GenRequest 'MtJSON 'RA WorkflowRun +workflowRunAttemptR user repo run attempt = Query + ["repos", toPathPart user, toPathPart repo, "actions", "runs", toPathPart run, "attempts", toPathPart attempt] + [] + +-- | Download workflow run attempt logs. +-- See +downloadWorkflowRunAttemptLogsR + :: Name Owner + -> Name Repo + -> Id WorkflowRun + -> Id RunAttempt + -> GenRequest 'MtRedirect 'RO URI +downloadWorkflowRunAttemptLogsR user repo run attempt = Query + ["repos", toPathPart user, toPathPart repo, "actions", "runs", toPathPart run, "attempts", toPathPart attempt, "logs"] + [] + +-- | Cancel a workflow run. +-- See +cancelWorkflowRunR + :: Name Owner + -> Name Repo + -> Id WorkflowRun + -> GenRequest 'MtUnit 'RW () +cancelWorkflowRunR user repo run = Command Post + ["repos", toPathPart user, toPathPart repo, "actions", "runs", toPathPart run, "cancel"] + mempty + +-- | Download workflow run logs. +-- See +downloadWorkflowRunLogsR + :: Name Owner + -> Name Repo + -> Id WorkflowRun + -> GenRequest 'MtRedirect 'RA URI +downloadWorkflowRunLogsR user repo run = Query + ["repos", toPathPart user, toPathPart repo, "actions", "runs", toPathPart run, "logs"] + [] + +-- | Delete workflow run logs. +-- See +deleteWorkflowRunLogsR + :: Name Owner + -> Name Repo + -> Id WorkflowRun + -> GenRequest 'MtUnit 'RW () +deleteWorkflowRunLogsR user repo run = Command Delete + ["repos", toPathPart user, toPathPart repo, "actions", "runs", toPathPart run, "logs"] + mempty + +-- | Re-run a workflow. +-- See +reRunWorkflowR + :: Name Owner + -> Name Repo + -> Id WorkflowRun + -> GenRequest 'MtUnit 'RW () +reRunWorkflowR user repo run = Command Post + ["repos", toPathPart user, toPathPart repo, "actions", "runs", toPathPart run, "rerun"] + mempty + +-- | Re-run failed jobs from a workflow run. +-- See +reRunFailedJobsR + :: Name Owner + -> Name Repo + -> Id WorkflowRun + -> GenRequest 'MtUnit 'RW () +reRunFailedJobsR user repo run = Command Post + ["repos", toPathPart user, toPathPart repo, "actions", "runs", toPathPart run, "rerun-failed-jobs"] + mempty + +-- | List workflow runs for a workflow. +-- See +workflowRunsForWorkflowR + :: (IsPathPart idOrName) => Name Owner + -> Name Repo + -> idOrName + -> WorkflowRunMod + -> FetchCount + -> GenRequest 'MtJSON 'RA (WithTotalCount WorkflowRun) +workflowRunsForWorkflowR user repo idOrName runMod = PagedQuery + ["repos", toPathPart user, toPathPart repo, "actions", "workflows", toPathPart idOrName, "runs"] + (workflowRunModToQueryString runMod) diff --git a/src/GitHub/Endpoints/Actions/Workflows.hs b/src/GitHub/Endpoints/Actions/Workflows.hs new file mode 100644 --- /dev/null +++ b/src/GitHub/Endpoints/Actions/Workflows.hs @@ -0,0 +1,68 @@ +module GitHub.Endpoints.Actions.Workflows ( + repositoryWorkflowsR, + workflowR, + disableWorkflowR, + triggerWorkflowR, + enableWorkflowR, + module GitHub.Data + ) where + +import GitHub.Data +import GitHub.Internal.Prelude +import Prelude () + +-- | List repository workflows. +-- See +repositoryWorkflowsR + :: Name Owner + -> Name Repo + -> FetchCount + -> GenRequest 'MtJSON 'RA (WithTotalCount Workflow) +repositoryWorkflowsR user repo = PagedQuery + ["repos", toPathPart user, toPathPart repo, "actions", "workflows"] + [] + +-- | Get a workflow. +-- See +workflowR + :: (IsPathPart idOrName) => Name Owner + -> Name Repo + -> idOrName + -> GenRequest 'MtJSON 'RA Workflow +workflowR user repo idOrName = Query + ["repos", toPathPart user, toPathPart repo, "actions", "workflows", toPathPart idOrName] + [] + +-- | Disable a workflow. +-- See +disableWorkflowR + :: (IsPathPart idOrName) => Name Owner + -> Name Repo + -> idOrName + -> GenRequest 'MtUnit 'RW () +disableWorkflowR user repo idOrName = Command Put + ["repos", toPathPart user, toPathPart repo, "actions", "workflows", toPathPart idOrName, "disable"] + mempty + +-- | Create a workflow dispatch event. +-- See +triggerWorkflowR + :: (ToJSON a, IsPathPart idOrName) => Name Owner + -> Name Repo + -> idOrName + -> CreateWorkflowDispatchEvent a + -> GenRequest 'MtUnit 'RW () +triggerWorkflowR user repo idOrName = Command Post + ["repos", toPathPart user, toPathPart repo, "actions", "workflows", toPathPart idOrName, "dispatches"] + . encode + +-- | Enable a workflow. +-- See +enableWorkflowR + :: (IsPathPart idOrName) => Name Owner + -> Name Repo + -> idOrName + -> GenRequest 'MtUnit 'RW () +enableWorkflowR user repo idOrName = Command Put + ["repos", toPathPart user, toPathPart repo, "actions", "workflows", toPathPart idOrName, "enable"] + mempty diff --git a/src/GitHub/Endpoints/Activity/Events.hs b/src/GitHub/Endpoints/Activity/Events.hs --- a/src/GitHub/Endpoints/Activity/Events.hs +++ b/src/GitHub/Endpoints/Activity/Events.hs @@ -1,9 +1,6 @@ ------------------------------------------------------------------------------ -- | --- License : BSD-3-Clause --- Maintainer : Oleg Grenrus --- -- The events API as described on . + module GitHub.Endpoints.Activity.Events ( -- * Events repositoryEventsR, diff --git a/src/GitHub/Endpoints/Activity/Notifications.hs b/src/GitHub/Endpoints/Activity/Notifications.hs new file mode 100644 --- /dev/null +++ b/src/GitHub/Endpoints/Activity/Notifications.hs @@ -0,0 +1,32 @@ +-- | +-- The repo watching API as described on +-- . + +module GitHub.Endpoints.Activity.Notifications ( + getNotificationsR, + markNotificationAsReadR, + markAllNotificationsAsReadR, + ) where + +import GitHub.Data +import GitHub.Internal.Prelude +import Prelude () + +-- | List your notifications. +-- See +getNotificationsR :: FetchCount -> Request 'RA (Vector Notification) +getNotificationsR = pagedQuery ["notifications"] [] + +-- | Mark a thread as read. +-- See +markNotificationAsReadR :: Id Notification -> GenRequest 'MtUnit 'RW () +markNotificationAsReadR nid = Command + Patch + ["notifications", "threads", toPathPart nid] + (encode ()) + +-- | Mark as read. +-- See +markAllNotificationsAsReadR :: GenRequest 'MtUnit 'RW () +markAllNotificationsAsReadR = + Command Put ["notifications"] $ encode emptyObject diff --git a/src/GitHub/Endpoints/Activity/Starring.hs b/src/GitHub/Endpoints/Activity/Starring.hs --- a/src/GitHub/Endpoints/Activity/Starring.hs +++ b/src/GitHub/Endpoints/Activity/Starring.hs @@ -1,22 +1,13 @@ ------------------------------------------------------------------------------ -- | --- 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 @@ -24,29 +15,14 @@ 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) @@ -54,44 +30,25 @@ 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 -> Request 'RA (Vector RepoStarred) -myStarredAcceptStarR = HeaderQuery [("Accept", "application/vnd.github.v3.star+json")] . 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 +myStarredAcceptStarR :: FetchCount -> GenRequest 'MtStar 'RA (Vector RepoStarred) +myStarredAcceptStarR = PagedQuery ["user", "starred"] [] -- | Star a repo by the authenticated user. -- See -starRepoR :: Name Owner -> Name Repo -> Request 'RW () -starRepoR user repo = command Put' paths mempty +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 -> Request 'RW () -unstarRepoR user repo = command Delete paths mempty +unstarRepoR :: Name Owner -> Name Repo -> GenRequest 'MtUnit 'RW () +unstarRepoR user repo = Command Delete paths mempty where paths = ["user", "starred", toPathPart user, toPathPart repo] diff --git a/src/GitHub/Endpoints/Activity/Watching.hs b/src/GitHub/Endpoints/Activity/Watching.hs --- a/src/GitHub/Endpoints/Activity/Watching.hs +++ b/src/GitHub/Endpoints/Activity/Watching.hs @@ -1,62 +1,33 @@ ------------------------------------------------------------------------------ -- | --- 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, + unwatchRepoR, 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 (User (user, 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 (User (user, 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"] [] + +-- | Stop watching repository. +-- See +unwatchRepoR :: Name Owner -> Name Repo -> Request 'RW () +unwatchRepoR owner repo = + command Delete ["repos", toPathPart owner, toPathPart repo, "subscription"] mempty diff --git a/src/GitHub/Endpoints/Enterprise/Organizations.hs b/src/GitHub/Endpoints/Enterprise/Organizations.hs new file mode 100644 --- /dev/null +++ b/src/GitHub/Endpoints/Enterprise/Organizations.hs @@ -0,0 +1,25 @@ +-- | +-- The GitHub Enterprise orgs API as described on . + +module GitHub.Endpoints.Enterprise.Organizations ( + createOrganizationR, + renameOrganizationR, + module GitHub.Data, + ) where + +import GitHub.Data +import GitHub.Data.Enterprise +import GitHub.Internal.Prelude +import Prelude () + +-- | Create an organization. +-- See +createOrganizationR :: CreateOrganization -> Request 'RW SimpleOrganization +createOrganizationR = + command Post ["admin", "organizations"] . encode + +-- | Rename an organization. +-- See +renameOrganizationR :: Name Organization -> RenameOrganization -> Request 'RW RenameOrganizationResponse +renameOrganizationR org = + command Patch ["admin", "organizations", toPathPart org] . encode diff --git a/src/GitHub/Endpoints/Gists.hs b/src/GitHub/Endpoints/Gists.hs --- a/src/GitHub/Endpoints/Gists.hs +++ b/src/GitHub/Endpoints/Gists.hs @@ -1,96 +1,47 @@ ------------------------------------------------------------------------------ -- | --- License : BSD-3-Clause --- Maintainer : Oleg Grenrus --- -- The gists API as described at . + module GitHub.Endpoints.Gists ( - gists, - gists', gistsR, - gist, - gist', gistR, - starGist, + createGistR, 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 ("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 ("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 ("github-username", "github-password") "225074" -starGist :: Auth -> Name Gist -> IO (Either Error ()) -starGist auth gid = executeRequest auth $ starGistR gid +-- | Create a new gist +-- See +createGistR :: NewGist -> Request 'RW Gist +createGistR ngist = command Post ["gists"] (encode ngist) -- | Star a gist by the authenticated user. -- See -starGistR :: Name Gist -> Request 'RW () -starGistR gid = command Put' ["gists", toPathPart gid, "star"] mempty - --- | Unstar a gist by the authenticated user. --- --- > unstarGist ("github-username", "github-password") "225074" -unstarGist :: Auth -> Name Gist -> IO (Either Error ()) -unstarGist auth gid = executeRequest auth $ unstarGistR gid +starGistR :: Name Gist -> GenRequest 'MtUnit 'RW () +starGistR gid = Command Put ["gists", toPathPart gid, "star"] mempty -- | Unstar a gist by the authenticated user. -- See -unstarGistR :: Name Gist -> Request 'RW () -unstarGistR gid = command Delete ["gists", toPathPart gid, "star"] mempty - --- | Delete a gist by the authenticated user. --- --- > deleteGist ("github-username", "github-password") "225074" -deleteGist :: Auth -> Name Gist -> IO (Either Error ()) -deleteGist auth gid = executeRequest auth $ deleteGistR gid +unstarGistR :: Name Gist -> GenRequest 'MtUnit 'RW () +unstarGistR gid = Command Delete ["gists", toPathPart gid, "star"] mempty -- | Delete a gist by the authenticated user. -- See -deleteGistR :: Name Gist -> Request 'RW () -deleteGistR gid = command Delete ["gists", toPathPart gid] mempty +deleteGistR :: Name Gist -> GenRequest 'MtUnit 'RW () +deleteGistR gid = Command Delete ["gists", toPathPart gid] mempty diff --git a/src/GitHub/Endpoints/Gists/Comments.hs b/src/GitHub/Endpoints/Gists/Comments.hs --- a/src/GitHub/Endpoints/Gists/Comments.hs +++ b/src/GitHub/Endpoints/Gists/Comments.hs @@ -1,42 +1,22 @@ ------------------------------------------------------------------------------ -- | --- 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 diff --git a/src/GitHub/Endpoints/GitData/Blobs.hs b/src/GitHub/Endpoints/GitData/Blobs.hs --- a/src/GitHub/Endpoints/GitData/Blobs.hs +++ b/src/GitHub/Endpoints/GitData/Blobs.hs @@ -1,34 +1,14 @@ ------------------------------------------------------------------------------ -- | --- 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 ("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 diff --git a/src/GitHub/Endpoints/GitData/Commits.hs b/src/GitHub/Endpoints/GitData/Commits.hs --- a/src/GitHub/Endpoints/GitData/Commits.hs +++ b/src/GitHub/Endpoints/GitData/Commits.hs @@ -1,27 +1,14 @@ ------------------------------------------------------------------------------ -- | --- 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 diff --git a/src/GitHub/Endpoints/GitData/References.hs b/src/GitHub/Endpoints/GitData/References.hs --- a/src/GitHub/Endpoints/GitData/References.hs +++ b/src/GitHub/Endpoints/GitData/References.hs @@ -1,61 +1,27 @@ ------------------------------------------------------------------------------ -- | --- 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, + deleteReferenceR, + namespacedReferencesR, 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 ("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. +-- | A single reference -- | 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) @@ -63,22 +29,16 @@ 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 +-- | Delete a reference. +-- See +deleteReferenceR :: Name Owner -> Name Repo -> Name GitReference -> GenRequest 'MtUnit 'RW () +deleteReferenceR user repo ref = + Command Delete ["repos", toPathPart user, toPathPart repo , "git", "refs", toPathPart ref] mempty -- | Query namespaced references. -- See diff --git a/src/GitHub/Endpoints/GitData/Trees.hs b/src/GitHub/Endpoints/GitData/Trees.hs --- a/src/GitHub/Endpoints/GitData/Trees.hs +++ b/src/GitHub/Endpoints/GitData/Trees.hs @@ -1,56 +1,22 @@ ------------------------------------------------------------------------------ -- | --- 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 ("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 ("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 diff --git a/src/GitHub/Endpoints/Issues.hs b/src/GitHub/Endpoints/Issues.hs --- a/src/GitHub/Endpoints/Issues.hs +++ b/src/GitHub/Endpoints/Issues.hs @@ -1,23 +1,13 @@ -{-# 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, @@ -25,7 +15,6 @@ import GitHub.Data import GitHub.Internal.Prelude -import GitHub.Request import Prelude () -- | See . @@ -38,42 +27,12 @@ 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 ("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 :: Name Owner -> Name Repo -> IssueNumber -> 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 ("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) @@ -85,17 +44,7 @@ -- Creating new issues. newIssue :: Text -> NewIssue -newIssue title = NewIssue title Nothing Nothing Nothing Nothing - - --- | Create a new issue. --- --- > createIssue (User (user, 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 +newIssue title = NewIssue title Nothing mempty Nothing Nothing -- | Create an issue. -- See @@ -109,16 +58,7 @@ editOfIssue = EditIssue Nothing Nothing Nothing Nothing Nothing Nothing -- | Edit an issue. --- --- > editIssue (User (user, 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 :: Name Owner -> Name Repo -> IssueNumber -> EditIssue -> Request 'RW Issue editIssueR user repo iss = command Patch ["repos", toPathPart user, toPathPart repo, "issues", toPathPart iss] . encode diff --git a/src/GitHub/Endpoints/Issues/Comments.hs b/src/GitHub/Endpoints/Issues/Comments.hs --- a/src/GitHub/Endpoints/Issues/Comments.hs +++ b/src/GitHub/Endpoints/Issues/Comments.hs @@ -1,89 +1,41 @@ ------------------------------------------------------------------------------ -- | --- 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 -> Id Issue -> IO (Either Error (Vector IssueComment)) -comments = comments' Nothing - --- | All comments on an issue, by the issue's number, using authentication. --- --- > comments' (User (user, password)) "thoughtbot" "paperclip" 635 -comments' :: Maybe Auth -> Name Owner -> Name Repo -> Id Issue -> 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 -> Id Issue -> FetchCount -> Request k (Vector IssueComment) +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 (User (user, password)) user repo issue --- > "some words" -createComment :: Auth -> Name Owner -> Name Repo -> Id Issue -> 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 -> Id Issue -> Text -> Request 'RW Comment +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 (User (user, 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 = @@ -92,17 +44,9 @@ parts = ["repos", toPathPart user, toPathPart repo, "issues", "comments", toPathPart commid] -- | Delete a comment. --- --- > deleteComment (User (user, 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 -> Request 'RW () +deleteCommentR :: Name Owner -> Name Repo -> Id Comment -> GenRequest 'MtUnit 'RW () deleteCommentR user repo commid = - command Delete parts mempty + Command Delete parts mempty where parts = ["repos", toPathPart user, toPathPart repo, "issues", "comments", toPathPart commid] diff --git a/src/GitHub/Endpoints/Issues/Events.hs b/src/GitHub/Endpoints/Issues/Events.hs --- a/src/GitHub/Endpoints/Issues/Events.hs +++ b/src/GitHub/Endpoints/Issues/Events.hs @@ -1,78 +1,29 @@ ------------------------------------------------------------------------------ -- | --- 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' (User (user, 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' (User (user, 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' (User (user, 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 diff --git a/src/GitHub/Endpoints/Issues/Labels.hs b/src/GitHub/Endpoints/Issues/Labels.hs --- a/src/GitHub/Endpoints/Issues/Labels.hs +++ b/src/GitHub/Endpoints/Issues/Labels.hs @@ -1,151 +1,59 @@ ------------------------------------------------------------------------------ -- | --- 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 (User (user 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 (User (user 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 (User (user 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 (User (user 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 +createLabelR :: Name Owner -> Name Repo -> NewIssueLabel -> Request 'RW IssueLabel +createLabelR user repo = + command Post ["repos", toPathPart user, toPathPart repo, "labels"] . encode -- | Update a label. -- See updateLabelR :: Name Owner -> Name Repo -> Name IssueLabel -- ^ old label name - -> Name IssueLabel -- ^ new label name - -> String -- ^ new color + -> UpdateIssueLabel -- ^ new label -> 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 (User (user 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 +updateLabelR user repo oldLbl = + command Patch ["repos", toPathPart user, toPathPart repo, "labels", toPathPart oldLbl] . encode -- | Delete a label. -- See -deleteLabelR :: Name Owner -> Name Repo -> Name IssueLabel -> Request 'RW () +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 (User (user 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 + Command Delete ["repos", toPathPart user, toPathPart repo, "labels", toPathPart lbl] mempty -- | List labels on an issue. -- See @@ -153,19 +61,6 @@ labelsOnIssueR user repo iid = pagedQuery ["repos", toPathPart user, toPathPart repo, "issues", toPathPart iid, "labels"] [] --- | Add labels to an issue. --- --- > addLabelsToIssue (User (user 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 @@ -180,30 +75,10 @@ paths = ["repos", toPathPart user, toPathPart repo, "issues", toPathPart iid, "labels"] -- | Remove a label from an issue. --- --- > removeLabelFromIssue (User (user 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 -> Request 'RW () +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 (User (user 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 + Command Delete ["repos", toPathPart user, toPathPart repo, "issues", toPathPart iid, "labels", toPathPart lbl] mempty -- | Replace all labels on an issue. -- See @@ -221,30 +96,10 @@ paths = ["repos", toPathPart user, toPathPart repo, "issues", toPathPart iid, "labels"] -- | Remove all labels from an issue. --- --- > removeAllLabelsFromIssue (User (user 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 -> Request 'RW () +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 (User (user 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 + Command Delete ["repos", toPathPart user, toPathPart repo, "issues", toPathPart iid, "labels"] mempty -- | Query labels for every issue in a milestone. -- See diff --git a/src/GitHub/Endpoints/Issues/Milestones.hs b/src/GitHub/Endpoints/Issues/Milestones.hs --- a/src/GitHub/Endpoints/Issues/Milestones.hs +++ b/src/GitHub/Endpoints/Issues/Milestones.hs @@ -1,52 +1,47 @@ ------------------------------------------------------------------------------ -- | --- License : BSD-3-Clause --- Maintainer : Oleg Grenrus --- -- The milestones API as described on -- . + module GitHub.Endpoints.Issues.Milestones ( - milestones, - milestones', milestonesR, - milestone, milestoneR, + createMilestoneR, + updateMilestoneR, + 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' (User (user, passwordG) "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] [] + +-- | 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 + +-- | 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 + +-- | 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 diff --git a/src/GitHub/Endpoints/Organizations.hs b/src/GitHub/Endpoints/Organizations.hs --- a/src/GitHub/Endpoints/Organizations.hs +++ b/src/GitHub/Endpoints/Organizations.hs @@ -1,53 +1,26 @@ ------------------------------------------------------------------------------ -- | --- 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 ("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 user organizations. +-- | 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 ("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 diff --git a/src/GitHub/Endpoints/Organizations/Members.hs b/src/GitHub/Endpoints/Organizations/Members.hs --- a/src/GitHub/Endpoints/Organizations/Members.hs +++ b/src/GitHub/Endpoints/Organizations/Members.hs @@ -1,42 +1,20 @@ ------------------------------------------------------------------------------ -- | --- 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, + orgMembershipR, 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 @@ -59,26 +37,11 @@ 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 -> Request k Bool -isMemberOfR user org = StatusQuery statusOnlyOk $ +isMemberOfR :: Name User -> Name Organization -> GenRequest 'MtStatus rw Bool +isMemberOfR user org = Query [ "orgs", toPathPart org, "members", toPathPart user ] [] -- | List pending organization invitations @@ -86,3 +49,10 @@ -- See orgInvitationsR :: Name Organization -> FetchCount -> Request 'RA (Vector Invitation) orgInvitationsR org = pagedQuery ["orgs", toPathPart org, "invitations"] [] + +-- | Get user membership information in an organization +-- +-- See +orgMembershipR :: Name User -> Name Organization -> Request 'RA Membership +orgMembershipR user org = + Query [ "orgs", toPathPart org, "memberships", toPathPart user ] [] diff --git a/src/GitHub/Endpoints/Organizations/OutsideCollaborators.hs b/src/GitHub/Endpoints/Organizations/OutsideCollaborators.hs new file mode 100644 --- /dev/null +++ b/src/GitHub/Endpoints/Organizations/OutsideCollaborators.hs @@ -0,0 +1,18 @@ +-- | +-- The organization members API as described on +-- . + +module GitHub.Endpoints.Organizations.OutsideCollaborators ( + outsideCollaboratorsR, + ) where + +import GitHub.Data +import GitHub.Internal.Prelude +import Prelude () + +-- | All the users who are outside collaborators of the specified organization. +-- +-- See +outsideCollaboratorsR :: Name Organization -> FetchCount -> Request k (Vector SimpleUser) +outsideCollaboratorsR organization = + pagedQuery ["orgs", toPathPart organization, "outside_collaborators"] [] diff --git a/src/GitHub/Endpoints/Organizations/Teams.hs b/src/GitHub/Endpoints/Organizations/Teams.hs --- a/src/GitHub/Endpoints/Organizations/Teams.hs +++ b/src/GitHub/Endpoints/Organizations/Teams.hs @@ -1,132 +1,56 @@ ------------------------------------------------------------------------------ -- | --- 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 -> Request 'RW () +deleteTeamR :: Id Team -> GenRequest 'MtUnit 'RW () deleteTeamR tid = - command Delete ["teams", toPathPart tid] mempty + Command Delete ["teams", toPathPart tid] mempty -- | List team members. -- @@ -140,45 +64,17 @@ 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 -> Request 'RW () +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 + Command Put ["teams", toPathPart tid, "repos", toPathPart org, toPathPart repo] (encode $ AddTeamRepoPermission permission) -- | Query team membership. -- See 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 -> Request 'RW () +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 + Command Delete ["teams", toPathPart tid, "memberships", toPathPart user] mempty -- | List user teams. -- See diff --git a/src/GitHub/Endpoints/PullRequests.hs b/src/GitHub/Endpoints/PullRequests.hs --- a/src/GitHub/Endpoints/PullRequests.hs +++ b/src/GitHub/Endpoints/PullRequests.hs @@ -1,52 +1,25 @@ ------------------------------------------------------------------------------ -- | --- License : BSD-3-Clause --- Maintainer : Oleg Grenrus --- -- The pull requests API as documented at -- . + module GitHub.Endpoints.PullRequests ( - pullRequestsFor, - pullRequestsFor', pullRequestsForR, - pullRequest', - pullRequest, pullRequestR, - createPullRequest, + pullRequestDiffR, + pullRequestPatchR, 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 () - --- | 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 +import Data.ByteString.Lazy (ByteString) -- | List pull requests. -- See @@ -60,36 +33,24 @@ ["repos", toPathPart user, toPathPart repo, "pulls"] (prModToQueryString opts) --- | A detailed pull request, which has much more information. This takes the --- repo owner and name along with the number assigned to the pull request. --- With authentification. --- --- > pullRequest' (Just ("github-username", "github-password")) "thoughtbot" "paperclip" 562 -pullRequest' :: Maybe Auth -> Name Owner -> Name Repo -> Id PullRequest -> IO (Either Error PullRequest) -pullRequest' auth user repo prid = - executeRequestMaybe auth $ pullRequestR user repo prid +-- | 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] [] --- | A detailed pull request, which has much more information. This takes the --- repo owner and name along with the number assigned to the pull request. --- --- > pullRequest "thoughtbot" "paperclip" 562 -pullRequest :: Name Owner -> Name Repo -> Id PullRequest -> IO (Either Error PullRequest) -pullRequest = pullRequest' 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] [] -- | Query a single pull request. -- See -pullRequestR :: Name Owner -> Name Repo -> Id PullRequest -> Request k PullRequest +pullRequestR :: Name Owner -> Name Repo -> IssueNumber -> Request k PullRequest pullRequestR user repo prid = query ["repos", toPathPart user, toPathPart repo, "pulls", toPathPart prid] [] -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 @@ -99,85 +60,38 @@ createPullRequestR user repo cpr = command Post ["repos", toPathPart user, toPathPart repo, "pulls"] (encode cpr) --- | Update a pull request -updatePullRequest :: Auth -> Name Owner -> Name Repo -> Id PullRequest -> EditPullRequest -> IO (Either Error PullRequest) -updatePullRequest auth user repo prid epr = - executeRequest auth $ updatePullRequestR user repo prid epr - -- | Update a pull request. -- See updatePullRequestR :: Name Owner -> Name Repo - -> Id PullRequest + -> 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 ("github-username", "github-password")) "thoughtbot" "paperclip" 688 -pullRequestCommits' :: Maybe Auth -> Name Owner -> Name Repo -> Id PullRequest -> IO (Either Error (Vector Commit)) -pullRequestCommits' auth user repo prid = - executeRequestMaybe auth $ pullRequestCommitsR user repo prid FetchAll - --- | All the commits on a pull request, given the repo owner, repo name, and --- the number of the pull request. --- --- > pullRequestCommits "thoughtbot" "paperclip" 688 -pullRequestCommitsIO :: Name Owner -> Name Repo -> Id PullRequest -> IO (Either Error (Vector Commit)) -pullRequestCommitsIO = pullRequestCommits' Nothing - -- | List commits on a pull request. -- See -pullRequestCommitsR :: Name Owner -> Name Repo -> Id PullRequest -> FetchCount -> Request k (Vector Commit) +pullRequestCommitsR :: Name Owner -> Name Repo -> IssueNumber -> FetchCount -> Request k (Vector Commit) pullRequestCommitsR user repo prid = pagedQuery ["repos", toPathPart user, toPathPart repo, "pulls", toPathPart prid, "commits"] [] --- | 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 ("github-username", "github-password")) "thoughtbot" "paperclip" 688 -pullRequestFiles' :: Maybe Auth -> Name Owner -> Name Repo -> Id PullRequest -> IO (Either Error (Vector File)) -pullRequestFiles' auth user repo prid = - executeRequestMaybe auth $ pullRequestFilesR user repo prid FetchAll - --- | The individual files that a pull request patches. Takes the repo owner and --- name, plus the number assigned to the pull request. --- --- > pullRequestFiles "thoughtbot" "paperclip" 688 -pullRequestFiles :: Name Owner -> Name Repo -> Id PullRequest -> IO (Either Error (Vector File)) -pullRequestFiles = pullRequestFiles' Nothing - -- | List pull requests files. -- See -pullRequestFilesR :: Name Owner -> Name Repo -> Id PullRequest -> FetchCount -> Request k (Vector File) +pullRequestFilesR :: Name Owner -> Name Repo -> IssueNumber -> FetchCount -> Request k (Vector File) pullRequestFilesR user repo prid = pagedQuery ["repos", toPathPart user, toPathPart repo, "pulls", toPathPart prid, "files"] [] --- | Check if pull request has been merged. -isPullRequestMerged :: Auth -> Name Owner -> Name Repo -> Id PullRequest -> 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 -> Id PullRequest -> Request k Bool -isPullRequestMergedR user repo prid = StatusQuery statusOnlyOk $ +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 -> Id PullRequest -> 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 -> Id PullRequest -> Maybe Text -> Request 'RW MergeResult -mergePullRequestR user repo prid commitMessage = StatusQuery statusMerge $ +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"] @@ -185,4 +99,3 @@ buildCommitMessageMap :: Maybe Text -> Value buildCommitMessageMap (Just msg) = object ["commit_message" .= msg ] buildCommitMessageMap Nothing = object [] - diff --git a/src/GitHub/Endpoints/PullRequests/Comments.hs b/src/GitHub/Endpoints/PullRequests/Comments.hs --- a/src/GitHub/Endpoints/PullRequests/Comments.hs +++ b/src/GitHub/Endpoints/PullRequests/Comments.hs @@ -1,45 +1,46 @@ ------------------------------------------------------------------------------ -- | --- 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, + createPullCommentR, + createPullCommentReplyR, 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 -> Id PullRequest -> 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 -> Id PullRequest -> FetchCount -> Request k (Vector Comment) +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 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"] + +-- | Create a comment reply. +-- +-- See +createPullCommentReplyR :: Name Owner -> Name Repo -> IssueNumber -> Id Comment -> Text -> Request 'RW Comment +createPullCommentReplyR user repo iss cid body = + command Post parts (encode $ PullCommentReply body) + where + parts = ["repos", toPathPart user, toPathPart repo, "pulls", toPathPart iss + , "comments", toPathPart cid, "replies"] diff --git a/src/GitHub/Endpoints/PullRequests/Reviews.hs b/src/GitHub/Endpoints/PullRequests/Reviews.hs --- a/src/GitHub/Endpoints/PullRequests/Reviews.hs +++ b/src/GitHub/Endpoints/PullRequests/Reviews.hs @@ -1,27 +1,15 @@ ------------------------------------------------------------------------------ -- | --- 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. @@ -29,7 +17,7 @@ pullRequestReviewsR :: Name Owner -> Name Repo - -> Id PullRequest + -> IssueNumber -> FetchCount -> Request k (Vector Review) pullRequestReviewsR owner repo prid = @@ -43,37 +31,12 @@ ] [] --- | 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 ("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 + -> IssueNumber -> Id Review -> Request k Review pullRequestReviewR owner repo prid rid = @@ -88,40 +51,12 @@ ] [] --- | 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 ("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 + -> IssueNumber -> Id Review -> Request k [ReviewComment] pullRequestReviewCommentsR owner repo prid rid = @@ -136,30 +71,3 @@ , "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 ("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 diff --git a/src/GitHub/Endpoints/RateLimit.hs b/src/GitHub/Endpoints/RateLimit.hs new file mode 100644 --- /dev/null +++ b/src/GitHub/Endpoints/RateLimit.hs @@ -0,0 +1,16 @@ +-- | +-- The Github RateLimit API, as described at +-- . + +module GitHub.Endpoints.RateLimit ( + rateLimitR, + module GitHub.Data, + ) where + +import GitHub.Data +import Prelude () + +-- | Get your current rate limit status. +-- +rateLimitR :: Request k RateLimit +rateLimitR = query ["rate_limit"] [] diff --git a/src/GitHub/Endpoints/Reactions.hs b/src/GitHub/Endpoints/Reactions.hs new file mode 100644 --- /dev/null +++ b/src/GitHub/Endpoints/Reactions.hs @@ -0,0 +1,60 @@ +-- | +-- The Reactions API as described at +-- . +module GitHub.Endpoints.Reactions ( + issueReactionsR, + createIssueReactionR, + deleteIssueReactionR, + commentReactionsR, + createCommentReactionR, + deleteCommentReactionR, + module GitHub.Data, +) where + +import GitHub.Data +import GitHub.Internal.Prelude +import Prelude () + +-- | List reactions for an issue. +-- See +issueReactionsR :: Name Owner -> Name Repo -> Id Issue -> FetchCount -> Request k (Vector Reaction) +issueReactionsR owner repo iid = + pagedQuery ["repos", toPathPart owner, toPathPart repo, "issues", toPathPart iid, "reactions"] [] + +-- | Create reaction for an issue comment. +-- See +createIssueReactionR :: Name Owner -> Name Repo -> Id Issue -> ReactionContent -> Request 'RW Reaction +createIssueReactionR owner repo iid content = + command Post parts (encode $ NewReaction content) + where + parts = ["repos", toPathPart owner, toPathPart repo, "issues", toPathPart iid, "reactions"] + +-- | Delete an issue comment reaction. +-- See +deleteIssueReactionR :: Name Owner -> Name Repo -> Id Issue -> Id Reaction -> GenRequest 'MtUnit 'RW () +deleteIssueReactionR owner repo iid rid = + Command Delete parts mempty + where + parts = ["repos", toPathPart owner, toPathPart repo, "issues", toPathPart iid, "reactions", toPathPart rid] + +-- | List reactions for an issue comment. +-- See +commentReactionsR :: Name Owner -> Name Repo -> Id Comment -> FetchCount -> Request k (Vector Reaction) +commentReactionsR owner repo cid = + pagedQuery ["repos", toPathPart owner, toPathPart repo, "issues", "comments", toPathPart cid, "reactions"] [] + +-- | Create reaction for an issue comment. +-- See https://docs.github.com/en/rest/reactions/reactions?apiVersion=2022-11-28#create-reaction-for-an-issue-comment +createCommentReactionR :: Name Owner -> Name Repo -> Id Comment -> ReactionContent -> Request 'RW Reaction +createCommentReactionR owner repo cid content = + command Post parts (encode $ NewReaction content) + where + parts = ["repos", toPathPart owner, toPathPart repo, "issues", "comments", toPathPart cid, "reactions"] + +-- | Delete an issue comment reaction. +-- See +deleteCommentReactionR :: Name Owner -> Name Repo -> Id Comment -> Id Reaction -> GenRequest 'MtUnit 'RW () +deleteCommentReactionR owner repo cid rid = + Command Delete parts mempty + where + parts = ["repos", toPathPart owner, toPathPart repo, "issues", "comments", toPathPart cid, "reactions", toPathPart rid] diff --git a/src/GitHub/Endpoints/Repos.hs b/src/GitHub/Endpoints/Repos.hs --- a/src/GitHub/Endpoints/Repos.hs +++ b/src/GitHub/Endpoints/Repos.hs @@ -1,51 +1,27 @@ ------------------------------------------------------------------------------ -- | --- 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, forkExistingRepoR, -- ** Edit - editRepo, editRepoR, -- ** Delete - deleteRepo, deleteRepoR, -- * Data @@ -54,7 +30,6 @@ import GitHub.Data import GitHub.Internal.Prelude -import GitHub.Request import Prelude () repoPublicityQueryString :: RepoPublicity -> QueryString @@ -65,65 +40,23 @@ 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 +-- 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 (user, 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 +-- 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 (user, 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 +-- See organizationReposR :: Name Organization -> RepoPublicity @@ -134,20 +67,6 @@ 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 (user, 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 @@ -155,13 +74,6 @@ 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 = @@ -175,32 +87,12 @@ 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 = @@ -209,20 +101,6 @@ -- 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 (user, 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 @@ -237,93 +115,26 @@ 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 (user, 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 (user, 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 (user, 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 (user, 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 - -deleteRepoR :: Name Owner -> Name Repo -> Request 'RW () +-- | Delete a repository,. +-- See +deleteRepoR :: Name Owner -> Name Repo -> GenRequest 'MtUnit 'RW () deleteRepoR user repo = - command Delete ["repos", toPathPart user, toPathPart repo] mempty + Command Delete ["repos", toPathPart user, toPathPart repo] mempty diff --git a/src/GitHub/Endpoints/Repos/Collaborators.hs b/src/GitHub/Endpoints/Repos/Collaborators.hs --- a/src/GitHub/Endpoints/Repos/Collaborators.hs +++ b/src/GitHub/Endpoints/Repos/Collaborators.hs @@ -1,55 +1,34 @@ ------------------------------------------------------------------------------ -- | --- License : BSD-3-Clause --- Maintainer : Oleg Grenrus --- -- The repo collaborators API as described on -- . + module GitHub.Endpoints.Repos.Collaborators ( - collaboratorsOn, - collaboratorsOn', collaboratorsOnR, - isCollaboratorOn, + collaboratorPermissionOnR, isCollaboratorOnR, + 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 +-- | Review a user's permission level. +-- +collaboratorPermissionOnR + :: 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 + -> Name User -- ^ Collaborator to check permissions of. + -> GenRequest 'MtJSON rw CollaboratorWithPermission +collaboratorPermissionOnR owner repo coll = + query ["repos", toPathPart owner, toPathPart repo, "collaborators", toPathPart coll, "permission"] [] -- | Check if a user is a collaborator. -- See @@ -57,6 +36,16 @@ :: Name Owner -- ^ Repository owner -> Name Repo -- ^ Repository name -> Name User -- ^ Collaborator? - -> Request k Bool -isCollaboratorOnR user repo coll = StatusQuery statusOnlyOk $ + -> GenRequest 'MtStatus rw Bool +isCollaboratorOnR user repo coll = Query ["repos", toPathPart user, toPathPart repo, "collaborators", toPathPart 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 diff --git a/src/GitHub/Endpoints/Repos/Comments.hs b/src/GitHub/Endpoints/Repos/Comments.hs --- a/src/GitHub/Endpoints/Repos/Comments.hs +++ b/src/GitHub/Endpoints/Repos/Comments.hs @@ -1,81 +1,29 @@ -{-# 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 diff --git a/src/GitHub/Endpoints/Repos/Commits.hs b/src/GitHub/Endpoints/Repos/Commits.hs --- a/src/GitHub/Endpoints/Repos/Commits.hs +++ b/src/GitHub/Endpoints/Repos/Commits.hs @@ -1,31 +1,18 @@ -{-# 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 @@ -39,37 +26,11 @@ 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 (user, 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 (user, 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) @@ -78,39 +39,11 @@ 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 (username, 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 diff --git a/src/GitHub/Endpoints/Repos/Contents.hs b/src/GitHub/Endpoints/Repos/Contents.hs --- a/src/GitHub/Endpoints/Repos/Contents.hs +++ b/src/GitHub/Endpoints/Repos/Contents.hs @@ -1,32 +1,20 @@ ------------------------------------------------------------------------------ -- | --- 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 @@ -34,27 +22,12 @@ 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 (user, 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 @@ -66,60 +39,23 @@ 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 (user, 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 (user, 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 - -> Request k URI -archiveForR user repo format ref = - RedirectQuery $ Query path [] + -> 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 @@ -130,16 +66,6 @@ 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 @@ -150,21 +76,11 @@ 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 - -> Request 'RW () + -> GenRequest 'MtUnit 'RW () deleteFileR user repo body = - command Delete ["repos", toPathPart user, toPathPart repo, "contents", deleteFilePath body] (encode body) + Command Delete ["repos", toPathPart user, toPathPart repo, "contents", deleteFilePath body] (encode body) diff --git a/src/GitHub/Endpoints/Repos/DeployKeys.hs b/src/GitHub/Endpoints/Repos/DeployKeys.hs --- a/src/GitHub/Endpoints/Repos/DeployKeys.hs +++ b/src/GitHub/Endpoints/Repos/DeployKeys.hs @@ -7,64 +7,40 @@ -- 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 -> Request 'RW () +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 + Command Delete ["repos", toPathPart user, toPathPart repo, "keys", toPathPart keyId] mempty diff --git a/src/GitHub/Endpoints/Repos/Deployments.hs b/src/GitHub/Endpoints/Repos/Deployments.hs new file mode 100644 --- /dev/null +++ b/src/GitHub/Endpoints/Repos/Deployments.hs @@ -0,0 +1,72 @@ +-- | The deployments API, as described at +module GitHub.Endpoints.Repos.Deployments + ( deploymentsWithOptionsForR + , createDeploymentR + + , deploymentStatusesForR + , createDeploymentStatusR + + , module GitHub.Data + ) where + +import Control.Arrow (second) + +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"] diff --git a/src/GitHub/Endpoints/Repos/Forks.hs b/src/GitHub/Endpoints/Repos/Forks.hs --- a/src/GitHub/Endpoints/Repos/Forks.hs +++ b/src/GitHub/Endpoints/Repos/Forks.hs @@ -1,35 +1,15 @@ ------------------------------------------------------------------------------ -- | --- 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 (User (user, 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 diff --git a/src/GitHub/Endpoints/Repos/Invitations.hs b/src/GitHub/Endpoints/Repos/Invitations.hs new file mode 100644 --- /dev/null +++ b/src/GitHub/Endpoints/Repos/Invitations.hs @@ -0,0 +1,32 @@ +-- | +-- 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 diff --git a/src/GitHub/Endpoints/Repos/Releases.hs b/src/GitHub/Endpoints/Repos/Releases.hs --- a/src/GitHub/Endpoints/Repos/Releases.hs +++ b/src/GitHub/Endpoints/Repos/Releases.hs @@ -1,95 +1,34 @@ -- 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 (User (user, 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 (User (user, 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 (User (user, 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 (User (user, 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 diff --git a/src/GitHub/Endpoints/Repos/Statuses.hs b/src/GitHub/Endpoints/Repos/Statuses.hs --- a/src/GitHub/Endpoints/Repos/Statuses.hs +++ b/src/GitHub/Endpoints/Repos/Statuses.hs @@ -1,35 +1,19 @@ ------------------------------------------------------------------------------ -- | --- 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 = @@ -38,26 +22,10 @@ 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 diff --git a/src/GitHub/Endpoints/Repos/Webhooks.hs b/src/GitHub/Endpoints/Repos/Webhooks.hs --- a/src/GitHub/Endpoints/Repos/Webhooks.hs +++ b/src/GitHub/Endpoints/Repos/Webhooks.hs @@ -1,111 +1,70 @@ ------------------------------------------------------------------------------ -- | --- 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 -> Request 'RW Bool -testPushRepoWebhookR user repo hookId = StatusQuery statusOnlyOk $ +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 -> Request 'RW Bool -pingRepoWebhookR user repo hookId = StatusQuery statusOnlyOk $ +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 -> Request 'RW () +deleteRepoWebhookR :: Name Owner -> Name Repo -> Id RepoWebhook -> GenRequest 'MtUnit 'RW () deleteRepoWebhookR user repo hookId = - command Delete (createWebhookOpPath user repo hookId Nothing) mempty + Command Delete (createWebhookOpPath user repo hookId Nothing) mempty createBaseWebhookPath :: Name Owner -> Name Repo -> Id RepoWebhook -> Paths createBaseWebhookPath user repo hookId = diff --git a/src/GitHub/Endpoints/Search.hs b/src/GitHub/Endpoints/Search.hs --- a/src/GitHub/Endpoints/Search.hs +++ b/src/GitHub/Endpoints/Search.hs @@ -1,86 +1,41 @@ ------------------------------------------------------------------------------ -- | --- 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, + searchUsersR, 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 :: Text -> FetchCount -> 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 + PagedQuery ["search", "repositories"] [("q", Just $ TE.encodeUtf8 searchString)] -- | Search code. -- See -searchCodeR :: Text -> Request k (SearchResult Code) +searchCodeR :: Text -> FetchCount -> 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 + PagedQuery ["search", "code"] [("q", Just $ TE.encodeUtf8 searchString)] -- | Search issues. -- See -searchIssuesR :: Text -> Request k (SearchResult Issue) +searchIssuesR :: Text -> FetchCount -> Request k (SearchResult Issue) searchIssuesR searchString = - query ["search", "issues"] [("q", Just $ TE.encodeUtf8 searchString)] + PagedQuery ["search", "issues"] [("q", Just $ TE.encodeUtf8 searchString)] + +-- | Search users. +-- See +searchUsersR :: Text -> FetchCount -> Request k (SearchResult SimpleUser) +searchUsersR searchString = + PagedQuery ["search", "users"] [("q", Just $ TE.encodeUtf8 searchString)] diff --git a/src/GitHub/Endpoints/Users.hs b/src/GitHub/Endpoints/Users.hs --- a/src/GitHub/Endpoints/Users.hs +++ b/src/GitHub/Endpoints/Users.hs @@ -1,40 +1,26 @@ ------------------------------------------------------------------------------ -- | --- 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 ("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 +-- +-- >>> github' userInfoForR "mike-burns" +-- +-- or +-- +-- >>> github userInfoForR (OAuth "github-token") "mike-burns" +-- userInfoForR :: Name User -> Request k User userInfoForR user = query ["users", toPathPart user] [] @@ -42,13 +28,6 @@ -- 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 diff --git a/src/GitHub/Endpoints/Users/Emails.hs b/src/GitHub/Endpoints/Users/Emails.hs --- a/src/GitHub/Endpoints/Users/Emails.hs +++ b/src/GitHub/Endpoints/Users/Emails.hs @@ -1,42 +1,22 @@ ------------------------------------------------------------------------------ -- | --- 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 diff --git a/src/GitHub/Endpoints/Users/Followers.hs b/src/GitHub/Endpoints/Users/Followers.hs --- a/src/GitHub/Endpoints/Users/Followers.hs +++ b/src/GitHub/Endpoints/Users/Followers.hs @@ -1,13 +1,8 @@ ------------------------------------------------------------------------------ -- | --- 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, @@ -15,28 +10,13 @@ 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 diff --git a/src/GitHub/Endpoints/Users/PublicSSHKeys.hs b/src/GitHub/Endpoints/Users/PublicSSHKeys.hs new file mode 100644 --- /dev/null +++ b/src/GitHub/Endpoints/Users/PublicSSHKeys.hs @@ -0,0 +1,53 @@ +----------------------------------------------------------------------------- +-- | +-- License : BSD-3-Clause +-- Maintainer : Todd Mohney +-- +-- The public keys API, as described at +-- +module GitHub.Endpoints.Users.PublicSSHKeys ( + -- * Querying public SSH keys + publicSSHKeysR, + publicSSHKeysForR, + publicSSHKeyR, + + -- ** Create + createUserPublicSSHKeyR, + + -- ** Delete + deleteUserPublicSSHKeyR, +) where + +import GitHub.Data +import GitHub.Internal.Prelude +import Prelude () + +-- | 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 +-- See +publicSSHKeysR :: Request 'RA (Vector PublicSSHKey) +publicSSHKeysR = + query ["user", "keys"] [] + +-- | Querying a public SSH key. +-- See +publicSSHKeyR :: Id PublicSSHKey -> Request 'RA PublicSSHKey +publicSSHKeyR keyId = + query ["user", "keys", toPathPart keyId] [] + +-- | Create a public SSH key. +-- See . +createUserPublicSSHKeyR :: NewPublicSSHKey -> Request 'RW PublicSSHKey +createUserPublicSSHKeyR key = + command Post ["user", "keys"] (encode key) + +-- | Delete a public SSH key. +-- See +deleteUserPublicSSHKeyR :: Id PublicSSHKey -> GenRequest 'MtUnit 'RW () +deleteUserPublicSSHKeyR keyId = + Command Delete ["user", "keys", toPathPart keyId] mempty diff --git a/src/GitHub/Enterprise.hs b/src/GitHub/Enterprise.hs new file mode 100644 --- /dev/null +++ b/src/GitHub/Enterprise.hs @@ -0,0 +1,19 @@ +-- | +-- This module re-exports all request constructors and data definitions for +-- working with GitHub Enterprise. + +module GitHub.Enterprise ( + -- * Enterprise Admin + -- | See + + -- ** Organizations + -- | See + createOrganizationR, + renameOrganizationR, + + -- * Data definitions + module GitHub.Data.Enterprise, + ) where + +import GitHub.Data.Enterprise +import GitHub.Endpoints.Enterprise.Organizations diff --git a/src/GitHub/Internal/Prelude.hs b/src/GitHub/Internal/Prelude.hs --- a/src/GitHub/Internal/Prelude.hs +++ b/src/GitHub/Internal/Prelude.hs @@ -1,60 +1,30 @@ {-# LANGUAGE NoImplicitPrelude #-} ------------------------------------------------------------------------------ + -- | --- License : BSD-3-Clause --- Maintainer : Oleg Grenrus --- --- This module may change between minor releases. Do not rely on it 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, - encode, - withText, withObject, (.:), (.:?), (.!=), (.=), object, typeMismatch, - -- * Control.Applicative - (<|>), - -- * Data.Maybe - catMaybes, - -- * Data.List - intercalate, toList, - -- * Data.Time.ISO8601 - formatISO8601, - ) where +-- This module may change between minor releases. Do not rely on its contents. -import Control.Applicative ((<|>)) -import Control.DeepSeq (NFData (..)) -import Control.DeepSeq.Generics (genericRnf) -import Data.Aeson.Compat +module GitHub.Internal.Prelude ( module X ) where + +import Control.Applicative as X ((<|>)) +import Control.DeepSeq as X (NFData (..)) +import Data.Aeson as X (FromJSON (..), Object, ToJSON (..), Value (..), encode, object, withObject, withText, (.!=), (.:), (.:?), (.=)) -import Data.Aeson.Types (typeMismatch) -import Data.Binary (Binary) -import Data.Binary.Orphans () -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 +import Data.Aeson.Types as X (emptyObject, typeMismatch) +import Data.Binary as X (Binary) +import Data.Binary.Instances as X () +import Data.Data as X (Data) +import Data.Foldable as X (toList) +import Data.Hashable as X (Hashable (..)) +import Data.HashMap.Strict as X (HashMap) +import Data.List as X (intercalate) +import Data.Maybe as X (catMaybes) +import Data.Semigroup as X (Semigroup (..)) +import Data.String as X (IsString (..)) +import Data.Text as X (Text, pack, unpack) +import Data.Time as X (UTCTime) +import Data.Time.ISO8601 as X (formatISO8601) +import Data.Vector as X (Vector) +import GHC.Generics as X (Generic) +import Prelude.Compat as X +import Data.Functor.Compat as X ((<&>)) diff --git a/src/GitHub/Request.hs b/src/GitHub/Request.hs --- a/src/GitHub/Request.hs +++ b/src/GitHub/Request.hs @@ -1,13 +1,13 @@ -{-# LANGUAGE CPP #-} -{-# LANGUAGE FlexibleContexts #-} -{-# LANGUAGE GADTs #-} -{-# LANGUAGE KindSignatures #-} -{-# LANGUAGE StandaloneDeriving #-} ------------------------------------------------------------------------------ +{-# LANGUAGE CPP #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE FunctionalDependencies #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE KindSignatures #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE UndecidableInstances #-} + -- | --- 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. @@ -27,9 +27,16 @@ -- > -- | Lift request into Monad -- > githubRequest :: GH.Request 'False a -> GithubMonad a -- > githubRequest = singleton + module GitHub.Request ( + -- * A convenient execution of requests + github, + github', + GitHubRW, + GitHubRO, -- * Types - Request(..), + Request, + GenRequest (..), CommandMethod(..), toMethod, Paths, @@ -37,172 +44,397 @@ -- * Request execution in IO executeRequest, executeRequestWithMgr, + executeRequestWithMgrAndRes, executeRequest', executeRequestWithMgr', executeRequestMaybe, unsafeDropAuthRequirements, -- * Helpers + Accept (..), + ParseResponse (..), makeHttpRequest, - makeHttpSimpleRequest, - parseResponse, parseStatus, + parsePageLinks, + StatusMap, getNextUrl, performPagedRequest, + parseResponseJSON, + -- ** Preview + PreviewAccept (..), + PreviewParseResponse (..), + -- * SSL + -- | This always exist, independently of @openssl@ configuration flag. + -- They change accordingly, to make use of the library simpler. + withOpenSSL, + tlsManagerSettings, ) where import GitHub.Internal.Prelude import Prelude () -#if MIN_VERSION_mtl(2,2,0) -import Control.Monad.Except (MonadError (..)) -#else -import Control.Monad.Error (MonadError (..)) -#endif +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.Compat (eitherDecode) +import Data.Aeson (eitherDecode) import Data.List (find) +import Data.Maybe (fromMaybe) +import Data.Tagged (Tagged (..)) +import Data.Version (showVersion) import Network.HTTP.Client - (HttpException (..), Manager, RequestBody (..), Response (..), - applyBasicAuth, getUri, httpLbs, method, newManager, redirectCount, - requestBody, requestHeaders, setQueryString, setRequestIgnoreStatus) -import Network.HTTP.Client.TLS (tlsManagerSettings) + (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.Link.Types (Link(..), LinkParam (..), href, linkParams) import Network.HTTP.Types (Method, RequestHeaders, Status (..)) -import Network.URI (URI, parseURIReference, relativeTo) - -#if !MIN_VERSION_http_client(0,5,0) -import qualified Control.Exception as E -import Network.HTTP.Types (ResponseHeaders) -#endif +import Network.URI + (URI, escapeURIString, isUnescapedInURIComponent, parseURIReference, + relativeTo) +import qualified Data.ByteString as BS +import Data.ByteString.Builder (intDec, toLazyByteString) 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 -import GitHub.Auth (Auth (..)) -import GitHub.Data (Error (..)) +#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 (AuthMethod, endpoint, setAuthRequest) +import GitHub.Data (Error (..)) +import GitHub.Data.PullRequests (MergeResult (..)) import GitHub.Data.Request --- | Execute 'Request' in 'IO' -executeRequest :: Auth -> Request k a -> IO (Either Error a) -executeRequest auth req = do - manager <- newManager tlsManagerSettings - x <- executeRequestWithMgr manager auth req -#if !MIN_VERSION_http_client(0, 4, 18) - closeManager manager +import Paths_github (version) + +------------------------------------------------------------------------------- +-- Convenience +------------------------------------------------------------------------------- + +-- | A convenience function to turn functions returning @'Request' rw x@, +-- into functions returning @IO (Either 'Error' x)@. +-- +-- >>> :t \auth -> github auth userInfoForR +-- \auth -> github auth userInfoForR +-- :: AuthMethod am => am -> Name User -> IO (Either Error User) +-- +-- >>> :t github pullRequestsForR +-- \auth -> github auth pullRequestsForR +-- :: AuthMethod am => +-- am +-- -> Name Owner +-- -> Name Repo +-- -> PullRequestMod +-- -> FetchCount +-- -> IO (Either Error (Data.Vector.Vector SimplePullRequest)) +-- +github :: (AuthMethod am, GitHubRW req res) => am -> req -> res +github = githubImpl + +-- | Like 'github'' but for 'RO' i.e. read-only requests. +-- Note that GitHub has low request limit for non-authenticated requests. +-- +-- >>> :t github' userInfoForR +-- github' userInfoForR :: Name User -> IO (Either Error User) +-- +github' :: GitHubRO req res => req -> res +github' = githubImpl' + +-- | A type-class implementing 'github'. +class GitHubRW req res | req -> res where + githubImpl :: AuthMethod am => am -> req -> res + +-- | A type-class implementing 'github''. +class GitHubRO req res | req -> res where + githubImpl' :: req -> res + +instance (ParseResponse mt req, res ~ Either Error req) => GitHubRW (GenRequest mt rw req) (IO res) where + githubImpl = executeRequest + +instance (ParseResponse mt req, res ~ Either Error req, rw ~ 'RO) => GitHubRO (GenRequest mt rw req) (IO res) where + githubImpl' = executeRequest' + +instance GitHubRW req res => GitHubRW (a -> req) (a -> res) where + githubImpl am req x = githubImpl am (req x) + +instance GitHubRO req res => GitHubRO (a -> req) (a -> res) where + githubImpl' req x = githubImpl' (req x) + +------------------------------------------------------------------------------- +-- Execution +------------------------------------------------------------------------------- + +#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 - pure x -lessFetchCount :: Int -> FetchCount -> Bool -lessFetchCount _ FetchAll = True -lessFetchCount i (FetchAtLeast j) = i < fromIntegral j +-- | Execute 'Request' in 'IO' +executeRequest + :: (AuthMethod am, ParseResponse mt a) + => am + -> GenRequest mt rw a + -> IO (Either Error a) +executeRequest auth req = withOpenSSL $ do + manager <- newManager tlsManagerSettings + executeRequestWithMgr manager auth req -- | Like 'executeRequest' but with provided 'Manager'. executeRequestWithMgr - :: Manager - -> Auth - -> Request k a + :: (AuthMethod am, ParseResponse mt a) + => Manager + -> am + -> GenRequest mt rw a -> IO (Either Error a) -executeRequestWithMgr mgr auth req = runExceptT $ do +executeRequestWithMgr mgr auth req = + fmap (fmap responseBody) (executeRequestWithMgrAndRes mgr auth req) + +-- | Execute request and return the last received 'HTTP.Response'. +-- +-- @since 0.24 +executeRequestWithMgrAndRes + :: (AuthMethod am, ParseResponse mt a) + => Manager + -> am + -> GenRequest mt rw a + -> IO (Either Error (HTTP.Response a)) +executeRequestWithMgrAndRes mgr auth req = runExceptT $ do httpReq <- makeHttpRequest (Just auth) req performHttpReq httpReq req where - httpLbs' :: HTTP.Request -> ExceptT Error IO (Response LBS.ByteString) + httpLbs' :: HTTP.Request -> ExceptT Error IO (HTTP.Response LBS.ByteString) httpLbs' req' = lift (httpLbs req' mgr) `catch` onHttpException - performHttpReq :: HTTP.Request -> Request k b -> ExceptT Error IO b - performHttpReq httpReq (SimpleQuery sreq) = - performHttpReq' httpReq sreq - performHttpReq httpReq (HeaderQuery _ sreq) = - performHttpReq' httpReq sreq - performHttpReq httpReq (StatusQuery sm _) = do - res <- httpLbs' httpReq - parseStatus sm . responseStatus $ res - performHttpReq httpReq (RedirectQuery _) = do + performHttpReq :: forall rw mt b. ParseResponse mt b => HTTP.Request -> GenRequest mt rw b -> ExceptT Error IO (HTTP.Response b) + performHttpReq httpReq Query {} = do res <- httpLbs' httpReq - parseRedirect (getUri httpReq) res + (<$ res) <$> unTagged (parseResponse httpReq res :: Tagged mt (ExceptT Error IO b)) - performHttpReq' :: FromJSON b => HTTP.Request -> SimpleRequest k b -> ExceptT Error IO b - performHttpReq' httpReq Query {} = do - res <- httpLbs' httpReq - parseResponse res - performHttpReq' httpReq (PagedQuery _ _ l) = - performPagedRequest httpLbs' predicate httpReq - where - predicate v = lessFetchCount (V.length v) l - performHttpReq' httpReq (Command m _ _) = do - res <- httpLbs' httpReq - case m of - Delete -> pure () - Put' -> pure () - _ -> parseResponse res + performHttpReq httpReq (PagedQuery _ _ (FetchPage _)) = do + (res, _pageLinks) <- unTagged (performPerPageRequest httpLbs' httpReq :: Tagged mt (ExceptT Error IO (HTTP.Response b, PageLinks))) + return res + performHttpReq httpReq (PagedQuery _ _ FetchAll) = + unTagged (performPagedRequest httpLbs' (const True) httpReq :: Tagged mt (ExceptT Error IO (HTTP.Response b))) + performHttpReq httpReq (PagedQuery _ _ (FetchAtLeast j)) = + unTagged (performPagedRequest httpLbs' (\v -> length v < fromIntegral j) httpReq :: Tagged mt (ExceptT Error IO (HTTP.Response b))) + performHttpReq httpReq (Command _ _ _) = do + res <- httpLbs' httpReq + (<$ res) <$> unTagged (parseResponse httpReq res :: Tagged mt (ExceptT Error IO b)) -- | Like 'executeRequest' but without authentication. -executeRequest' ::Request 'RO a -> IO (Either Error a) -executeRequest' req = do +executeRequest' :: ParseResponse mt a => GenRequest mt 'RO a -> IO (Either Error a) +executeRequest' req = withOpenSSL $ do manager <- newManager tlsManagerSettings - x <- executeRequestWithMgr' manager req -#if !MIN_VERSION_http_client(0, 4, 18) - closeManager manager -#endif - pure x + executeRequestWithMgr' manager req -- | Like 'executeRequestWithMgr' but without authentication. executeRequestWithMgr' - :: Manager - -> Request 'RO a + :: ParseResponse mt a + => Manager + -> GenRequest mt 'RO a -> IO (Either Error a) -executeRequestWithMgr' mgr req = runExceptT $ do - httpReq <- makeHttpRequest Nothing req - performHttpReq httpReq req - where - httpLbs' :: HTTP.Request -> ExceptT Error IO (Response LBS.ByteString) - httpLbs' req' = lift (httpLbs req' mgr) `catch` onHttpException - - performHttpReq :: HTTP.Request -> Request 'RO b -> ExceptT Error IO b - performHttpReq httpReq (SimpleQuery sreq) = - performHttpReq' httpReq sreq - performHttpReq httpReq (HeaderQuery _ sreq) = - performHttpReq' httpReq sreq - performHttpReq httpReq (StatusQuery sm _) = do - res <- httpLbs' httpReq - parseStatus sm . responseStatus $ res - performHttpReq httpReq (RedirectQuery _) = do - res <- httpLbs' httpReq - parseRedirect (getUri httpReq) res - - performHttpReq' :: FromJSON b => HTTP.Request -> SimpleRequest 'RO b -> ExceptT Error IO b - performHttpReq' httpReq Query {} = do - res <- httpLbs' httpReq - parseResponse res - performHttpReq' httpReq (PagedQuery _ _ l) = - performPagedRequest httpLbs' predicate httpReq - where - predicate v = lessFetchCount (V.length v) l +executeRequestWithMgr' mgr = executeRequestWithMgr mgr () -- | Helper for picking between 'executeRequest' and 'executeRequest''. -- -- The use is discouraged. -executeRequestMaybe :: Maybe Auth -> Request 'RO a -> IO (Either Error a) +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 :: Request k' a -> Request k a -unsafeDropAuthRequirements (SimpleQuery (Query ps qs)) = - SimpleQuery (Query ps qs) -unsafeDropAuthRequirements r = +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 => 'HTTP.Response' 'LBS.ByteString' -> 'Either' 'Error' a +-- @ +parseResponseJSON :: (FromJSON a, MonadError Error m) => HTTP.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 :: 'HTTP.Response' 'LBS.ByteString' -> 'Either' 'Error' a +-- @ +parseRedirect :: MonadError Error m => URI -> HTTP.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 ------------------------------------------------------------------------------ @@ -213,73 +445,44 @@ -- * for 'Status', the 'Request' for underlying 'Request' is created, -- status checking is modifying accordingly. -- --- @ --- parseResponse :: 'Maybe' 'Auth' -> 'Request' k a -> 'Maybe' 'Request' --- @ makeHttpRequest - :: MonadThrow m - => Maybe Auth - -> Request k a + :: 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 - SimpleQuery req -> - makeHttpSimpleRequest auth req - StatusQuery sm req -> do - req' <- makeHttpSimpleRequest auth req - return $ setCheckStatus (Just sm) req' - HeaderQuery h req -> do - req' <- makeHttpSimpleRequest auth req - return $ req' { requestHeaders = h <> requestHeaders req' } - RedirectQuery req -> do - req' <- makeHttpSimpleRequest auth req - return $ setRequestIgnoreStatus $ req' { redirectCount = 0 } - -makeHttpSimpleRequest - :: MonadThrow m - => Maybe Auth - -> SimpleRequest k a - -> m HTTP.Request -makeHttpSimpleRequest auth r = case r of Query paths qs -> do req <- parseUrl' $ url paths return $ setReqHeaders - . setCheckStatus Nothing - . setAuthRequest auth - . setQueryString qs + . unTagged (modifyRequest :: Tagged mt (HTTP.Request -> HTTP.Request)) + . maybe id setAuthRequest auth + . setQueryString (qs <> extraQueryItems) $ req PagedQuery paths qs _ -> do req <- parseUrl' $ url paths return $ setReqHeaders - . setCheckStatus Nothing - . setAuthRequest auth - . setQueryString qs + . unTagged (modifyRequest :: Tagged mt (HTTP.Request -> HTTP.Request)) + . maybe id setAuthRequest auth + . setQueryString (qs <> extraQueryItems) $ req Command m paths body -> do req <- parseUrl' $ url paths return $ setReqHeaders - . setCheckStatus Nothing - . setAuthRequest auth + . unTagged (modifyRequest :: Tagged mt (HTTP.Request -> HTTP.Request)) + . maybe id setAuthRequest auth . setBody body . setMethod (toMethod m) $ req where - parseUrl' :: MonadThrow m => Text -> m HTTP.Request -#if MIN_VERSION_http_client(0,4,30) - parseUrl' = HTTP.parseRequest . T.unpack -#else - parseUrl' = HTTP.parseUrl . T.unpack -#endif - - url :: Paths -> Text - url paths = baseUrl <> "/" <> T.intercalate "/" paths + parseUrl' :: MonadThrow m => String -> m HTTP.Request + parseUrl' = HTTP.parseUrlThrow - baseUrl :: Text - baseUrl = case auth of - Just (EnterpriseOAuth endpoint _) -> endpoint - _ -> "https://api.github.com" + 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 } @@ -288,138 +491,98 @@ setMethod m req = req { method = m } reqHeaders :: RequestHeaders - reqHeaders = maybe [] getOAuthHeader auth - <> [("User-Agent", "github.hs/0.7.4")] - <> [("Accept", "application/vnd.github.preview")] + 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 } - setAuthRequest :: Maybe Auth -> HTTP.Request -> HTTP.Request - setAuthRequest (Just (BasicAuth user pass)) = applyBasicAuth user pass - setAuthRequest _ = id - - getOAuthHeader :: Auth -> RequestHeaders - getOAuthHeader (OAuth token) = [("Authorization", "token " <> token)] - getOAuthHeader (EnterpriseOAuth _ token) = [("Authorization", "token " <> token)] - getOAuthHeader _ = [] + extraQueryItems :: [(BS.ByteString, Maybe BS.ByteString)] + extraQueryItems = case r of + PagedQuery _ _ (FetchPage pp) -> catMaybes [ + (\page -> ("page", Just (LBS.toStrict $ toLazyByteString $ intDec page))) <$> pageParamsPage pp + , (\perPage -> ("per_page", Just (LBS.toStrict $ toLazyByteString $ intDec perPage))) <$> pageParamsPerPage pp + ] + _ -> [] -- | Query @Link@ header with @rel=next@ from the request headers. -getNextUrl :: Response a -> Maybe URI +getNextUrl :: HTTP.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 :: Link -> Bool or Link uri -> Bool isRelNext = any (== relNextLinkParam) . linkParams relNextLinkParam :: (LinkParam, Text) relNextLinkParam = (Rel, "next") --- | Parse API response. --- --- @ --- parseResponse :: 'FromJSON' a => 'Response' 'LBS.ByteString' -> 'Either' 'Error' a --- @ -parseResponse :: (FromJSON a, MonadError Error m) => Response LBS.ByteString -> m a -parseResponse res = case eitherDecode (responseBody res) of - Right x -> return x - Left err -> throwError . ParseError . T.pack $ err - --- | 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) - --- | 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" - -- | Helper for making paginated requests. Responses, @a@ are combined monoidally. -- +-- The result is wrapped in the last received 'HTTP.Response'. +-- -- @ -- performPagedRequest :: ('FromJSON' a, 'Semigroup' a) --- => ('HTTP.Request' -> 'ExceptT' 'Error' 'IO' ('Response' 'LBS.ByteString')) +-- => ('HTTP.Request' -> 'ExceptT' 'Error' 'IO' ('HTTP.Response' 'LBS.ByteString')) -- -> (a -> 'Bool') -- -> 'HTTP.Request' --- -> 'ExceptT' 'Error' 'IO' a +-- -> 'ExceptT' 'Error' 'IO' ('HTTP.Response' a) -- @ performPagedRequest - :: forall a m. (FromJSON 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 - -> m a -performPagedRequest httpLbs' predicate initReq = do + :: forall a m mt. (ParseResponse mt a, Semigroup a, MonadCatch m, MonadError Error m) + => (HTTP.Request -> m (HTTP.Response LBS.ByteString)) -- ^ `httpLbs` analogue + -> (a -> Bool) -- ^ predicate to continue iteration + -> HTTP.Request -- ^ initial request + -> Tagged mt (m (HTTP.Response a)) +performPagedRequest httpLbs' predicate initReq = Tagged $ do res <- httpLbs' initReq - m <- parseResponse res + m <- unTagged (parseResponse initReq res :: Tagged mt (m a)) go m res initReq where - go :: a -> Response LBS.ByteString -> HTTP.Request -> m a + go :: a -> HTTP.Response LBS.ByteString -> HTTP.Request -> m (HTTP.Response a) go acc res req = case (predicate acc, getNextUrl res) of (True, Just uri) -> do req' <- HTTP.setUri req uri res' <- httpLbs' req' - m <- parseResponse res' + m <- unTagged (parseResponse req' res' :: Tagged mt (m a)) go (acc <> m) res' req' - (_, _) -> return acc - -------------------------------------------------------------------------------- --- Internal -------------------------------------------------------------------------------- + (_, _) -> return (acc <$ res) +-- | Helper for requesting a single page, as specified by 'PageParams'. +-- +-- This parses and returns the 'PageLinks' alongside the HTTP response. +performPerPageRequest + :: forall a m mt. (ParseResponse mt a, MonadCatch m, MonadError Error m) + => (HTTP.Request -> m (HTTP.Response LBS.ByteString)) -- ^ `httpLbs` analogue + -> HTTP.Request -- ^ initial request + -> Tagged mt (m (HTTP.Response a, PageLinks)) +performPerPageRequest httpLbs' initReq = Tagged $ do + res <- httpLbs' initReq + m <- unTagged (parseResponse initReq res :: Tagged mt (m a)) + return (m <$ res, parsePageLinks res) -setCheckStatus :: Maybe (StatusMap a) -> HTTP.Request -> HTTP.Request -#if MIN_VERSION_http_client(0,5,0) -setCheckStatus sm req = req { HTTP.checkResponse = successOrMissing sm } -#else -setCheckStatus sm req = req { HTTP.checkStatus = successOrMissing sm } -#endif +-- | Parse the 'PageLinks' from an HTTP response, where the information is +-- encoded in the Link header. +parsePageLinks :: HTTP.Response a -> PageLinks +parsePageLinks res = PageLinks { + pageLinksPrev = linkToUri <$> find (elem (Rel, "prev") . linkParams) links + , pageLinksNext = linkToUri <$> find (elem (Rel, "next") . linkParams) links + , pageLinksLast = linkToUri <$> find (elem (Rel, "last") . linkParams) links + , pageLinksFirst = linkToUri <$> find (elem (Rel, "first") . linkParams) links + } + where + links :: [Link URI] + links = fromMaybe [] (lookup "Link" (responseHeaders res) >>= parseLinkHeaderBS) + linkToUri :: Link URI -> URI + linkToUri (Link uri _) = uri -#if MIN_VERSION_http_client(0,5,0) -successOrMissing :: Maybe (StatusMap a) -> HTTP.Request -> HTTP.Response HTTP.BodyReader -> IO () -successOrMissing sm _req res - | check = pure () - | otherwise = do - chunk <- HTTP.brReadSome (HTTP.responseBody res) 1024 - let res' = fmap (const ()) res - HTTP.throwHttp $ HTTP.StatusCodeException res' (LBS.toStrict chunk) - where - Status sci _ = HTTP.responseStatus res -#else -successOrMissing :: Maybe (StatusMap a) -> Status -> ResponseHeaders -> HTTP.CookieJar -> Maybe E.SomeException -successOrMissing sm s@(Status sci _) hs cookiejar - | check = Nothing - | otherwise = Just $ E.toException $ StatusCodeException s hs cookiejar - where -#endif - check = case sm of - Nothing -> 200 <= sci && sci < 300 - Just sm' -> sci `elem` map fst sm' +------------------------------------------------------------------------------- +-- Internal +------------------------------------------------------------------------------- onHttpException :: MonadError Error m => HttpException -> m a onHttpException = throwError . HTTPError