diff --git a/.github/workflows/haskell-ci.yml b/.github/workflows/haskell-ci.yml new file mode 100644 index 00000000..2e003f87 --- /dev/null +++ b/.github/workflows/haskell-ci.yml @@ -0,0 +1,307 @@ +# This GitHub workflow config has been generated by a script via +# +# haskell-ci '--config=cabal.haskell-ci' 'github' 'cabal.project' +# +# To regenerate the script (for example after adjusting tested-with) run +# +# haskell-ci regenerate +# +# For more information, see https://github.com/haskell-CI/haskell-ci +# +# version: 0.19.20250821 +# +# REGENDATA ("0.19.20250821",["--config=cabal.haskell-ci","github","cabal.project"]) +# +name: Haskell-CI +on: + push: + branches: + - master + pull_request: + branches: + - master +jobs: + linux: + name: Haskell-CI - Linux - ${{ matrix.compiler }} + runs-on: ubuntu-24.04 + timeout-minutes: + 60 + container: + image: buildpack-deps:jammy + continue-on-error: ${{ matrix.allow-failure }} + strategy: + matrix: + include: + - compiler: ghc-9.14.0.20250819 + compilerKind: ghc + compilerVersion: 9.14.0.20250819 + setup-method: ghcup-prerelease + allow-failure: false + - compiler: ghc-9.12.2 + compilerKind: ghc + compilerVersion: 9.12.2 + setup-method: ghcup + allow-failure: false + - compiler: ghc-9.10.2 + compilerKind: ghc + compilerVersion: 9.10.2 + setup-method: ghcup + allow-failure: false + - compiler: ghc-9.8.4 + compilerKind: ghc + compilerVersion: 9.8.4 + setup-method: ghcup + allow-failure: false + - compiler: ghc-9.6.7 + compilerKind: ghc + compilerVersion: 9.6.7 + setup-method: ghcup + allow-failure: false + - compiler: ghc-9.4.8 + compilerKind: ghc + compilerVersion: 9.4.8 + setup-method: ghcup + allow-failure: false + - compiler: ghc-9.2.8 + compilerKind: ghc + compilerVersion: 9.2.8 + setup-method: ghcup + allow-failure: false + - compiler: ghc-9.0.2 + compilerKind: ghc + compilerVersion: 9.0.2 + setup-method: ghcup + allow-failure: false + - compiler: ghc-8.10.7 + compilerKind: ghc + compilerVersion: 8.10.7 + setup-method: ghcup + allow-failure: false + - compiler: ghc-8.8.4 + compilerKind: ghc + compilerVersion: 8.8.4 + setup-method: ghcup + allow-failure: false + - compiler: ghc-8.6.5 + compilerKind: ghc + compilerVersion: 8.6.5 + setup-method: ghcup + allow-failure: false + - compiler: ghc-8.4.4 + compilerKind: ghc + compilerVersion: 8.4.4 + setup-method: ghcup + allow-failure: false + - compiler: ghc-8.2.2 + compilerKind: ghc + compilerVersion: 8.2.2 + setup-method: ghcup + allow-failure: false + fail-fast: false + steps: + - name: apt-get install + run: | + apt-get update + apt-get install -y --no-install-recommends gnupg ca-certificates dirmngr curl git software-properties-common libtinfo5 libnuma-dev + - name: Install GHCup + run: | + mkdir -p "$HOME/.ghcup/bin" + curl -sL https://downloads.haskell.org/ghcup/0.1.50.1/x86_64-linux-ghcup-0.1.50.1 > "$HOME/.ghcup/bin/ghcup" + chmod a+x "$HOME/.ghcup/bin/ghcup" + - name: Install cabal-install + run: | + "$HOME/.ghcup/bin/ghcup" install cabal 3.16.0.0 || (cat "$HOME"/.ghcup/logs/*.* && false) + echo "CABAL=$HOME/.ghcup/bin/cabal-3.16.0.0 -vnormal+nowrap" >> "$GITHUB_ENV" + - name: Install GHC (GHCup) + if: matrix.setup-method == 'ghcup' + run: | + "$HOME/.ghcup/bin/ghcup" install ghc "$HCVER" || (cat "$HOME"/.ghcup/logs/*.* && false) + HC=$("$HOME/.ghcup/bin/ghcup" whereis ghc "$HCVER") + HCPKG=$(echo "$HC" | sed 's#ghc$#ghc-pkg#') + HADDOCK=$(echo "$HC" | sed 's#ghc$#haddock#') + echo "HC=$HC" >> "$GITHUB_ENV" + echo "HCPKG=$HCPKG" >> "$GITHUB_ENV" + echo "HADDOCK=$HADDOCK" >> "$GITHUB_ENV" + env: + HCKIND: ${{ matrix.compilerKind }} + HCNAME: ${{ matrix.compiler }} + HCVER: ${{ matrix.compilerVersion }} + - name: Install GHC (GHCup prerelease) + if: matrix.setup-method == 'ghcup-prerelease' + run: | + "$HOME/.ghcup/bin/ghcup" config add-release-channel prereleases + "$HOME/.ghcup/bin/ghcup" install ghc "$HCVER" || (cat "$HOME"/.ghcup/logs/*.* && false) + HC=$("$HOME/.ghcup/bin/ghcup" whereis ghc "$HCVER") + HCPKG=$(echo "$HC" | sed 's#ghc$#ghc-pkg#') + HADDOCK=$(echo "$HC" | sed 's#ghc$#haddock#') + echo "HC=$HC" >> "$GITHUB_ENV" + echo "HCPKG=$HCPKG" >> "$GITHUB_ENV" + echo "HADDOCK=$HADDOCK" >> "$GITHUB_ENV" + env: + HCKIND: ${{ matrix.compilerKind }} + HCNAME: ${{ matrix.compiler }} + HCVER: ${{ matrix.compilerVersion }} + - name: Set PATH and environment variables + run: | + echo "$HOME/.cabal/bin" >> $GITHUB_PATH + echo "LANG=C.UTF-8" >> "$GITHUB_ENV" + echo "CABAL_DIR=$HOME/.cabal" >> "$GITHUB_ENV" + echo "CABAL_CONFIG=$HOME/.cabal/config" >> "$GITHUB_ENV" + HCNUMVER=$(${HC} --numeric-version|perl -ne '/^(\d+)\.(\d+)\.(\d+)(\.(\d+))?$/; print(10000 * $1 + 100 * $2 + ($3 == 0 ? $5 != 1 : $3))') + echo "HCNUMVER=$HCNUMVER" >> "$GITHUB_ENV" + echo "ARG_TESTS=--enable-tests" >> "$GITHUB_ENV" + echo "ARG_BENCH=--enable-benchmarks" >> "$GITHUB_ENV" + if [ $((HCNUMVER >= 91400)) -ne 0 ] ; then echo "HEADHACKAGE=true" >> "$GITHUB_ENV" ; else echo "HEADHACKAGE=false" >> "$GITHUB_ENV" ; fi + echo "ARG_COMPILER=--$HCKIND --with-compiler=$HC" >> "$GITHUB_ENV" + env: + HCKIND: ${{ matrix.compilerKind }} + HCNAME: ${{ matrix.compiler }} + HCVER: ${{ matrix.compilerVersion }} + - name: env + run: | + env + - name: write cabal config + run: | + mkdir -p $CABAL_DIR + cat >> $CABAL_CONFIG <> $CABAL_CONFIG <> $CABAL_CONFIG < cabal-plan.xz + echo 'f62ccb2971567a5f638f2005ad3173dba14693a45154c1508645c52289714cb2 cabal-plan.xz' | sha256sum -c - + xz -d < cabal-plan.xz > $HOME/.cabal/bin/cabal-plan + rm -f cabal-plan.xz + chmod a+x $HOME/.cabal/bin/cabal-plan + cabal-plan --version + - name: checkout + uses: actions/checkout@v4 + with: + path: source + - name: initial cabal.project for sdist + run: | + touch cabal.project + echo "packages: $GITHUB_WORKSPACE/source/." >> cabal.project + if [ $((HCNUMVER >= 80400)) -ne 0 ] ; then echo "packages: $GITHUB_WORKSPACE/source/samples" >> cabal.project ; fi + cat cabal.project + - name: sdist + run: | + mkdir -p sdist + $CABAL sdist all --output-dir $GITHUB_WORKSPACE/sdist + - name: unpack + run: | + mkdir -p unpacked + find sdist -maxdepth 1 -type f -name '*.tar.gz' -exec tar -C $GITHUB_WORKSPACE/unpacked -xzvf {} \; + - name: generate cabal.project + run: | + PKGDIR_github="$(find "$GITHUB_WORKSPACE/unpacked" -maxdepth 1 -type d -regex '.*/github-[0-9.]*')" + echo "PKGDIR_github=${PKGDIR_github}" >> "$GITHUB_ENV" + PKGDIR_github_samples="$(find "$GITHUB_WORKSPACE/unpacked" -maxdepth 1 -type d -regex '.*/github-samples-[0-9.]*')" + echo "PKGDIR_github_samples=${PKGDIR_github_samples}" >> "$GITHUB_ENV" + rm -f cabal.project cabal.project.local + touch cabal.project + touch cabal.project.local + echo "packages: ${PKGDIR_github}" >> cabal.project + if [ $((HCNUMVER >= 80400)) -ne 0 ] ; then echo "packages: ${PKGDIR_github_samples}" >> cabal.project ; fi + echo "package github" >> cabal.project + echo " ghc-options: -Werror=missing-methods -Werror=missing-fields" >> cabal.project + if [ $((HCNUMVER >= 80400)) -ne 0 ] ; then echo "package github-samples" >> cabal.project ; fi + if [ $((HCNUMVER >= 80400)) -ne 0 ] ; then echo " ghc-options: -Werror=missing-methods -Werror=missing-fields" >> cabal.project ; fi + if [ $((HCNUMVER >= 90000)) -ne 0 ] ; then echo "package github" >> cabal.project ; fi + if [ $((HCNUMVER >= 90000)) -ne 0 ] ; then echo " ghc-options: -Werror=incomplete-patterns -Werror=incomplete-uni-patterns" >> cabal.project ; fi + if [ $((HCNUMVER >= 90000)) -ne 0 ] ; then echo "package github-samples" >> cabal.project ; fi + if [ $((HCNUMVER >= 90000)) -ne 0 ] ; then echo " ghc-options: -Werror=incomplete-patterns -Werror=incomplete-uni-patterns" >> cabal.project ; fi + cat >> cabal.project <> cabal.project + fi + $HCPKG list --simple-output --names-only | perl -ne 'for (split /\s+/) { print "constraints: any.$_ installed\n" unless /^(github|github-samples)$/; }' >> cabal.project.local + cat cabal.project + cat cabal.project.local + - name: dump install plan + run: | + $CABAL v2-build $ARG_COMPILER $ARG_TESTS $ARG_BENCH --dry-run all + cabal-plan + - name: restore cache + uses: actions/cache/restore@v4 + with: + key: ${{ runner.os }}-${{ matrix.compiler }}-${{ github.sha }} + path: ~/.cabal/store + restore-keys: ${{ runner.os }}-${{ matrix.compiler }}- + - name: install dependencies + run: | + $CABAL v2-build $ARG_COMPILER --disable-tests --disable-benchmarks --dependencies-only -j2 all + $CABAL v2-build $ARG_COMPILER $ARG_TESTS $ARG_BENCH --dependencies-only -j2 all + - name: build w/o tests + run: | + $CABAL v2-build $ARG_COMPILER --disable-tests --disable-benchmarks all + - name: build + run: | + $CABAL v2-build $ARG_COMPILER $ARG_TESTS $ARG_BENCH all --write-ghc-environment-files=always + - name: tests + run: | + $CABAL v2-test $ARG_COMPILER $ARG_TESTS $ARG_BENCH all --test-show-details=direct + - name: cabal check + run: | + cd ${PKGDIR_github} || false + ${CABAL} -vnormal check + if [ $((HCNUMVER >= 80400)) -ne 0 ] ; then cd ${PKGDIR_github_samples} || false ; fi + if [ $((HCNUMVER >= 80400)) -ne 0 ] ; then ${CABAL} -vnormal check ; fi + - name: haddock + run: | + if [ $((HCNUMVER >= 80600)) -ne 0 ] ; then $CABAL v2-haddock --disable-documentation --haddock-all $ARG_COMPILER --with-haddock $HADDOCK $ARG_TESTS $ARG_BENCH all ; fi + - name: unconstrained build + run: | + rm -f cabal.project.local + $CABAL v2-build $ARG_COMPILER --disable-tests --disable-benchmarks all + - name: save cache + if: always() + uses: actions/cache/save@v4 + with: + key: ${{ runner.os }}-${{ matrix.compiler }}-${{ github.sha }} + path: ~/.cabal/store diff --git a/.gitignore b/.gitignore index 821dfe03..3a8f6f25 100644 --- a/.gitignore +++ b/.gitignore @@ -1,2 +1,22 @@ +.env dist +dist-newstyle +/dist* +/tmp +.ghc.environment.* *swp +.cabal-sandbox +cabal.sandbox.config +*flymake* +*.#* +*~ +*.hi +*.o +*.lock +.stack-work +run.sh +src/hightlight.js +src/style.css +TAGS +.DS_Store + diff --git a/.stylish-haskell.yaml b/.stylish-haskell.yaml new file mode 100644 index 00000000..480cae6b --- /dev/null +++ b/.stylish-haskell.yaml @@ -0,0 +1,17 @@ +steps: + - imports: + align: group + list_align: after_alias + long_list_align: new_line + empty_list_align: right_after + list_padding: module_name + - language_pragmas: + style: vertical + remove_redundant: true + - trailing_whitespace: {} +columns: 80 +language_extensions: + - MultiParamTypeClasses + - FlexibleContexts + - ExplicitForAll + - DataKinds diff --git a/CHANGELOG.md b/CHANGELOG.md new file mode 100644 index 00000000..014e7e29 --- /dev/null +++ b/CHANGELOG.md @@ -0,0 +1,412 @@ +## 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/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/haskell-github/github/pull/306) +- Add "Get archive link" API + [#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/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/haskell-github/github/pull/308) +- Add list organisation invitations endpoint + +## Changes for 0.18 + +_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/haskell-github/github/pull/296) +- Add `archived` field to `Repo`. + [#298](https://github.com/haskell-github/github/pull/298) +- Update dependencies. + [#295](https://github.com/haskell-github/github/pull/295) +- Add Statuses endpoints. + [#268](https://github.com/haskell-github/github/pull/268) +- Add requested reviewers field to pull request records. + [#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 +- Pull Request review endpoints + +## 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` + +## Changes for 0.15.0 + +_2016-11-04, Oleg Grenrus_ + +- Reworked `PullRequest` (notably `pullRequestsFor`) +- Reworked PR and Issue filtering +- GHC-8.0.1 support +- Change `repoMasterBranch` to `repoDefaultBranch` in `Repo` +- Add `listTeamReposR` +- Add `myStarredAcceptStarR` +- Add `HeaderQuery` to `Request` +- Add `Hashable Auth` instance +- Add `mkUserId`, `mkUserName`, `fromUserId`, `fromOrganizationId` +- Add `userIssuesR` +- Add `organizationIssuesR` +- Make `teamName :: Text` amnd `teamSlug :: Name Team` in both: `Team` and `SimpleTeam` +- Refactor `Request` structure +- Added multiple issue assignees +- Preliminary support for repository events: `repositoryEventsR` +- Support for adding repository permissions to the team +- Remove `simpleUserType`, it was always the same. + +See [git commit summary](https://github.com/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`, + `RepoPublicity` +- Don't require network access for search tests + +## Changes for 0.14.0 + +_2016-01-25, Oleg Grenrus_ + +Large API changes: + +- Use `Text` and `Vector` in place of `String` and `[]`. +- Use `Name` and `Id` tagged types for names and identifiers. +- Make detailed structures un-prefixed, simple ones prefixed with `Simple`. Example: `Team` and `SimpleTeam`. +- Decouple request creation from execution (`*R` and `executeRequest*` functions). +- Add `Binary` instances for all data +- `GithubOwner` is a `newtype` of `Either User Organization`. There's still `SimpleOwner`. + +## 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: + +_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. +* The above by [John Wiegley](https://github.com/jwiegley). + +## Changes for 0.4.1: + +_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: + +_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`. +* Private gists, issues, organizations, pull requests, and users. +* Lock down `tls` and `tls-extra` instead of keeping up with the + ever-changing `http-conduit` package. +* Features by [Pavel Ryzhov](https://github.com/paulrzcz) and [Simon Hengel](https://github.com/sol). + +## Changes for 0.2.1: + +_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. +* An `HTTPConnectionError` now composes `SomeException` instead of `IOException`. All exceptions raised by the underlying http-conduit library are encapulated there. +* The `githubIssueClosedBy` function now produces a `Maybe GithubOwner`. +* Remove the Blobs API, as it is broken upstream. +* Bugs found and squashed thanks to [Joey Hess](https://github.com/joeyh) and [Simon Hengel](https://github.com/sol). diff --git a/CONTRIBUTING.md b/CONTRIBUTING.md index b42a9c2e..dc10c361 100644 --- a/CONTRIBUTING.md +++ b/CONTRIBUTING.md @@ -1,26 +1,41 @@ Contributing ------------- +============ -When adding a new public function -================================= +When adding a new endpoint +-------------------------- -* Write a sample in the appropriate place in the samples/ directory. -* Implement the function. -* Submit a pull request. +```haskell +-- | The title, as in the GitHub API docs. +-- +endpointR :: Request k EndpointResult +endpointR = query ["endpoint"] [] +``` -When modifying an existing data structure -========================================= +For example: -* Find all samples that use the data structure and make sure they run. -* Modify the data structure. -* Modify the samples as appropriate. -* Make sure all relevant samples still run. -* Submit a pull request. +```haskell +-- | Get your current rate limit status. +-- +rateLimitR :: Request k RateLimit +rateLimitR = query ["rate_limit"] [] +``` -Submitting a pull request -========================= +Also re-export endpoints from the top `GitHub` module. *Note:* only `R` variants, not `IO`. -* If your code is radically different from existing functionality, give -some explanation for how it fits in this library. -* Create a topic branch on your fork. -* Rebase and squash your commits. +Testing +------- + +When adding new functionality, cover it by a test case in: + + spec/ + +or a demonstration added to: + + samples/github-samples.cabal + +Miscellaneous +------------- + +* **Don't** edit `CHANGELOG.md`, it will only conflict. +* **Don't** edit package version. +* The codebase is not uniform in style, don't make it worse. diff --git a/Github/Data.hs b/Github/Data.hs deleted file mode 100644 index 70a0ea0f..00000000 --- a/Github/Data.hs +++ /dev/null @@ -1,552 +0,0 @@ -{-# LANGUAGE DeriveDataTypeable, OverloadedStrings #-} - --- | This module re-exports the @Github.Data.Definitions@ module, adding --- instances of @FromJSON@ to it. If you wish to use the data without the --- instances, use the @Github.Data.Definitions@ module instead. - -module Github.Data (module Github.Data.Definitions) where - -import Data.Time -import Control.Applicative -import Control.Monad -import qualified Data.Text as T -import Data.Aeson.Types -import System.Locale (defaultTimeLocale) -import qualified Data.Vector as V -import qualified Data.HashMap.Lazy as Map -import Data.Hashable (Hashable) - -import Github.Data.Definitions - -instance FromJSON GithubDate where - parseJSON (String t) = - case parseTime defaultTimeLocale "%FT%T%Z" (T.unpack t) of - Just d -> pure $ GithubDate d - _ -> fail "could not parse Github datetime" - parseJSON _ = fail "Given something besides a String" - -instance FromJSON Commit where - parseJSON (Object o) = - Commit <$> o .: "sha" - <*> o .: "parents" - <*> o .: "url" - <*> o .: "commit" - <*> o .:? "committer" - <*> o .:? "author" - <*> o .:< "files" - <*> o .:? "stats" - parseJSON _ = fail "Could not build a Commit" - -instance FromJSON Tree where - parseJSON (Object o) = - Tree <$> o .: "sha" - <*> o .: "url" - <*> o .:< "tree" - parseJSON _ = fail "Could not build a Tree" - -instance FromJSON GitTree where - parseJSON (Object o) = - GitTree <$> o .: "type" - <*> o .: "sha" - <*> o .: "url" - <*> o .:? "size" - <*> o .: "path" - <*> o .: "mode" - parseJSON _ = fail "Could not build a GitTree" - -instance FromJSON GitCommit where - parseJSON (Object o) = - GitCommit <$> o .: "message" - <*> o .: "url" - <*> o .: "committer" - <*> o .: "author" - <*> o .: "tree" - <*> o .:? "sha" - <*> o .:< "parents" - parseJSON _ = fail "Could not build a GitCommit" - -instance FromJSON GithubOwner where - parseJSON (Object o) - | o `at` "gravatar_id" == Nothing = - GithubOrganization <$> o .: "avatar_url" - <*> o .: "login" - <*> o .: "url" - <*> o .: "id" - | otherwise = - GithubUser <$> o .: "avatar_url" - <*> o .: "login" - <*> o .: "url" - <*> o .: "id" - <*> o .: "gravatar_id" - parseJSON v = fail $ "Could not build a GithubOwner out of " ++ (show v) - -instance FromJSON GitUser where - parseJSON (Object o) = - GitUser <$> o .: "name" - <*> o .: "email" - <*> o .: "date" - parseJSON _ = fail "Could not build a GitUser" - -instance FromJSON File where - parseJSON (Object o) = - File <$> o .: "blob_url" - <*> o .: "status" - <*> o .: "raw_url" - <*> o .: "additions" - <*> o .: "sha" - <*> o .: "changes" - <*> o .: "patch" - <*> o .: "filename" - <*> o .: "deletions" - parseJSON _ = fail "Could not build a File" - -instance FromJSON Stats where - parseJSON (Object o) = - Stats <$> o .: "additions" - <*> o .: "total" - <*> o .: "deletions" - parseJSON _ = fail "Could not build a Stats" - -instance FromJSON Comment where - parseJSON (Object o) = - Comment <$> o .:? "position" - <*> o .:? "line" - <*> o .: "body" - <*> o .: "commit_id" - <*> o .: "updated_at" - <*> o .:? "html_url" - <*> o .: "url" - <*> o .: "created_at" - <*> o .: "path" - <*> o .: "user" - <*> o .: "id" - parseJSON _ = fail "Could not build a Comment" - -instance ToJSON NewComment where - toJSON (NewComment b) = object [ "body" .= b ] - -instance ToJSON EditComment where - toJSON (EditComment b) = object [ "body" .= b ] - -instance FromJSON Diff where - parseJSON (Object o) = - Diff <$> o .: "status" - <*> o .: "behind_by" - <*> o .: "patch_url" - <*> o .: "url" - <*> o .: "base_commit" - <*> o .:< "commits" - <*> o .: "total_commits" - <*> o .: "html_url" - <*> o .:< "files" - <*> o .: "ahead_by" - <*> o .: "diff_url" - <*> o .: "permalink_url" - parseJSON _ = fail "Could not build a Diff" - -instance FromJSON Gist where - parseJSON (Object o) = - Gist <$> o .: "user" - <*> o .: "git_push_url" - <*> o .: "url" - <*> o .:? "description" - <*> o .: "created_at" - <*> o .: "public" - <*> o .: "comments" - <*> o .: "updated_at" - <*> o .: "html_url" - <*> o .: "id" - <*> o `values` "files" - <*> o .: "git_push_url" - parseJSON _ = fail "Could not build a Gist" - -instance FromJSON GistFile where - parseJSON (Object o) = - GistFile <$> o .: "type" - <*> o .: "raw_url" - <*> o .: "size" - <*> o .:? "language" - <*> o .: "filename" - <*> o .:? "content" - parseJSON _ = fail "Could not build a GistFile" - -instance FromJSON GistComment where - parseJSON (Object o) = - GistComment <$> o .: "user" - <*> o .: "url" - <*> o .: "created_at" - <*> o .: "body" - <*> o .: "updated_at" - <*> o .: "id" - parseJSON _ = fail "Could not build a GistComment" - -instance FromJSON Blob where - parseJSON (Object o) = - Blob <$> o .: "url" - <*> o .: "encoding" - <*> o .: "content" - <*> o .: "sha" - <*> o .: "size" - parseJSON _ = fail "Could not build a Blob" - -instance FromJSON GitReference where - parseJSON (Object o) = - GitReference <$> o .: "object" - <*> o .: "url" - <*> o .: "ref" - parseJSON _ = fail "Could not build a GitReference" - -instance FromJSON GitObject where - parseJSON (Object o) = - GitObject <$> o .: "type" - <*> o .: "sha" - <*> o .: "url" - parseJSON _ = fail "Could not build a GitObject" - -instance FromJSON Issue where - parseJSON (Object o) = - Issue <$> o .:? "closed_at" - <*> o .: "updated_at" - <*> o .: "html_url" - <*> o .:? "closed_by" - <*> o .: "labels" - <*> o .: "number" - <*> o .:? "assignee" - <*> o .: "user" - <*> o .: "title" - <*> o .: "pull_request" - <*> o .: "url" - <*> o .: "created_at" - <*> o .: "body" - <*> o .: "state" - <*> o .: "id" - <*> o .: "comments" - <*> o .:? "milestone" - parseJSON _ = fail "Could not build an Issue" - -instance ToJSON NewIssue where - toJSON (NewIssue t b a m ls) = - object - [ "title" .= t - , "body" .= b - , "assignee" .= a - , "milestone" .= m - , "labels" .= ls ] - -instance ToJSON EditIssue where - toJSON (EditIssue t b a s m ls) = - object $ filter notNull $ [ "title" .= t - , "body" .= b - , "assignee" .= a - , "state" .= s - , "milestone" .= m - , "labels" .= ls ] - where notNull (_, Null) = False - notNull (_, _) = True - -instance FromJSON Milestone where - parseJSON (Object o) = - Milestone <$> o .: "creator" - <*> o .: "due_on" - <*> o .: "open_issues" - <*> o .: "number" - <*> o .: "closed_issues" - <*> o .: "description" - <*> o .: "title" - <*> o .: "url" - <*> o .: "created_at" - <*> o .: "state" - parseJSON _ = fail "Could not build a Milestone" - -instance FromJSON IssueLabel where - parseJSON (Object o) = - IssueLabel <$> o .: "color" - <*> o .: "url" - <*> o .: "name" - parseJSON _ = fail "Could not build a Milestone" - -instance FromJSON PullRequestReference where - parseJSON (Object o) = - PullRequestReference <$> o .:? "html_url" - <*> o .:? "patch_url" - <*> o .:? "diff_url" - parseJSON _ = fail "Could not build a PullRequest" - -instance FromJSON IssueComment where - parseJSON (Object o) = - IssueComment <$> o .: "updated_at" - <*> o .: "user" - <*> o .: "url" - <*> o .: "created_at" - <*> o .: "body" - <*> o .: "id" - parseJSON _ = fail "Could not build an IssueComment" - -instance FromJSON Event where - parseJSON (Object o) = - Event <$> o .: "actor" - <*> o .: "event" - <*> o .:? "commit_id" - <*> o .: "url" - <*> o .: "created_at" - <*> o .: "id" - <*> o .:? "issue" - parseJSON _ = fail "Could not build an Event" - -instance FromJSON EventType where - parseJSON (String "closed") = pure Closed - parseJSON (String "reopened") = pure Reopened - parseJSON (String "subscribed") = pure Subscribed - parseJSON (String "merged") = pure Merged - parseJSON (String "referenced") = pure Referenced - parseJSON (String "mentioned") = pure Mentioned - parseJSON (String "assigned") = pure Assigned - parseJSON (String "unsubscribed") = pure Unsubscribed - parseJSON _ = fail "Could not build an EventType" - -instance FromJSON SimpleOrganization where - parseJSON (Object o) = - SimpleOrganization <$> o .: "url" - <*> o .: "avatar_url" - <*> o .: "id" - <*> o .: "login" - parseJSON _ = fail "Could not build a SimpleOrganization" - -instance FromJSON Organization where - parseJSON (Object o) = - Organization <$> o .: "type" - <*> o .:? "blog" - <*> o .:? "location" - <*> o .: "login" - <*> o .: "followers" - <*> o .:? "company" - <*> o .: "avatar_url" - <*> o .: "public_gists" - <*> o .: "html_url" - <*> o .:? "email" - <*> o .: "following" - <*> o .: "public_repos" - <*> o .: "url" - <*> o .: "created_at" - <*> o .:? "name" - <*> o .: "id" - parseJSON _ = fail "Could not build an Organization" - -instance FromJSON PullRequest where - parseJSON (Object o) = - PullRequest - <$> o .:? "closed_at" - <*> o .: "created_at" - <*> o .: "user" - <*> o .: "patch_url" - <*> o .: "state" - <*> o .: "number" - <*> o .: "html_url" - <*> o .: "updated_at" - <*> o .: "body" - <*> o .: "issue_url" - <*> o .: "diff_url" - <*> o .: "url" - <*> o .: "_links" - <*> o .:? "merged_at" - <*> o .: "title" - <*> o .: "id" - parseJSON _ = fail "Could not build a PullRequest" - -instance FromJSON DetailedPullRequest where - parseJSON (Object o) = - DetailedPullRequest - <$> o .:? "closed_at" - <*> o .: "created_at" - <*> o .: "user" - <*> o .: "patch_url" - <*> o .: "state" - <*> o .: "number" - <*> o .: "html_url" - <*> o .: "updated_at" - <*> o .: "body" - <*> o .: "issue_url" - <*> o .: "diff_url" - <*> o .: "url" - <*> o .: "_links" - <*> o .:? "merged_at" - <*> o .: "title" - <*> o .: "id" - <*> o .:? "merged_by" - <*> o .: "changed_files" - <*> o .: "head" - <*> o .: "comments" - <*> o .: "deletions" - <*> o .: "additions" - <*> o .: "review_comments" - <*> o .: "base" - <*> o .: "commits" - <*> o .: "merged" - <*> o .: "mergeable" - parseJSON _ = fail "Could not build a DetailedPullRequest" - -instance FromJSON PullRequestLinks where - parseJSON (Object o) = - PullRequestLinks <$> o <.:> ["review_comments", "href"] - <*> o <.:> ["comments", "href"] - <*> o <.:> ["html", "href"] - <*> o <.:> ["self", "href"] - parseJSON _ = fail "Could not build a PullRequestLinks" - -instance FromJSON PullRequestCommit where - parseJSON (Object _) = - return PullRequestCommit - parseJSON _ = fail "Could not build a PullRequestCommit" - -instance FromJSON SearchReposResult where - parseJSON (Object o) = - SearchReposResult <$> o .: "total_count" - <*> o .:< "items" - parseJSON _ = fail "Could not build a SearchReposResult" - -instance FromJSON Repo where - parseJSON (Object o) = - Repo <$> o .: "ssh_url" - <*> o .: "description" - <*> o .: "created_at" - <*> o .: "html_url" - <*> o .: "svn_url" - <*> o .: "forks" - <*> o .:? "homepage" - <*> o .: "fork" - <*> o .: "git_url" - <*> o .: "private" - <*> o .: "clone_url" - <*> o .: "size" - <*> o .: "updated_at" - <*> o .: "watchers" - <*> o .: "owner" - <*> o .: "name" - <*> o .: "language" - <*> o .:? "master_branch" - <*> o .: "pushed_at" - <*> o .: "id" - <*> o .: "url" - <*> o .: "open_issues" - <*> o .:? "has_wiki" - <*> o .:? "has_issues" - <*> o .:? "has_downloads" - <*> o .:? "parent" - <*> o .:? "source" - parseJSON _ = fail "Could not build a Repo" - -instance FromJSON RepoRef where - parseJSON (Object o) = - RepoRef <$> o .: "owner" - <*> o .: "name" - parseJSON _ = fail "Could not build a RepoRef" - -instance FromJSON Contributor where - parseJSON (Object o) - | o `at` "type" == (Just "Anonymous") = - AnonymousContributor <$> o .: "contributions" - <*> o .: "name" - | otherwise = - KnownContributor <$> o .: "contributions" - <*> o .: "avatar_url" - <*> o .: "login" - <*> o .: "url" - <*> o .: "id" - <*> o .: "gravatar_id" - parseJSON _ = fail "Could not build a Contributor" - -instance FromJSON Languages where - parseJSON (Object o) = - Languages <$> - mapM (\name -> Language (T.unpack name) <$> o .: name) - (Map.keys o) - parseJSON _ = fail "Could not build Languages" - -instance FromJSON Tag where - parseJSON (Object o) = - Tag <$> o .: "name" - <*> o .: "zipball_url" - <*> o .: "tarball_url" - <*> o .: "commit" - parseJSON _ = fail "Could not build a Tag" - -instance FromJSON Branch where - parseJSON (Object o) = Branch <$> o .: "name" <*> o .: "commit" - parseJSON _ = fail "Could not build a Branch" - -instance FromJSON BranchCommit where - parseJSON (Object o) = BranchCommit <$> o .: "sha" <*> o .: "url" - parseJSON _ = fail "Could not build a BranchCommit" - -instance FromJSON DetailedOwner where - parseJSON (Object o) - | o `at` "gravatar_id" == Nothing = - DetailedOrganization <$> o .: "created_at" - <*> o .: "type" - <*> o .: "public_gists" - <*> o .: "avatar_url" - <*> o .: "followers" - <*> o .: "following" - <*> o .:? "blog" - <*> o .:? "bio" - <*> o .: "public_repos" - <*> o .:? "name" - <*> o .:? "location" - <*> o .:? "company" - <*> o .: "url" - <*> o .: "id" - <*> o .: "html_url" - <*> o .: "login" - | otherwise = - DetailedUser <$> o .: "created_at" - <*> o .: "type" - <*> o .: "public_gists" - <*> o .: "avatar_url" - <*> o .: "followers" - <*> o .: "following" - <*> o .: "hireable" - <*> o .: "gravatar_id" - <*> o .:? "blog" - <*> o .:? "bio" - <*> o .: "public_repos" - <*> o .:? "name" - <*> o .:? "location" - <*> o .:? "company" - <*> o .: "email" - <*> o .: "url" - <*> o .: "id" - <*> o .: "html_url" - <*> o .: "login" - parseJSON _ = fail "Could not build a DetailedOwner" - - --- | A slightly more generic version of Aeson's @(.:?)@, using `mzero' instead --- of `Nothing'. -(.:<) :: (FromJSON a) => Object -> T.Text -> Parser [a] -obj .:< key = case Map.lookup key obj of - Nothing -> pure mzero - Just v -> parseJSON v - --- | Produce all values for the given key. -values :: (Eq k, Hashable k, FromJSON v) => Map.HashMap k Value -> k -> Parser v -obj `values` key = - let (Object children) = findWithDefault (Object Map.empty) key obj in - parseJSON $ Array $ V.fromList $ Map.elems children - --- | Produce the value for the last key by traversing. -(<.:>) :: (FromJSON v) => Object => [T.Text] -> Parser v -obj <.:> [key] = obj .: key -obj <.:> (key:keys) = - let (Object nextObj) = findWithDefault (Object Map.empty) key obj in - nextObj <.:> keys - --- | Produce the value for the given key, maybe. -at :: Object -> T.Text -> Maybe Value -obj `at` key = Map.lookup key obj - --- Taken from Data.Map: -findWithDefault :: (Eq k, Hashable k) => v -> k -> Map.HashMap k v -> v -findWithDefault def k m = - case Map.lookup k m of - Nothing -> def - Just x -> x diff --git a/Github/Data/Definitions.hs b/Github/Data/Definitions.hs deleted file mode 100644 index ccf2add5..00000000 --- a/Github/Data/Definitions.hs +++ /dev/null @@ -1,477 +0,0 @@ -{-# LANGUAGE DeriveDataTypeable, StandaloneDeriving #-} - -module Github.Data.Definitions where - -import Data.Time -import Data.Data -import qualified Control.Exception as E - --- | Errors have been tagged according to their source, so you can more easily --- dispatch and handle them. -data Error = - HTTPConnectionError E.SomeException -- ^ A HTTP error occurred. The actual caught error is included. - | ParseError String -- ^ An error in the parser itself. - | JsonError String -- ^ The JSON is malformed or unexpected. - | UserError String -- ^ Incorrect input. - deriving Show - --- | A date in the Github format, which is a special case of ISO-8601. -newtype GithubDate = GithubDate { fromGithubDate :: UTCTime } - deriving (Show, Data, Typeable, Eq, Ord) - -data Commit = Commit { - commitSha :: String - ,commitParents :: [Tree] - ,commitUrl :: String - ,commitGitCommit :: GitCommit - ,commitCommitter :: Maybe GithubOwner - ,commitAuthor :: Maybe GithubOwner - ,commitFiles :: [File] - ,commitStats :: Maybe Stats -} deriving (Show, Data, Typeable, Eq, Ord) - -data Tree = Tree { - treeSha :: String - ,treeUrl :: String - ,treeGitTrees :: [GitTree] -} deriving (Show, Data, Typeable, Eq, Ord) - -data GitTree = GitTree { - gitTreeType :: String - ,gitTreeSha :: String - ,gitTreeUrl :: String - ,gitTreeSize :: Maybe Int - ,gitTreePath :: String - ,gitTreeMode :: String -} deriving (Show, Data, Typeable, Eq, Ord) - -data GitCommit = GitCommit { - gitCommitMessage :: String - ,gitCommitUrl :: String - ,gitCommitCommitter :: GitUser - ,gitCommitAuthor :: GitUser - ,gitCommitTree :: Tree - ,gitCommitSha :: Maybe String - ,gitCommitParents :: [Tree] -} deriving (Show, Data, Typeable, Eq, Ord) - -data GithubOwner = GithubUser { - githubOwnerAvatarUrl :: String - ,githubOwnerLogin :: String - ,githubOwnerUrl :: String - ,githubOwnerId :: Int - ,githubOwnerGravatarId :: Maybe String - } - | GithubOrganization { - githubOwnerAvatarUrl :: String - ,githubOwnerLogin :: String - ,githubOwnerUrl :: String - ,githubOwnerId :: Int -} deriving (Show, Data, Typeable, Eq, Ord) - -data GitUser = GitUser { - gitUserName :: String - ,gitUserEmail :: String - ,gitUserDate :: GithubDate -} deriving (Show, Data, Typeable, Eq, Ord) - -data File = File { - fileBlobUrl :: String - ,fileStatus :: String - ,fileRawUrl :: String - ,fileAdditions :: Int - ,fileSha :: String - ,fileChanges :: Int - ,filePatch :: String - ,fileFilename :: String - ,fileDeletions :: Int -} deriving (Show, Data, Typeable, Eq, Ord) - -data Stats = Stats { - statsAdditions :: Int - ,statsTotal :: Int - ,statsDeletions :: Int -} deriving (Show, Data, Typeable, Eq, Ord) - -data Comment = Comment { - commentPosition :: Maybe Int - ,commentLine :: Maybe Int - ,commentBody :: String - ,commentCommitId :: String - ,commentUpdatedAt :: UTCTime - ,commentHtmlUrl :: Maybe String - ,commentUrl :: String - ,commentCreatedAt :: UTCTime - ,commentPath :: Maybe String - ,commentUser :: GithubOwner - ,commentId :: Int -} deriving (Show, Data, Typeable, Eq, Ord) - -data NewComment = NewComment { - newCommentBody :: String -} deriving (Show, Data, Typeable, Eq, Ord) - -data EditComment = EditComment { - editCommentBody :: String -} deriving (Show, Data, Typeable, Eq, Ord) - -data Diff = Diff { - diffStatus :: String - ,diffBehindBy :: Int - ,diffPatchUrl :: String - ,diffUrl :: String - ,diffBaseCommit :: Commit - ,diffCommits :: [Commit] - ,diffTotalCommits :: Int - ,diffHtmlUrl :: String - ,diffFiles :: [File] - ,diffAheadBy :: Int - ,diffDiffUrl :: String - ,diffPermalinkUrl :: String -} deriving (Show, Data, Typeable, Eq, Ord) - -data Gist = Gist { - gistUser :: GithubOwner - ,gistGitPushUrl :: String - ,gistUrl :: String - ,gistDescription :: Maybe String - ,gistCreatedAt :: GithubDate - ,gistPublic :: Bool - ,gistComments :: Int - ,gistUpdatedAt :: GithubDate - ,gistHtmlUrl :: String - ,gistId :: String - ,gistFiles :: [GistFile] - ,gistGitPullUrl :: String -} deriving (Show, Data, Typeable, Eq, Ord) - -data GistFile = GistFile { - gistFileType :: String - ,gistFileRawUrl :: String - ,gistFileSize :: Int - ,gistFileLanguage :: Maybe String - ,gistFileFilename :: String - ,gistFileContent :: Maybe String -} deriving (Show, Data, Typeable, Eq, Ord) - -data GistComment = GistComment { - gistCommentUser :: GithubOwner - ,gistCommentUrl :: String - ,gistCommentCreatedAt :: GithubDate - ,gistCommentBody :: String - ,gistCommentUpdatedAt :: GithubDate - ,gistCommentId :: Int -} deriving (Show, Data, Typeable, Eq, Ord) - -data Blob = Blob { - blobUrl :: String - ,blobEncoding :: String - ,blobContent :: String - ,blobSha :: String - ,blobSize :: Int -} deriving (Show, Data, Typeable, Eq, Ord) - -data GitReference = GitReference { - gitReferenceObject :: GitObject - ,gitReferenceUrl :: String - ,gitReferenceRef :: String -} deriving (Show, Data, Typeable, Eq, Ord) - -data GitObject = GitObject { - gitObjectType :: String - ,gitObjectSha :: String - ,gitObjectUrl :: String -} deriving (Show, Data, Typeable, Eq, Ord) - -data Issue = Issue { - issueClosedAt :: Maybe GithubDate - ,issueUpdatedAt :: GithubDate - ,issueHtmlUrl :: Maybe String - ,issueClosedBy :: Maybe GithubOwner - ,issueLabels :: [IssueLabel] - ,issueNumber :: Int - ,issueAssignee :: Maybe GithubOwner - ,issueUser :: GithubOwner - ,issueTitle :: String - ,issuePullRequest :: PullRequestReference - ,issueUrl :: String - ,issueCreatedAt :: GithubDate - ,issueBody :: Maybe String - ,issueState :: String - ,issueId :: Int - ,issueComments :: Int - ,issueMilestone :: Maybe Milestone -} deriving (Show, Data, Typeable, Eq, Ord) - -data NewIssue = NewIssue { - newIssueTitle :: String -, newIssueBody :: Maybe String -, newIssueAssignee :: Maybe String -, newIssueMilestone :: Maybe Int -, newIssueLabels :: Maybe [String] -} deriving (Show, Data, Typeable, Eq, Ord) - -data EditIssue = EditIssue { - editIssueTitle :: Maybe String -, editIssueBody :: Maybe String -, editIssueAssignee :: Maybe String -, editIssueState :: Maybe String -, editIssueMilestone :: Maybe Int -, editIssueLabels :: Maybe [String] -} deriving (Show, Data, Typeable, Eq, Ord) - - -data Milestone = Milestone { - milestoneCreator :: GithubOwner - ,milestoneDueOn :: Maybe GithubDate - ,milestoneOpenIssues :: Int - ,milestoneNumber :: Int - ,milestoneClosedIssues :: Int - ,milestoneDescription :: String - ,milestoneTitle :: String - ,milestoneUrl :: String - ,milestoneCreatedAt :: GithubDate - ,milestoneState :: String -} deriving (Show, Data, Typeable, Eq, Ord) - -data IssueLabel = IssueLabel { - labelColor :: String - ,labelUrl :: String - ,labelName :: String -} deriving (Show, Data, Typeable, Eq, Ord) - -data PullRequestReference = PullRequestReference { - pullRequestReferenceHtmlUrl :: Maybe String - ,pullRequestReferencePatchUrl :: Maybe String - ,pullRequestReferenceDiffUrl :: Maybe String -} deriving (Show, Data, Typeable, Eq, Ord) - -data IssueComment = IssueComment { - issueCommentUpdatedAt :: GithubDate - ,issueCommentUser :: GithubOwner - ,issueCommentUrl :: String - ,issueCommentCreatedAt :: GithubDate - ,issueCommentBody :: String - ,issueCommentId :: Int -} deriving (Show, Data, Typeable, Eq, Ord) - --- | Data describing an @Event@. -data EventType = - Mentioned -- ^ The actor was @mentioned in an issue body. - | Subscribed -- ^ The actor subscribed to receive notifications for an issue. - | Unsubscribed -- ^ The issue was unsubscribed from by the actor. - | Referenced -- ^ The issue was referenced from a commit message. The commit_id attribute is the commit SHA1 of where that happened. - | Merged -- ^ The issue was merged by the actor. The commit_id attribute is the SHA1 of the HEAD commit that was merged. - | Assigned -- ^ The issue was assigned to the actor. - | Closed -- ^ The issue was closed by the actor. When the commit_id is present, it identifies the commit that closed the issue using “closes / fixes #NN” syntax. - | Reopened -- ^ The issue was reopened by the actor. - deriving (Show, Data, Typeable, Eq, Ord) - -data Event = Event { - eventActor :: GithubOwner - ,eventType :: EventType - ,eventCommitId :: Maybe String - ,eventUrl :: String - ,eventCreatedAt :: GithubDate - ,eventId :: Int - ,eventIssue :: Maybe Issue -} deriving (Show, Data, Typeable, Eq, Ord) - -data SimpleOrganization = SimpleOrganization { - simpleOrganizationUrl :: String - ,simpleOrganizationAvatarUrl :: String - ,simpleOrganizationId :: Int - ,simpleOrganizationLogin :: String -} deriving (Show, Data, Typeable, Eq, Ord) - -data Organization = Organization { - organizationType :: String - ,organizationBlog :: Maybe String - ,organizationLocation :: Maybe String - ,organizationLogin :: String - ,organizationFollowers :: Int - ,organizationCompany :: Maybe String - ,organizationAvatarUrl :: String - ,organizationPublicGists :: Int - ,organizationHtmlUrl :: String - ,organizationEmail :: Maybe String - ,organizationFollowing :: Int - ,organizationPublicRepos :: Int - ,organizationUrl :: String - ,organizationCreatedAt :: GithubDate - ,organizationName :: Maybe String - ,organizationId :: Int -} deriving (Show, Data, Typeable, Eq, Ord) - -data PullRequest = PullRequest { - pullRequestClosedAt :: Maybe GithubDate - ,pullRequestCreatedAt :: GithubDate - ,pullRequestUser :: GithubOwner - ,pullRequestPatchUrl :: String - ,pullRequestState :: String - ,pullRequestNumber :: Int - ,pullRequestHtmlUrl :: String - ,pullRequestUpdatedAt :: GithubDate - ,pullRequestBody :: String - ,pullRequestIssueUrl :: String - ,pullRequestDiffUrl :: String - ,pullRequestUrl :: String - ,pullRequestLinks :: PullRequestLinks - ,pullRequestMergedAt :: Maybe GithubDate - ,pullRequestTitle :: String - ,pullRequestId :: Int -} deriving (Show, Data, Typeable, Eq, Ord) - -data DetailedPullRequest = DetailedPullRequest { - -- this is a duplication of a PullRequest - detailedPullRequestClosedAt :: Maybe GithubDate - ,detailedPullRequestCreatedAt :: GithubDate - ,detailedPullRequestUser :: GithubOwner - ,detailedPullRequestPatchUrl :: String - ,detailedPullRequestState :: String - ,detailedPullRequestNumber :: Int - ,detailedPullRequestHtmlUrl :: String - ,detailedPullRequestUpdatedAt :: GithubDate - ,detailedPullRequestBody :: String - ,detailedPullRequestIssueUrl :: String - ,detailedPullRequestDiffUrl :: String - ,detailedPullRequestUrl :: String - ,detailedPullRequestLinks :: PullRequestLinks - ,detailedPullRequestMergedAt :: Maybe GithubDate - ,detailedPullRequestTitle :: String - ,detailedPullRequestId :: Int - - ,detailedPullRequestMergedBy :: Maybe GithubOwner - ,detailedPullRequestChangedFiles :: Int - ,detailedPullRequestHead :: PullRequestCommit - ,detailedPullRequestComments :: Int - ,detailedPullRequestDeletions :: Int - ,detailedPullRequestAdditions :: Int - ,detailedPullRequestReviewComments :: Int - ,detailedPullRequestBase :: PullRequestCommit - ,detailedPullRequestCommits :: Int - ,detailedPullRequestMerged :: Bool - ,detailedPullRequestMergeable :: Bool -} deriving (Show, Data, Typeable, Eq, Ord) - -data PullRequestLinks = PullRequestLinks { - pullRequestLinksReviewComments :: String - ,pullRequestLinksComments :: String - ,pullRequestLinksHtml :: String - ,pullRequestLinksSelf :: String -} deriving (Show, Data, Typeable, Eq, Ord) - -data PullRequestCommit = PullRequestCommit { -} deriving (Show, Data, Typeable, Eq, Ord) - -data SearchReposResult = SearchReposResult { - searchReposTotalCount :: Int - ,searchReposRepos :: [ Repo ] -} deriving (Show, Data, Typeable, Eq, Ord) - -data Repo = Repo { - repoSshUrl :: String - ,repoDescription :: Maybe String - ,repoCreatedAt :: GithubDate - ,repoHtmlUrl :: String - ,repoSvnUrl :: String - ,repoForks :: Int - ,repoHomepage :: Maybe String - ,repoFork :: Bool - ,repoGitUrl :: String - ,repoPrivate :: Bool - ,repoCloneUrl :: String - ,repoSize :: Int - ,repoUpdatedAt :: GithubDate - ,repoWatchers :: Int - ,repoOwner :: GithubOwner - ,repoName :: String - ,repoLanguage :: Maybe String - ,repoMasterBranch :: Maybe String - ,repoPushedAt :: Maybe GithubDate -- ^ this is Nothing for new repositories - ,repoId :: Int - ,repoUrl :: String - ,repoOpenIssues :: Int - ,repoHasWiki :: Maybe Bool - ,repoHasIssues :: Maybe Bool - ,repoHasDownloads :: Maybe Bool - ,repoParent :: Maybe RepoRef - ,repoSource :: Maybe RepoRef -} deriving (Show, Data, Typeable, Eq, Ord) - -data RepoRef = RepoRef GithubOwner String -- Repo owner and name - deriving (Show, Data, Typeable, Eq, Ord) - -data Contributor - -- | An existing Github user, with their number of contributions, avatar - -- URL, login, URL, ID, and Gravatar ID. - = KnownContributor Int String String String Int String - -- | An unknown Github user with their number of contributions and recorded name. - | AnonymousContributor Int String - deriving (Show, Data, Typeable, Eq, Ord) - --- | This is only used for the FromJSON instance. -data Languages = Languages { getLanguages :: [Language] } - deriving (Show, Data, Typeable, Eq, Ord) - --- | A programming language with the name and number of characters written in --- it. -data Language = Language String Int - deriving (Show, Data, Typeable, Eq, Ord) - -data Tag = Tag { - tagName :: String - ,tagZipballUrl :: String - ,tagTarballUrl :: String - ,tagCommit :: BranchCommit -} deriving (Show, Data, Typeable, Eq, Ord) - -data Branch = Branch { - branchName :: String - ,branchCommit :: BranchCommit -} deriving (Show, Data, Typeable, Eq, Ord) - -data BranchCommit = BranchCommit { - branchCommitSha :: String - ,branchCommitUrl :: String -} deriving (Show, Data, Typeable, Eq, Ord) - -data DetailedOwner = DetailedUser { - detailedOwnerCreatedAt :: GithubDate - ,detailedOwnerType :: String - ,detailedOwnerPublicGists :: Int - ,detailedOwnerAvatarUrl :: String - ,detailedOwnerFollowers :: Int - ,detailedOwnerFollowing :: Int - ,detailedOwnerHireable :: Bool - ,detailedOwnerGravatarId :: Maybe String - ,detailedOwnerBlog :: Maybe String - ,detailedOwnerBio :: Maybe String - ,detailedOwnerPublicRepos :: Int - ,detailedOwnerName :: Maybe String - ,detailedOwnerLocation :: Maybe String - ,detailedOwnerCompany :: Maybe String - ,detailedOwnerEmail :: String - ,detailedOwnerUrl :: String - ,detailedOwnerId :: Int - ,detailedOwnerHtmlUrl :: String - ,detailedOwnerLogin :: String - } - | DetailedOrganization { - detailedOwnerCreatedAt :: GithubDate - ,detailedOwnerType :: String - ,detailedOwnerPublicGists :: Int - ,detailedOwnerAvatarUrl :: String - ,detailedOwnerFollowers :: Int - ,detailedOwnerFollowing :: Int - ,detailedOwnerBlog :: Maybe String - ,detailedOwnerBio :: Maybe String - ,detailedOwnerPublicRepos :: Int - ,detailedOwnerName :: Maybe String - ,detailedOwnerLocation :: Maybe String - ,detailedOwnerCompany :: Maybe String - ,detailedOwnerUrl :: String - ,detailedOwnerId :: Int - ,detailedOwnerHtmlUrl :: String - ,detailedOwnerLogin :: String -} deriving (Show, Data, Typeable, Eq, Ord) diff --git a/Github/Gists.hs b/Github/Gists.hs deleted file mode 100644 index 6f2f2c94..00000000 --- a/Github/Gists.hs +++ /dev/null @@ -1,35 +0,0 @@ --- | The gists API as described at . -module Github.Gists ( - gists -,gists' -,gist -,gist' -,module Github.Data -) where - -import Github.Data -import Github.Private - --- | The list of all gists created by the user --- --- > gists' (Just ("github-username", "github-password")) "mike-burns" -gists' :: Maybe GithubAuth -> String -> IO (Either Error [Gist]) -gists' auth userName = githubGet' auth ["users", userName, "gists"] - --- | The list of all public gists created by the user. --- --- > gists "mike-burns" -gists :: String -> IO (Either Error [Gist]) -gists = gists' Nothing - --- | A specific gist, given its id, with authentication credentials --- --- > gist' (Just ("github-username", "github-password")) "225074" -gist' :: Maybe GithubAuth -> String -> IO (Either Error Gist) -gist' auth reqGistId = githubGet' auth ["gists", reqGistId] - --- | A specific gist, given its id. --- --- > gist "225074" -gist :: String -> IO (Either Error Gist) -gist = gist' Nothing diff --git a/Github/Gists/Comments.hs b/Github/Gists/Comments.hs deleted file mode 100644 index b670bbc3..00000000 --- a/Github/Gists/Comments.hs +++ /dev/null @@ -1,22 +0,0 @@ --- | The loving comments people have left on Gists, described on --- . -module Github.Gists.Comments ( - commentsOn -,comment -,module Github.Data -) where - -import Github.Data -import Github.Private - --- | All the comments on a Gist, given the Gist ID. --- --- > commentsOn "1174060" -commentsOn :: String -> IO (Either Error [GistComment]) -commentsOn reqGistId = githubGet ["gists", reqGistId, "comments"] - --- | A specific comment, by the comment ID. --- --- > comment "62449" -comment :: String -> IO (Either Error GistComment) -comment reqCommentId = githubGet ["gists", "comments", reqCommentId] diff --git a/Github/GitData/Blobs.hs b/Github/GitData/Blobs.hs deleted file mode 100644 index b7ba0cc0..00000000 --- a/Github/GitData/Blobs.hs +++ /dev/null @@ -1,16 +0,0 @@ --- | The API for dealing with git blobs from Github repos, as described in --- . -module Github.GitData.Blobs ( - blob -,module Github.Data -) where - -import Github.Data -import Github.Private - --- | Get a blob by SHA1. --- --- > blob "thoughtbot" "paperclip" "bc5c51d1ece1ee45f94b056a0f5a1674d7e8cba9" -blob :: String -> String -> String -> IO (Either Error Blob) -blob user reqRepoName sha = - githubGet ["repos", user, reqRepoName, "git", "blobs", sha] diff --git a/Github/GitData/Commits.hs b/Github/GitData/Commits.hs deleted file mode 100644 index 07cd7bbb..00000000 --- a/Github/GitData/Commits.hs +++ /dev/null @@ -1,16 +0,0 @@ --- | The API for underlying git commits of a Github repo, as described on --- . -module Github.GitData.Commits ( - commit -,module Github.Data -) where - -import Github.Data -import Github.Private - --- | A single commit, by SHA1. --- --- > commit "thoughtbot" "paperclip" "bc5c51d1ece1ee45f94b056a0f5a1674d7e8cba9" -commit :: String -> String -> String -> IO (Either Error GitCommit) -commit user reqRepoName sha = - githubGet ["repos", user, reqRepoName, "git", "commits", sha] diff --git a/Github/GitData/References.hs b/Github/GitData/References.hs deleted file mode 100644 index 0dff891d..00000000 --- a/Github/GitData/References.hs +++ /dev/null @@ -1,33 +0,0 @@ --- | 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.GitData.References ( - reference -,references -,namespacedReferences -,module Github.Data -) where - -import Github.Data -import Github.Private - --- | A single reference by the ref name. --- --- > reference "mike-burns" "github" "heads/master" -reference :: String -> String -> String -> IO (Either Error GitReference) -reference user reqRepoName ref = - githubGet ["repos", user, reqRepoName, "git", "refs", ref] - --- | The history of references for a repo. --- --- > references "mike-burns" "github" -references :: String -> String -> IO (Either Error [GitReference]) -references user reqRepoName = - githubGet ["repos", user, reqRepoName, "git", "refs"] - --- | Limited references by a namespace. --- --- > namespacedReferences "thoughtbot" "paperclip" "tags" -namespacedReferences :: String -> String -> String -> IO (Either Error [GitReference]) -namespacedReferences user reqRepoName namespace = - githubGet ["repos", user, reqRepoName, "git", "refs", namespace] diff --git a/Github/GitData/Trees.hs b/Github/GitData/Trees.hs deleted file mode 100644 index ce7d04c2..00000000 --- a/Github/GitData/Trees.hs +++ /dev/null @@ -1,25 +0,0 @@ --- | The underlying tree of SHA1s and files that make up a git repo. The API is --- described on . -module Github.GitData.Trees ( - tree -,nestedTree -,module Github.Data -) where - -import Github.Data -import Github.Private - --- | A tree for a SHA1. --- --- > tree "thoughtbot" "paperclip" "fe114451f7d066d367a1646ca7ac10e689b46844" -tree :: String -> String -> String -> IO (Either Error Tree) -tree user reqRepoName sha = - githubGet ["repos", user, reqRepoName, "git", "trees", sha] - --- | A recursively-nested tree for a SHA1. --- --- > nestedTree "thoughtbot" "paperclip" "fe114451f7d066d367a1646ca7ac10e689b46844" -nestedTree :: String -> String -> String -> IO (Either Error Tree) -nestedTree user reqRepoName sha = - githubGetWithQueryString ["repos", user, reqRepoName, "git", "trees", sha] - "recursive=1" diff --git a/Github/Issues.hs b/Github/Issues.hs deleted file mode 100644 index c603ec65..00000000 --- a/Github/Issues.hs +++ /dev/null @@ -1,130 +0,0 @@ -{-# LANGUAGE OverloadedStrings #-} --- | The issues API as described on . -module Github.Issues ( - issue -,issue' -,issuesForRepo -,issuesForRepo' -,IssueLimitation(..) - --- * Modifying Issues --- | --- Only authenticated users may create and edit issues. -,GithubAuth(..) - -,createIssue -,newIssue -,editIssue -,editOfIssue -,module Github.Data -) where - -import Github.Data -import Github.Private -import Data.List (intercalate) -import Data.Time.Format (formatTime) -import System.Locale (defaultTimeLocale) -import Data.Time.Clock (UTCTime(..)) - --- | A data structure for describing how to filter issues. This is used by --- @issuesForRepo@. -data IssueLimitation = - AnyMilestone -- ^ Issues appearing in any milestone. [default] - | NoMilestone -- ^ Issues without a milestone. - | MilestoneId Int -- ^ Only issues that are in the milestone with the given id. - | Open -- ^ Only open issues. [default] - | OnlyClosed -- ^ Only closed issues. - | Unassigned -- ^ Issues to which no one has been assigned ownership. - | AnyAssignment -- ^ All issues regardless of assignment. [default] - | AssignedTo String -- ^ Only issues assigned to the user with the given login. - | Mentions String -- ^ Issues which mention the given string, taken to be a user's login. - | Labels [String] -- ^ A list of labels to filter by. - | Ascending -- ^ Sort ascending. - | Descending -- ^ Sort descending. [default] - | Since UTCTime -- ^ Only issues created since the specified date and time. - | PerPage Int -- ^ Download this many issues per query - - --- | 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 GithubAuth -> String -> String -> Int -> IO (Either Error Issue) -issue' auth user reqRepoName reqIssueNumber = - githubGet' auth ["repos", user, reqRepoName, "issues", show reqIssueNumber] - --- | Details on a specific issue, given the repo owner and name, and the issue --- number. --- --- > issue "thoughtbot" "paperclip" "462" -issue :: String -> String -> Int -> IO (Either Error Issue) -issue = issue' Nothing - --- | All issues for a repo (given the repo owner and name), with optional --- restrictions as described in the @IssueLimitation@ data type. --- --- > issuesForRepo' (Just ("github-username", "github-password")) "thoughtbot" "paperclip" [NoMilestone, OnlyClosed, Mentions "jyurek", Ascending] -issuesForRepo' :: Maybe GithubAuth -> String -> String -> [IssueLimitation] -> IO (Either Error [Issue]) -issuesForRepo' auth user reqRepoName issueLimitations = - githubGetWithQueryString' - auth - ["repos", user, reqRepoName, "issues"] - (queryStringFromLimitations issueLimitations) - where - queryStringFromLimitations = intercalate "&" . map convert - - convert AnyMilestone = "milestone=*" - convert NoMilestone = "milestone=none" - convert (MilestoneId n) = "milestone=" ++ show n - convert Open = "state=open" - convert OnlyClosed = "state=closed" - convert Unassigned = "assignee=none" - convert AnyAssignment = "assignee=*" - convert (AssignedTo u) = "assignee=" ++ u - convert (Mentions u) = "mentioned=" ++ u - convert (Labels l) = "labels=" ++ intercalate "," l - convert Ascending = "direction=asc" - convert Descending = "direction=desc" - convert (PerPage n) = "per_page=" ++ show n - convert (Since t) = - "since=" ++ formatTime defaultTimeLocale "%FT%TZ" t - --- | All issues for a repo (given the repo owner and name), with optional --- restrictions as described in the @IssueLimitation@ data type. --- --- > issuesForRepo "thoughtbot" "paperclip" [NoMilestone, OnlyClosed, Mentions "jyurek", Ascending] -issuesForRepo :: String -> String -> [IssueLimitation] -> IO (Either Error [Issue]) -issuesForRepo = issuesForRepo' Nothing - - --- Creating new issues. - -newIssue :: String -> NewIssue -newIssue title = NewIssue title Nothing Nothing Nothing Nothing - - --- | --- Create a new issue. --- --- > createIssue (GithubUser (user, password)) user repo --- > (newIssue "some_repo") {...} -createIssue :: GithubAuth -> String -> String -> NewIssue - -> IO (Either Error Issue) -createIssue auth user repo = githubPost auth ["repos", user, repo, "issues"] - - --- Editing issues. - -editOfIssue :: EditIssue -editOfIssue = EditIssue Nothing Nothing Nothing Nothing Nothing Nothing - - --- | --- Edit an issue. --- --- > editIssue (GithubUser (user, password)) user repo issue --- > editOfIssue {...} -editIssue :: GithubAuth -> String -> String -> Int -> EditIssue - -> IO (Either Error Issue) -editIssue auth user repo iss = - githubPatch auth ["repos", user, repo, "issues", show iss] diff --git a/Github/Issues/Comments.hs b/Github/Issues/Comments.hs deleted file mode 100644 index 2d893a86..00000000 --- a/Github/Issues/Comments.hs +++ /dev/null @@ -1,65 +0,0 @@ --- | The Github issue comments API from --- . -module Github.Issues.Comments ( - comment -,comments -,comments' - --- * Modifying Comments --- | --- Only authenticated users may create and edit comments. -,GithubAuth(..) - -,createComment -,editComment -,module Github.Data -) where - -import Github.Data -import Github.Private - --- | A specific comment, by ID. --- --- > comment "thoughtbot" "paperclip" 1468184 -comment :: String -> String -> Int -> IO (Either Error IssueComment) -comment user reqRepoName reqCommentId = - githubGet ["repos", user, reqRepoName, "issues", "comments", show reqCommentId] - --- | All comments on an issue, by the issue's number. --- --- > comments "thoughtbot" "paperclip" 635 -comments :: String -> String -> Int -> IO (Either Error [IssueComment]) -comments user reqRepoName reqIssueNumber = - githubGet ["repos", user, reqRepoName, "issues", show reqIssueNumber, "comments"] - --- | All comments on an issue, by the issue's number, using authentication. --- --- > comments' (GithubUser (user, password)) "thoughtbot" "paperclip" 635 -comments' :: Maybe GithubAuth -> String -> String -> Int -> IO (Either Error [IssueComment]) -comments' auth user reqRepoName reqIssueNumber = - githubGet' auth ["repos", user, reqRepoName, "issues", show reqIssueNumber, "comments"] - - - --- | --- Create a new comment. --- --- > createComment (GithubUser (user, password)) user repo issue --- > "some words" -createComment :: GithubAuth -> String -> String -> Int -> String - -> IO (Either Error Comment) -createComment auth user repo iss body = - githubPost auth - ["repos", user, repo, "issues", show iss, "comments"] (NewComment body) - - --- | --- Edit a comment. --- --- > editComment (GithubUser (user, password)) user repo commentid --- > "new words" -editComment :: GithubAuth -> String -> String -> Int -> String - -> IO (Either Error Comment) -editComment auth user repo commid body = - githubPatch auth ["repos", user, repo, "issues", "comments", show commid] - (EditComment body) diff --git a/Github/Issues/Events.hs b/Github/Issues/Events.hs deleted file mode 100644 index 68f75bdd..00000000 --- a/Github/Issues/Events.hs +++ /dev/null @@ -1,32 +0,0 @@ --- | The Github issue events API, which is described on --- -module Github.Issues.Events ( - eventsForIssue -,eventsForRepo -,event -,module Github.Data -) where - -import Github.Data -import Github.Private - --- | All events that have happened on an issue. --- --- > eventsForIssue "thoughtbot" "paperclip" 49 -eventsForIssue :: String -> String -> Int -> IO (Either Error [Event]) -eventsForIssue user reqRepoName reqIssueNumber = - githubGet ["repos", user, reqRepoName, "issues", show reqIssueNumber, "events"] - --- | All the events for all issues in a repo. --- --- > eventsForRepo "thoughtbot" "paperclip" -eventsForRepo :: String -> String -> IO (Either Error [Event]) -eventsForRepo user reqRepoName = - githubGet ["repos", user, reqRepoName, "issues", "events"] - --- | Details on a specific event, by the event's ID. --- --- > event "thoughtbot" "paperclip" 5335772 -event :: String -> String -> Int -> IO (Either Error Event) -event user reqRepoName reqEventId = - githubGet ["repos", user, reqRepoName, "issues", "events", show reqEventId] diff --git a/Github/Issues/Labels.hs b/Github/Issues/Labels.hs deleted file mode 100644 index 44db680e..00000000 --- a/Github/Issues/Labels.hs +++ /dev/null @@ -1,39 +0,0 @@ --- | The API for dealing with labels on Github issues, as described on --- . -module Github.Issues.Labels ( - label -,labelsOnRepo -,labelsOnIssue -,labelsOnMilestone -,module Github.Data -) where - -import Github.Data -import Github.Private - --- | All the labels available to use on any issue in the repo. --- --- > labelsOnRepo "thoughtbot" "paperclip" -labelsOnRepo :: String -> String -> IO (Either Error [IssueLabel]) -labelsOnRepo user reqRepoName = githubGet ["repos", user, reqRepoName, "labels"] - --- | The labels on an issue in a repo. --- --- > labelsOnIssue "thoughtbot" "paperclip" 585 -labelsOnIssue :: String -> String -> Int -> IO (Either Error [IssueLabel]) -labelsOnIssue user reqRepoName reqIssueId = - githubGet ["repos", user, reqRepoName, "issues", show reqIssueId, "labels"] - --- | All the labels on a repo's milestone, given the milestone ID. --- --- > labelsOnMilestone "thoughtbot" "paperclip" 2 -labelsOnMilestone :: String -> String -> Int -> IO (Either Error [IssueLabel]) -labelsOnMilestone user reqRepoName milestoneId = - githubGet ["repos", user, reqRepoName, "milestones", show milestoneId, "labels"] - --- | A label, by name. --- --- > Github.label "thoughtbot" "paperclip" "bug" -label :: String -> String -> String -> IO (Either Error IssueLabel) -label user reqRepoName reqLabelName = - githubGet ["repos", user, reqRepoName, "labels", reqLabelName] diff --git a/Github/Issues/Milestones.hs b/Github/Issues/Milestones.hs deleted file mode 100644 index 737ef490..00000000 --- a/Github/Issues/Milestones.hs +++ /dev/null @@ -1,30 +0,0 @@ --- | The milestones API as described on --- . -module Github.Issues.Milestones ( - milestones -,milestones' -,milestone -,module Github.Data -) where - -import Github.Data -import Github.Private - --- | All milestones in the repo. --- --- > milestones "thoughtbot" "paperclip" -milestones :: String -> String -> IO (Either Error [Milestone]) -milestones = milestones' Nothing - --- | All milestones in the repo, using authentication. --- --- > milestones' (GithubUser (user, password)) "thoughtbot" "paperclip" -milestones' :: Maybe GithubAuth -> String -> String -> IO (Either Error [Milestone]) -milestones' auth user reqRepoName = githubGet' auth ["repos", user, reqRepoName, "milestones"] - --- | Details on a specific milestone, given it's milestone number. --- --- > milestone "thoughtbot" "paperclip" 2 -milestone :: String -> String -> Int -> IO (Either Error Milestone) -milestone user reqRepoName reqMilestoneNumber = - githubGet ["repos", user, reqRepoName, "milestones", show reqMilestoneNumber] diff --git a/Github/Organizations.hs b/Github/Organizations.hs deleted file mode 100644 index db42dec3..00000000 --- a/Github/Organizations.hs +++ /dev/null @@ -1,35 +0,0 @@ --- | The orgs API as described on . -module Github.Organizations ( - publicOrganizationsFor -,publicOrganizationsFor' -,publicOrganization -,publicOrganization' -,module Github.Data -) where - -import Github.Data -import Github.Private - --- | The public organizations for a user, given the user's login, with authorization --- --- > publicOrganizationsFor' (Just ("github-username", "github-password")) "mike-burns" -publicOrganizationsFor' :: Maybe GithubAuth -> String -> IO (Either Error [SimpleOrganization]) -publicOrganizationsFor' auth userName = githubGet' auth ["users", userName, "orgs"] - --- | The public organizations for a user, given the user's login. --- --- > publicOrganizationsFor "mike-burns" -publicOrganizationsFor :: String -> IO (Either Error [SimpleOrganization]) -publicOrganizationsFor = publicOrganizationsFor' Nothing - --- | Details on a public organization. Takes the organization's login. --- --- > publicOrganization' (Just ("github-username", "github-password")) "thoughtbot" -publicOrganization' :: Maybe GithubAuth -> String -> IO (Either Error Organization) -publicOrganization' auth reqOrganizationName = githubGet' auth ["orgs", reqOrganizationName] - --- | Details on a public organization. Takes the organization's login. --- --- > publicOrganization "thoughtbot" -publicOrganization :: String -> IO (Either Error Organization) -publicOrganization = publicOrganization' Nothing diff --git a/Github/Organizations/Members.hs b/Github/Organizations/Members.hs deleted file mode 100644 index 1506d433..00000000 --- a/Github/Organizations/Members.hs +++ /dev/null @@ -1,15 +0,0 @@ --- | The organization members API as described on --- . -module Github.Organizations.Members ( - membersOf -,module Github.Data -) where - -import Github.Data -import Github.Private - --- | All the users who are members of the specified organization. --- --- > membersOf "thoughtbot" -membersOf :: String -> IO (Either Error [GithubOwner]) -membersOf organization = githubGet ["orgs", organization, "members"] diff --git a/Github/Private.hs b/Github/Private.hs deleted file mode 100644 index 09cabf17..00000000 --- a/Github/Private.hs +++ /dev/null @@ -1,168 +0,0 @@ -{-# LANGUAGE OverloadedStrings, StandaloneDeriving, DeriveDataTypeable #-} -{-# LANGUAGE CPP #-} -module Github.Private where - -import Github.Data -import Data.Aeson -import Data.Attoparsec.ByteString.Lazy -import Data.Data -import Data.Monoid -import Control.Applicative -import Data.List -import Data.CaseInsensitive (mk) -import qualified Data.ByteString.Char8 as BS -import qualified Data.ByteString.Lazy.Char8 as LBS -import Network.HTTP.Types (Method, Status(..)) -import Network.HTTP.Conduit -import Data.Conduit (ResourceT) -import qualified Control.Exception as E -import Data.Maybe (fromMaybe) - --- | user/password for HTTP basic access authentication -data GithubAuth = GithubBasicAuth BS.ByteString BS.ByteString - | GithubOAuth String - deriving (Show, Data, Typeable, Eq, Ord) - -githubGet :: (FromJSON b, Show b) => [String] -> IO (Either Error b) -githubGet = githubGet' Nothing - -githubGet' :: (FromJSON b, Show b) => Maybe GithubAuth -> [String] -> IO (Either Error b) -githubGet' auth paths = - githubAPI (BS.pack "GET") - (buildUrl paths) - auth - (Nothing :: Maybe Value) - -githubGetWithQueryString :: (FromJSON b, Show b) => [String] -> String -> IO (Either Error b) -githubGetWithQueryString = githubGetWithQueryString' Nothing - -githubGetWithQueryString' :: (FromJSON b, Show b) => Maybe GithubAuth -> [String] -> String -> IO (Either Error b) -githubGetWithQueryString' auth paths qs = - githubAPI (BS.pack "GET") - (buildUrl paths ++ "?" ++ qs) - auth - (Nothing :: Maybe Value) - -githubPost :: (ToJSON a, Show a, FromJSON b, Show b) => GithubAuth -> [String] -> a -> IO (Either Error b) -githubPost auth paths body = - githubAPI (BS.pack "POST") - (buildUrl paths) - (Just auth) - (Just body) - -githubPatch :: (ToJSON a, Show a, FromJSON b, Show b) => GithubAuth -> [String] -> a -> IO (Either Error b) -githubPatch auth paths body = - githubAPI (BS.pack "PATCH") - (buildUrl paths) - (Just auth) - (Just body) - -buildUrl :: [String] -> String -buildUrl paths = "https://api.github.com/" ++ intercalate "/" paths - -githubAPI :: (ToJSON a, Show a, FromJSON b, Show b) => BS.ByteString -> String - -> Maybe GithubAuth -> Maybe a -> IO (Either Error b) -githubAPI apimethod url auth body = do - result <- doHttps apimethod url auth (encodeBody body) - case result of - Left e -> return (Left (HTTPConnectionError e)) - Right resp -> either Left (\x -> jsonResultToE (LBS.pack (show x)) - (fromJSON x)) - <$> handleBody resp - - where - encodeBody = Just . RequestBodyLBS . encode . toJSON - - handleBody resp = either (return . Left) (handleJson resp) - (parseJsonRaw (responseBody resp)) - - -- This is an "escaping" version of "for", which returns (Right esc) if - -- the value 'v' is Nothing; otherwise, it extracts the value from the - -- Maybe, applies f, and return an IO (Either Error b). - forE :: b -> Maybe a -> (a -> IO (Either Error b)) - -> IO (Either Error b) - forE = flip . maybe . return . Right - - handleJson resp gotjson@(Array ary) = - -- Determine whether the output was paginated, and if so, we must - -- recurse to obtain the subsequent pages, and append those result - -- bodies to the current one. The aggregate will then be parsed. - forE gotjson (lookup "Link" (responseHeaders resp)) $ \l -> - forE gotjson (getNextUrl (BS.unpack l)) $ \nu -> - either (return . Left . HTTPConnectionError) - (\nextResp -> do - nextJson <- handleBody nextResp - return $ (\(Array x) -> Array (ary <> x)) - <$> nextJson) - =<< doHttps apimethod nu auth Nothing - handleJson _ gotjson = return (Right gotjson) - - getNextUrl l = - if "rel=\"next\"" `isInfixOf` l - then let s = l - s' = Data.List.tail $ Data.List.dropWhile (/= '<') s - in Just (Data.List.takeWhile (/= '>') s') - else Nothing - -doHttps :: Method -> String -> Maybe GithubAuth - -> Maybe (RequestBody (ResourceT IO)) - -> IO (Either E.SomeException (Response LBS.ByteString)) -doHttps reqMethod url auth body = do - let reqBody = fromMaybe (RequestBodyBS $ BS.pack "") body - reqHeaders = maybe [] getOAuth auth - Just uri = parseUrl url - request = uri { method = reqMethod - , secure = True - , port = 443 - , requestBody = reqBody - , requestHeaders = reqHeaders <> - [("User-Agent", "github.hs/0.7.0")] - <> [("Accept", "application/vnd.github.preview")] - , checkStatus = successOrMissing - } - authRequest = getAuthRequest auth request - - (getResponse authRequest >>= return . Right) `E.catches` [ - -- Re-throw AsyncException, otherwise execution will not terminate on - -- SIGINT (ctrl-c). All AsyncExceptions are re-thrown (not just - -- UserInterrupt) because all of them indicate severe conditions and - -- should not occur during normal operation. - E.Handler (\e -> E.throw (e :: E.AsyncException)), - E.Handler (\e -> (return . Left) (e :: E.SomeException)) - ] - where - getAuthRequest (Just (GithubBasicAuth user pass)) = applyBasicAuth user pass - getAuthRequest _ = id - getOAuth (GithubOAuth token) = [(mk (BS.pack "Authorization"), - BS.pack ("token " ++ token))] - getOAuth _ = [] - getResponse request = withManager $ \manager -> httpLbs request manager -#if MIN_VERSION_http_conduit(1, 9, 0) - successOrMissing s@(Status sci _) hs cookiejar -#else - successOrMissing s@(Status sci _) hs -#endif - | (200 <= sci && sci < 300) || sci == 404 = Nothing -#if MIN_VERSION_http_conduit(1, 9, 0) - | otherwise = Just $ E.toException $ StatusCodeException s hs cookiejar -#else - | otherwise = Just $ E.toException $ StatusCodeException s hs -#endif - -parseJsonRaw :: LBS.ByteString -> Either Error Value -parseJsonRaw jsonString = - let parsed = parse json jsonString in - case parsed of - Data.Attoparsec.ByteString.Lazy.Done _ jsonResult -> Right jsonResult - (Fail _ _ e) -> Left $ ParseError e - -jsonResultToE :: Show b => LBS.ByteString -> Data.Aeson.Result b - -> Either Error b -jsonResultToE jsonString result = case result of - Success s -> Right s - Error e -> Left $ JsonError $ - e ++ " on the JSON: " ++ LBS.unpack jsonString - -parseJson :: (FromJSON b, Show b) => LBS.ByteString -> Either Error b -parseJson jsonString = either Left (jsonResultToE jsonString . fromJSON) - (parseJsonRaw jsonString) diff --git a/Github/PullRequests.hs b/Github/PullRequests.hs deleted file mode 100644 index b3cf400d..00000000 --- a/Github/PullRequests.hs +++ /dev/null @@ -1,77 +0,0 @@ --- | The pull requests API as documented at --- . -module Github.PullRequests ( - pullRequestsFor' -,pullRequest' -,pullRequestCommits' -,pullRequestFiles' -,pullRequestsFor -,pullRequest -,pullRequestCommits -,pullRequestFiles -,module Github.Data -) where - -import Github.Data -import Github.Private - --- | All pull requests for the repo, by owner and repo name. --- | With authentification --- --- > pullRequestsFor' (Just ("github-username", "github-password")) "rails" "rails" -pullRequestsFor' :: Maybe GithubAuth -> String -> String -> IO (Either Error [PullRequest]) -pullRequestsFor' auth userName reqRepoName = - githubGet' auth ["repos", userName, reqRepoName, "pulls"] - --- | All pull requests for the repo, by owner and repo name. --- --- > pullRequestsFor "rails" "rails" -pullRequestsFor :: String -> String -> IO (Either Error [PullRequest]) -pullRequestsFor = pullRequestsFor' Nothing - --- | 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 GithubAuth -> String -> String -> Int -> IO (Either Error DetailedPullRequest) -pullRequest' auth userName reqRepoName number = - githubGet' auth ["repos", userName, reqRepoName, "pulls", show number] - --- | 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 :: String -> String -> Int -> IO (Either Error DetailedPullRequest) -pullRequest = pullRequest' Nothing - --- | 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 GithubAuth -> String -> String -> Int -> IO (Either Error [Commit]) -pullRequestCommits' auth userName reqRepoName number = - githubGet' auth ["repos", userName, reqRepoName, "pulls", show number, "commits"] - --- | All the commits on a pull request, given the repo owner, repo name, and --- the number of the pull request. --- --- > pullRequestCommits "thoughtbot" "paperclip" 688 -pullRequestCommits :: String -> String -> Int -> IO (Either Error [Commit]) -pullRequestCommits = pullRequestCommits' Nothing - --- | 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 GithubAuth -> String -> String -> Int -> IO (Either Error [File]) -pullRequestFiles' auth userName reqRepoName number = - githubGet' auth ["repos", userName, reqRepoName, "pulls", show number, "files"] --- | 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 :: String -> String -> Int -> IO (Either Error [File]) -pullRequestFiles = pullRequestFiles' Nothing diff --git a/Github/PullRequests/ReviewComments.hs b/Github/PullRequests/ReviewComments.hs deleted file mode 100644 index 45946819..00000000 --- a/Github/PullRequests/ReviewComments.hs +++ /dev/null @@ -1,24 +0,0 @@ --- | The pull request review comments API as described at --- . -module Github.PullRequests.ReviewComments ( - pullRequestReviewComments -,pullRequestReviewComment -,module Github.Data -) where - -import Github.Data -import Github.Private - --- | All the comments on a pull request with the given ID. --- --- > pullRequestReviewComments "thoughtbot" "factory_girl" 256 -pullRequestReviewComments :: String -> String -> Int -> IO (Either Error [Comment]) -pullRequestReviewComments userName repoName number = - githubGet ["repos", userName, repoName, "pulls", show number, "comments"] - --- | One comment on a pull request, by the comment's ID. --- --- > pullRequestReviewComment "thoughtbot" "factory_girl" 301819 -pullRequestReviewComment :: String -> String -> Int -> IO (Either Error Comment) -pullRequestReviewComment userName repoName id = - githubGet ["repos", userName, repoName, "pulls", "comments", show id] diff --git a/Github/Repos.hs b/Github/Repos.hs deleted file mode 100644 index 614ec207..00000000 --- a/Github/Repos.hs +++ /dev/null @@ -1,285 +0,0 @@ -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE CPP #-} --- | The Github Repos API, as documented at --- -module Github.Repos ( - --- * Querying repositories - userRepos -,userRepos' -,userRepo -,userRepo' -,organizationRepos -,organizationRepos' -,organizationRepo -,organizationRepo' -,contributors -,contributorsWithAnonymous -,languagesFor -,tagsFor -,branchesFor -,module Github.Data -,RepoPublicity(..) - --- * Modifying repositories --- | --- Only authenticated users may modify repositories. -,GithubAuth(..) - --- ** Create -,createRepo -,createOrganizationRepo -,newRepo -,NewRepo(..) - --- ** Edit -,editRepo -,def -,Edit(..) - --- ** Delete -,deleteRepo -) where - -import Data.Default -import Data.Aeson.Types -import Github.Data -import Github.Private -import Network.HTTP.Conduit -import Control.Applicative -import qualified Control.Exception as E -import Network.HTTP.Types - --- | Filter the list of the user's repos using any of these constructors. -data RepoPublicity = - All -- ^ All repos accessible to the user. - | Owner -- ^ Only repos owned by the user. - | Public -- ^ Only public repos. - | Private -- ^ Only private repos. - | Member -- ^ Only repos to which the user is a member but not an owner. - deriving (Show, Eq) - --- | The repos for a user, by their login. Can be restricted to just repos they --- own, are a member of, or publicize. Private repos are currently not --- supported. --- --- > userRepos "mike-burns" All -userRepos :: String -> RepoPublicity -> IO (Either Error [Repo]) -userRepos = userRepos' Nothing - --- | The repos for a user, by their login. --- | With authentication, but note that private repos are currently not supported. --- --- > userRepos' (Just (GithubUser (user, password))) "mike-burns" All -userRepos' :: Maybe GithubAuth -> String -> RepoPublicity -> IO (Either Error [Repo]) -userRepos' auth userName All = - githubGetWithQueryString' auth ["users", userName, "repos"] "type=all" -userRepos' auth userName Owner = - githubGetWithQueryString' auth ["users", userName, "repos"] "type=owner" -userRepos' auth userName Member = - githubGetWithQueryString' auth ["users", userName, "repos"] "type=member" -userRepos' auth userName Public = - githubGetWithQueryString' auth ["users", userName, "repos"] "type=public" -userRepos' _auth _userName Private = - return $ Left $ UserError "Cannot access private repos using userRepos" - --- | The repos for an organization, by the organization name. --- --- > organizationRepos "thoughtbot" -organizationRepos :: String -> IO (Either Error [Repo]) -organizationRepos = organizationRepos' Nothing - --- | The repos for an organization, by the organization name. --- | With authentication --- --- > organizationRepos (Just (GithubUser (user, password))) "thoughtbot" -organizationRepos' :: Maybe GithubAuth -> String -> IO (Either Error [Repo]) -organizationRepos' auth orgName = githubGet' auth ["orgs", orgName, "repos"] - --- | A specific organization repo, by the organization name. --- --- > organizationRepo "thoughtbot" "github" -organizationRepo :: String -> String -> IO (Either Error Repo) -organizationRepo = organizationRepo' Nothing - --- | A specific organization repo, by the organization name. --- | With authentication --- --- > organizationRepo (Just (GithubUser (user, password))) "thoughtbot" "github" -organizationRepo' :: Maybe GithubAuth -> String -> String -> IO (Either Error Repo) -organizationRepo' auth orgName reqRepoName = githubGet' auth ["orgs", orgName, reqRepoName] - --- | Details on a specific repo, given the owner and repo name. --- --- > userRepo "mike-burns" "github" -userRepo :: String -> String -> IO (Either Error Repo) -userRepo = userRepo' Nothing - --- | Details on a specific repo, given the owner and repo name. --- | With authentication --- --- > userRepo' (Just (GithubUser (user, password))) "mike-burns" "github" -userRepo' :: Maybe GithubAuth -> String -> String -> IO (Either Error Repo) -userRepo' auth userName reqRepoName = githubGet' auth ["repos", userName, reqRepoName] - --- | The contributors to a repo, given the owner and repo name. --- --- > contributors "thoughtbot" "paperclip" -contributors :: String -> String -> IO (Either Error [Contributor]) -contributors userName reqRepoName = - githubGet ["repos", userName, reqRepoName, "contributors"] - --- | 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 :: String -> String -> IO (Either Error [Contributor]) -contributorsWithAnonymous userName reqRepoName = - githubGetWithQueryString - ["repos", userName, reqRepoName, "contributors"] - "anon=true" - --- | 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 :: String -> String -> IO (Either Error [Language]) -languagesFor userName reqRepoName = do - result <- githubGet ["repos", userName, reqRepoName, "languages"] - return $ either Left (Right . getLanguages) result - --- | The git tags on a repo, given the repo owner and name. --- --- > tagsFor "thoughtbot" "paperclip" -tagsFor :: String -> String -> IO (Either Error [Tag]) -tagsFor userName reqRepoName = - githubGet ["repos", userName, reqRepoName, "tags"] - --- | The git branches on a repo, given the repo owner and name. --- --- > branchesFor "thoughtbot" "paperclip" -branchesFor :: String -> String -> IO (Either Error [Branch]) -branchesFor userName reqRepoName = - githubGet ["repos", userName, reqRepoName, "branches"] - - -data NewRepo = NewRepo { - newRepoName :: String -, newRepoDescription :: (Maybe String) -, newRepoHomepage :: (Maybe String) -, newRepoPrivate :: (Maybe Bool) -, newRepoHasIssues :: (Maybe Bool) -, newRepoHasWiki :: (Maybe Bool) -, newRepoAutoInit :: (Maybe Bool) -} deriving Show - -instance ToJSON NewRepo where - toJSON (NewRepo { newRepoName = name - , newRepoDescription = description - , newRepoHomepage = homepage - , newRepoPrivate = private - , newRepoHasIssues = hasIssues - , newRepoHasWiki = hasWiki - , newRepoAutoInit = autoInit - }) = object - [ "name" .= name - , "description" .= description - , "homepage" .= homepage - , "private" .= private - , "has_issues" .= hasIssues - , "has_wiki" .= hasWiki - , "auto_init" .= autoInit - ] - -newRepo :: String -> NewRepo -newRepo name = NewRepo name Nothing Nothing Nothing Nothing Nothing Nothing - --- | --- Create a new repository. --- --- > createRepo (GithubUser (user, password)) (newRepo "some_repo") {newRepoHasIssues = Just False} -createRepo :: GithubAuth -> NewRepo -> IO (Either Error Repo) -createRepo auth = githubPost auth ["user", "repos"] - --- | --- Create a new repository for an organization. --- --- > createOrganizationRepo (GithubUser (user, password)) "thoughtbot" (newRepo "some_repo") {newRepoHasIssues = Just False} -createOrganizationRepo :: GithubAuth -> String -> NewRepo -> IO (Either Error Repo) -createOrganizationRepo auth org = githubPost auth ["orgs", org, "repos"] - -data Edit = Edit { - editName :: Maybe String -, editDescription :: Maybe String -, editHomepage :: Maybe String -, editPublic :: Maybe Bool -, editHasIssues :: Maybe Bool -, editHasWiki :: Maybe Bool -, editHasDownloads :: Maybe Bool -} deriving Show - -instance Default Edit where - def = Edit def def def def def def def - -instance ToJSON Edit where - toJSON (Edit { editName = name - , editDescription = description - , editHomepage = homepage - , editPublic = public - , editHasIssues = hasIssues - , editHasWiki = hasWiki - , editHasDownloads = hasDownloads - }) = object - [ "name" .= name - , "description" .= description - , "homepage" .= homepage - , "public" .= public - , "has_issues" .= hasIssues - , "has_wiki" .= hasWiki - , "has_downloads" .= hasDownloads - ] - --- | --- Edit an existing repository. --- --- > editRepo (GithubUser (user, password)) "some_user" "some_repo" def {editDescription = Just "some description"} -editRepo :: GithubAuth - -> String -- ^ owner - -> String -- ^ repository name - -> Edit - -> IO (Either Error Repo) -editRepo auth user repo body = githubPatch auth ["repos", user, repo] b - where - -- if no name is given, use curent name - b = body {editName = editName body <|> Just repo} - --- | --- Delete an existing repository. --- --- > deleteRepo (GithubUser (user, password)) "thoughtbot" "some_repo" -deleteRepo :: GithubAuth - -> String -- ^ owner - -> String -- ^ repository name - -> IO (Either Error ()) -deleteRepo auth owner repo = do - result <- doHttps "DELETE" url (Just auth) Nothing - case result of - Left e -> return (Left (HTTPConnectionError e)) - Right resp -> - let status = responseStatus resp - headers = responseHeaders resp - in if status == notFound404 - -- doHttps silently absorbs 404 errors, but for this operation - -- we want the user to know if they've tried to delete a - -- non-existent repository - then return (Left (HTTPConnectionError - (E.toException - (StatusCodeException status headers -#if MIN_VERSION_http_conduit(1, 9, 0) - (responseCookieJar resp) -#endif - )))) - else return (Right ()) - where - url = "https://api.github.com/repos/" ++ owner ++ "/" ++ repo diff --git a/Github/Repos/Collaborators.hs b/Github/Repos/Collaborators.hs deleted file mode 100644 index 6cca521b..00000000 --- a/Github/Repos/Collaborators.hs +++ /dev/null @@ -1,36 +0,0 @@ --- | The repo collaborators API as described on --- . -module Github.Repos.Collaborators ( - collaboratorsOn -,isCollaboratorOn -,module Github.Data -) where - -import Github.Data -import Github.Private - -import Data.ByteString.Char8 (pack) -import qualified Network.HTTP.Conduit as C (responseStatus) -import qualified Network.HTTP.Types as T (statusCode) - --- | All the users who have collaborated on a repo. --- --- > collaboratorsOn "thoughtbot" "paperclip" -collaboratorsOn :: String -> String -> IO (Either Error [GithubOwner]) -collaboratorsOn userName reqRepoName = - githubGet ["repos", userName, reqRepoName, "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 "mike-burns" "thoughtbot" "paperclip" --- > isCollaboratorOn "johnson" "thoughtbot" "paperclip" -isCollaboratorOn :: String -> String -> String -> IO (Either Error Bool) -isCollaboratorOn userName repoOwnerName reqRepoName = do - result <- doHttps (pack "GET") - (buildUrl ["repos", repoOwnerName, reqRepoName, "collaborators", userName]) - Nothing - Nothing - return $ either (Left . HTTPConnectionError) - (Right . (204 ==) . T.statusCode . C.responseStatus) - result diff --git a/Github/Repos/Commits.hs b/Github/Repos/Commits.hs deleted file mode 100644 index acab907a..00000000 --- a/Github/Repos/Commits.hs +++ /dev/null @@ -1,53 +0,0 @@ --- | The repo commits API as described on --- . -module Github.Repos.Commits ( - commitsFor -,commit -,commentsFor -,commitCommentsFor -,commitCommentFor -,diff -,module Github.Data -) where - -import Github.Data -import Github.Private - --- | The commit history for a repo. --- --- > commitsFor "mike-burns" "github" -commitsFor :: String -> String -> IO (Either Error [Commit]) -commitsFor user repo = githubGet ["repos", user, repo, "commits"] - --- | Details on a specific SHA1 for a repo. --- --- > commit "mike-burns" "github" "9d1a9a361266c3c890b1108ad2fdf52f824b1b81" -commit :: String -> String -> String -> IO (Either Error Commit) -commit user repo sha1 = githubGet ["repos", user, repo, "commits", sha1] - --- | All the comments on a Github repo. --- --- > commentsFor "thoughtbot" "paperclip" -commentsFor :: String -> String -> IO (Either Error [Comment]) -commentsFor user repo = githubGet ["repos", user, repo, "comments"] - --- | Just the comments on a specific SHA for a given Github repo. --- --- > commitCommentsFor "thoughtbot" "paperclip" "41f685f6e01396936bb8cd98e7cca517e2c7d96b" -commitCommentsFor :: String -> String -> String -> IO (Either Error [Comment]) -commitCommentsFor user repo sha1 = - githubGet ["repos", user, repo, "commits", sha1, "comments"] - --- | A comment, by its ID, relative to the Github repo. --- --- > commitCommentFor "thoughtbot" "paperclip" "669575" -commitCommentFor :: String -> String -> String -> IO (Either Error Comment) -commitCommentFor user repo reqCommentId = - githubGet ["repos", user, repo, "comments", reqCommentId] - --- | The diff between two treeishes on a repo. --- --- > diff "thoughtbot" "paperclip" "41f685f6e01396936bb8cd98e7cca517e2c7d96b" "HEAD" -diff :: String -> String -> String -> String -> IO (Either Error Diff) -diff user repo base headref = - githubGet ["repos", user, repo, "compare", base ++ "..." ++ headref] diff --git a/Github/Repos/Forks.hs b/Github/Repos/Forks.hs deleted file mode 100644 index d24f54b5..00000000 --- a/Github/Repos/Forks.hs +++ /dev/null @@ -1,24 +0,0 @@ --- | Hot forking action, as described at --- . -module Github.Repos.Forks ( - forksFor -,forksFor' -,module Github.Data -) where - -import Github.Data -import Github.Private - --- | All the repos that are forked off the given repo. --- --- > forksFor "thoughtbot" "paperclip" -forksFor :: String -> String -> IO (Either Error [Repo]) -forksFor = forksFor' Nothing - --- | All the repos that are forked off the given repo. --- | With authentication --- --- > forksFor' (Just (GithubUser (user, password))) "thoughtbot" "paperclip" -forksFor' :: Maybe GithubAuth -> String -> String -> IO (Either Error [Repo]) -forksFor' auth userName reqRepoName = - githubGet' auth ["repos", userName, reqRepoName, "forks"] diff --git a/Github/Repos/Starring.hs b/Github/Repos/Starring.hs deleted file mode 100644 index 79d6f95f..00000000 --- a/Github/Repos/Starring.hs +++ /dev/null @@ -1,28 +0,0 @@ --- | The repo starring API as described on --- . -module Github.Repos.Starring ( - stargazersFor -,reposStarredBy -,myStarred -,module Github.Data -) where - -import Github.Data -import Github.Private - --- | The list of users that have starred the specified Github repo. --- --- > userInfoFor' Nothing "mike-burns" -stargazersFor :: Maybe GithubAuth -> String -> String -> IO (Either Error [GithubOwner]) -stargazersFor auth userName reqRepoName = - githubGet' auth ["repos", userName, reqRepoName, "stargazers"] - --- | All the public repos starred by the specified user. --- --- > reposStarredBy Nothing "croaky" -reposStarredBy :: Maybe GithubAuth -> String -> IO (Either Error [Repo]) -reposStarredBy auth userName = githubGet' auth ["users", userName, "starred"] - --- | All the repos starred by the authenticated user. -myStarred :: GithubAuth -> IO (Either Error [Repo]) -myStarred auth = githubGet' (Just auth) ["user", "starred"] diff --git a/Github/Repos/Watching.hs b/Github/Repos/Watching.hs deleted file mode 100644 index 63238446..00000000 --- a/Github/Repos/Watching.hs +++ /dev/null @@ -1,39 +0,0 @@ --- | The repo watching API as described on --- . -module Github.Repos.Watching ( - watchersFor -,watchersFor' -,reposWatchedBy -,reposWatchedBy' -,module Github.Data -) where - -import Github.Data -import Github.Private - --- | The list of users that are watching the specified Github repo. --- --- > watchersFor "thoughtbot" "paperclip" -watchersFor :: String -> String -> IO (Either Error [GithubOwner]) -watchersFor = watchersFor' Nothing - --- | The list of users that are watching the specified Github repo. --- | With authentication --- --- > watchersFor' (Just (GithubUser (user, password))) "thoughtbot" "paperclip" -watchersFor' :: Maybe GithubAuth -> String -> String -> IO (Either Error [GithubOwner]) -watchersFor' auth userName reqRepoName = - githubGet' auth ["repos", userName, reqRepoName, "watchers"] - --- | All the public repos watched by the specified user. --- --- > reposWatchedBy "croaky" -reposWatchedBy :: String -> IO (Either Error [Repo]) -reposWatchedBy = reposWatchedBy' Nothing - --- | All the public repos watched by the specified user. --- | With authentication --- --- > reposWatchedBy' (Just (GithubUser (user, password))) "croaky" -reposWatchedBy' :: Maybe GithubAuth -> String -> IO (Either Error [Repo]) -reposWatchedBy' auth userName = githubGet' auth ["users", userName, "watched"] diff --git a/Github/Search.hs b/Github/Search.hs deleted file mode 100644 index 03664c30..00000000 --- a/Github/Search.hs +++ /dev/null @@ -1,26 +0,0 @@ --- | The Github Search API, as described at --- . -module Github.Search( - searchRepos' -,searchRepos -,module Github.Data -,GithubAuth(..) -) where - -import Github.Data -import Github.Private - --- | Perform a repository search. --- | With authentication. --- --- > searchRepos' (Just $ GithubBasicAuth "github-username" "github-password') "q=a in%3Aname language%3Ahaskell created%3A>2013-10-01&per_page=100" -searchRepos' :: Maybe GithubAuth -> String -> IO (Either Error SearchReposResult) -searchRepos' auth queryString = githubGetWithQueryString' auth ["search/repositories"] queryString - --- | Perform a repository search. --- | Without authentication. --- --- > searchRepos "q=a in%3Aname language%3Ahaskell created%3A>2013-10-01&per_page=100" -searchRepos :: String -> IO (Either Error SearchReposResult) -searchRepos = searchRepos' Nothing - diff --git a/Github/Users.hs b/Github/Users.hs deleted file mode 100644 index e25a950a..00000000 --- a/Github/Users.hs +++ /dev/null @@ -1,23 +0,0 @@ --- | The Github Users API, as described at --- . -module Github.Users ( - userInfoFor -,userInfoFor' -,module Github.Data -) where - -import Github.Data -import Github.Private - --- | The information for a single user, by login name. --- | With authentification --- --- > userInfoFor' (Just ("github-username", "github-password")) "mike-burns" -userInfoFor' :: Maybe GithubAuth -> String -> IO (Either Error DetailedOwner) -userInfoFor' auth userName = githubGet' auth ["users", userName] - --- | The information for a single user, by login name. --- --- > userInfoFor "mike-burns" -userInfoFor :: String -> IO (Either Error DetailedOwner) -userInfoFor = userInfoFor' Nothing diff --git a/Github/Users/Followers.hs b/Github/Users/Followers.hs deleted file mode 100644 index 3ef53aa7..00000000 --- a/Github/Users/Followers.hs +++ /dev/null @@ -1,22 +0,0 @@ --- | The user followers API as described on --- . -module Github.Users.Followers ( - usersFollowing -,usersFollowedBy -,module Github.Data -) where - -import Github.Data -import Github.Private - --- | All the users following the given user. --- --- > usersFollowing "mike-burns" -usersFollowing :: String -> IO (Either Error [GithubOwner]) -usersFollowing userName = githubGet ["users", userName, "followers"] - --- | All the users that the given user follows. --- --- > usersFollowedBy "mike-burns" -usersFollowedBy :: String -> IO (Either Error [GithubOwner]) -usersFollowedBy userName = githubGet ["users", userName, "following"] diff --git a/NEWS.md b/NEWS.md deleted file mode 100644 index 29ad1572..00000000 --- a/NEWS.md +++ /dev/null @@ -1,43 +0,0 @@ -Changes for 0.5.0: - -* OAuth. -* New function: `Github.Repos.organizationRepo`, to get the repo for a specific organization. -* Introduce a new `newRepoAutoInit` flag to `NewRepo`, for whether to initialize a repo while creating it. -* Relax the attoparsec version requirements. -* The above by [John Wiegley](https://github.com/jwiegley). - -Changes for 0.4.1: - -* Stop using the uri package. -* Use aeson version 0.6.1.0. -* Use attoparsec version 0.10.3.0. -* Use http-conduit over 1.8. -* Use unordered-containers between 0.2 and 0.3. - -Changes for 0.4.0: - -* Use http-conduit version 1.4.1.10. - -Changes for 0.3.0: - -* Re-instantiate the Blobs API. -* `repoDescription1 and `repoPushedAt` are a `Maybe GithubDate`. -* Add `deleteRepo`, `editRepo`, and `createRepo`. -* Private gists, issues, organizations, pull requests, and users. -* Lock down `tls` and `tls-extra` instead of keeping up with the - ever-changing `http-conduit` package. -* Features by [Pavel Ryzhov](https://github.com/paulrzcz) and [Simon Hengel](https://github.com/sol). - -Changes for 0.2.1: - -* Expand the unordered-containers dependency to anything in 0.1.x . - -Changes for 0.2.0: - -* `milestoneDueOn` and `repoLanguage` are now `Maybe` types. -* Introduce `GithubOwner` as the sum type for a `GithubUser` or `GithubOrganization`. Everything that once produced a `GithubUser` now produces a `GithubOwner`. All record accessors have changed their names -* Similar to `GithubOwner`, introduce `DetailedOwner`, which can be a `DetailedUser` or a `DetailedOrganization`. All record accessors have changed their names -* An `HTTPConnectionError` now composes `SomeException` instead of `IOException`. All exceptions raised by the underlying http-conduit library are encapulated there. -* The `githubIssueClosedBy` function now produces a `Maybe GithubOwner`. -* Remove the Blobs API, as it is broken upstream. -* Bugs found and squashed thanks to [Joey Hess](https://github.com/joeyh) and [Simon Hengel](https://github.com/sol). diff --git a/README.md b/README.md index e300246a..3ead9b24 100644 --- a/README.md +++ b/README.md @@ -1,10 +1,15 @@ -Github +GitHub ------ -The Github API v3 for Haskell. +[![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) -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 +The GitHub API v3 for Haskell. + +Some functions are missing; these are functions where the GitHub API did +not work as expected. The full GitHub API is in beta and constantly improving. Installation @@ -12,45 +17,89 @@ Installation In your project's cabal file: - -- Packages needed in order to build this package. - Build-depends: github +```cabal +Build-depends: github +``` Or from the command line: - cabal install github +```sh +cabal v1-install github +``` Example Usage ============= -See the samples in the [samples/](https://github.com/fpco/github/tree/master/samples) directory. +See the samples in the +[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. +For details see the reference [documentation on Hackage][hackage]. + +Each module lines up with the hierarchy of +[documentation from the GitHub API](https://docs.github.com/en/rest). + +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. + +IO functions produce an `IO (Either Error a)`, where `a` is the actual thing +you want. You must call the function using IO goodness, then dispatch on the +possible error message. Here's an example from the samples: + +Many function have samples under +[`samples/`](https://github.com/haskell-github/github/tree/master/samples) directory. -Each module lines up with the hierarchy of [documentation from the Github API](http://developer.github.com/v3/). +```hs +{-# LANGUAGE NoImplicitPrelude #-} +{-# LANGUAGE OverloadedStrings #-} -Each function has a sample written for it. +import Prelude.Compat -All functions produce an `IO (Either Error a)`, where `a` is the actual thing you want. You must call the function using IO goodness, then dispatch on the possible error message. Here's an example from the samples: +import Data.Text (Text, pack) +import Data.Text.IO as T (putStrLn) +import Data.Monoid ((<>)) - import Github.Users.Followers - import Data.List (intercalate) - main = do - possibleUsers <- usersFollowing "mike-burns" - putStrLn $ either (\error -> "Error: " ++ $ show error) - (intercalate "\n" . map githubUserLogin) +import GitHub (github') +import qualified GitHub + +main :: IO () +main = do + possibleUsers <- github' GitHub.usersFollowingR "phadej" + T.putStrLn $ either (("Error: " <>) . pack . show) + (foldMap ((<> "\n") . formatUser)) possibleUsers +formatUser :: GitHub.SimpleUser -> Text +formatUser = GitHub.untagName . GitHub.simpleUserLogin +``` + Contributions ============= -Please see [CONTRIBUTING.md](https://github.com/fpco/github/blob/master/CONTRIBUTING.md) for details on how you can help. +Please see +[CONTRIBUTING.md](https://github.com/haskell-github/github/blob/master/CONTRIBUTING.md) +for details on how you can help. Copyright ========= -Copyright 2011, 2012 Mike Burns. +Copyright 2011-2012 Mike Burns. +Copyright 2013-2015 John Wiegley. +Copyright 2016-2019 Oleg Grenrus. Available under the BSD 3-clause license. + +[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/cabal.haskell-ci b/cabal.haskell-ci new file mode 100644 index 00000000..e44b77d2 --- /dev/null +++ b/cabal.haskell-ci @@ -0,0 +1,27 @@ +branches: master +haddock: >=8.6 + -- See PR #355: haddocks for GADT constructor arguments only supported from GHC 8.6 +jobs-selection: any + +-- Package github-samples uses "include" for dependencies, +-- so they are a superset. +-- Dissecting this is a waste of time, so I turn -Werror=unused-packages off +error-unused-packages: False + +-- Some dependencies do not allow mtl-2.3 yet, so this doesn't pass yet: +-- constraint-set mtl-2.3 +-- ghc: >= 8.6 +-- constraints: mtl >= 2.3, transformers >= 0.6 + +-- constraint-set text-2.0 +-- constraints: text >= 2.0 +-- allow-newer: *:text -- allow-newer not supported + +-- constraint-set containers-0.7 +-- ghc: >= 9 +-- constraints: containers >= 0.7 +-- tests: True +-- run-tests: True + +-- raw-project +-- allow-newer: containers diff --git a/cabal.project b/cabal.project new file mode 100644 index 00000000..be4081d6 --- /dev/null +++ b/cabal.project @@ -0,0 +1,13 @@ +packages: . +packages: samples + +optimization: False +tests: True + +constraints: github +openssl +constraints: github-samples +openssl +constraints: HsOpenSSL +use-pkg-config +constraints: operational -buildExamples + +-- constraints: text >=2 +-- allow-newer: *:text diff --git a/fix-whitespace.yaml b/fix-whitespace.yaml new file mode 100644 index 00000000..80795e01 --- /dev/null +++ b/fix-whitespace.yaml @@ -0,0 +1,61 @@ +# This file contains the project-specific settings for `fix-whitespace` +# +# (get it with `cabal install fix-whitespace`) +# +# a tiny, but useful tool to: +# +# * Remove trailing whitespace. +# * Remove trailing lines containing nothing but whitespace. +# * Ensure that the file ends in a newline character. +# +# By default, fix-whitespace checks every directory under the current working +# directory but no files. This program should be placed under a text-based +# project. +# +# For directories, +# +# 1) excluded-dirs is a black-list of directories, +# 2) included-dirs is a white-list of excluded-dirs +# +# For files, +# +# 3) included-files is a white-list of files, +# 4) excluded-files is a black-list of included-files. +# +# The extended glob pattern can be used to specify file/direcotory names. +# For details, see http://hackage.haskell.org/package/filemanip-0.3.6.3/docs/System-FilePath-GlobPattern.html +# + +excluded-dirs: + - .git + - .stack-work + - "dist*" + - fixtures + +included-dirs: + +# Every matched filename is included unless it is matched by excluded-files. +included-files: + - .authorspellings + - .gitignore + - LICENSE + - cabal.haskell-ci + - cabal.project + - cabal.project.local + - "*.cabal" + - "*.css" + - "*.example" + - "*.hs" + - "*.hs-boot" + - "*.html" + - "*.js" + - "*.json" + - "*.lhs" + - "*.md" + - "*.rst" + - "*.sh" + - "*.txt" + - "*.yaml" + - "*.yml" + +excluded-files: diff --git a/fixtures/actions/artifact.json b/fixtures/actions/artifact.json new file mode 100644 index 00000000..cb06b454 --- /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 index 00000000..2d03d803 --- /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 index 00000000..64cf3956 --- /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 index 00000000..99be4def --- /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 index 00000000..621c84eb --- /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 index 00000000..241a8737 --- /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 index 00000000..bf8659be --- /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 index 00000000..71ce3d35 --- /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 index 00000000..e8e35d0f --- /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 index 00000000..771dcd87 --- /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 index 00000000..edaf5c59 --- /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/issue-search.json b/fixtures/issue-search.json new file mode 100644 index 00000000..9b3bdfd9 --- /dev/null +++ b/fixtures/issue-search.json @@ -0,0 +1,98 @@ +{ + "total_count": 2, + "incomplete_results": false, + "items": [ + { + "url": "https://api.github.com/repos/phadej/github/issues/130", + "labels_url": "https://api.github.com/repos/phadej/github/issues/130/labels{/name}", + "comments_url": "https://api.github.com/repos/phadej/github/issues/130/comments", + "events_url": "https://api.github.com/repos/phadej/github/issues/130/events", + "html_url": "https://github.com/phadej/github/pull/130", + "id": 123898390, + "number": 130, + "title": "Make test runner more robust", + "user": { + "login": "phadej", + "id": 51087, + "avatar_url": "https://avatars.githubusercontent.com/u/51087?v=3", + "gravatar_id": "", + "url": "https://api.github.com/users/phadej", + "html_url": "https://github.com/phadej", + "followers_url": "https://api.github.com/users/phadej/followers", + "following_url": "https://api.github.com/users/phadej/following{/other_user}", + "gists_url": "https://api.github.com/users/phadej/gists{/gist_id}", + "starred_url": "https://api.github.com/users/phadej/starred{/owner}{/repo}", + "subscriptions_url": "https://api.github.com/users/phadej/subscriptions", + "organizations_url": "https://api.github.com/users/phadej/orgs", + "repos_url": "https://api.github.com/users/phadej/repos", + "events_url": "https://api.github.com/users/phadej/events{/privacy}", + "received_events_url": "https://api.github.com/users/phadej/received_events", + "type": "User", + "site_admin": false + }, + "labels": [ + + ], + "state": "closed", + "locked": false, + "assignee": null, + "assignees": [], + "milestone": null, + "comments": 0, + "created_at": "2015-12-25T21:37:39Z", + "updated_at": "2015-12-26T08:57:52Z", + "closed_at": "2015-12-25T23:32:12Z", + "pull_request": { + "url": "https://api.github.com/repos/phadej/github/pulls/130", + "html_url": "https://github.com/phadej/github/pull/130", + "diff_url": "https://github.com/phadej/github/pull/130.diff", + "patch_url": "https://github.com/phadej/github/pull/130.patch" + }, + "body": "As they use access token, it's highly unlikely it will be rate limited. ATM there's only one request per test job. i.e. travis could be re-enabled.\r\n\r\nExample run https://travis-ci.org/phadej/github/builds/98815089\r\nSome tests are pending as secret is made for this `jwiegley/github` repository.", + "score": 0.75566536 + }, + { + "url": "https://api.github.com/repos/phadej/github/issues/127", + "labels_url": "https://api.github.com/repos/phadej/github/issues/127/labels{/name}", + "comments_url": "https://api.github.com/repos/phadej/github/issues/127/comments", + "events_url": "https://api.github.com/repos/phadej/github/issues/127/events", + "html_url": "https://github.com/phadej/github/issues/127", + "id": 119694665, + "number": 127, + "title": "Decouple request creation from execution", + "user": { + "login": "phadej", + "id": 51087, + "avatar_url": "https://avatars.githubusercontent.com/u/51087?v=3", + "gravatar_id": "", + "url": "https://api.github.com/users/phadej", + "html_url": "https://github.com/phadej", + "followers_url": "https://api.github.com/users/phadej/followers", + "following_url": "https://api.github.com/users/phadej/following{/other_user}", + "gists_url": "https://api.github.com/users/phadej/gists{/gist_id}", + "starred_url": "https://api.github.com/users/phadej/starred{/owner}{/repo}", + "subscriptions_url": "https://api.github.com/users/phadej/subscriptions", + "organizations_url": "https://api.github.com/users/phadej/orgs", + "repos_url": "https://api.github.com/users/phadej/repos", + "events_url": "https://api.github.com/users/phadej/events{/privacy}", + "received_events_url": "https://api.github.com/users/phadej/received_events", + "type": "User", + "site_admin": false + }, + "labels": [ + + ], + "state": "open", + "locked": false, + "assignee": null, + "assignees": [], + "milestone": null, + "comments": 2, + "created_at": "2015-12-01T11:09:03Z", + "updated_at": "2015-12-25T19:15:33Z", + "closed_at": null, + "body": "After working with this API, and making few others, I found that separating request creation and execution is better (i.e. more flexible) design.\r\n\r\nNow one cannot use different network client or add new endpoints.\r\n\r\nShorly\r\n\r\n```hs\r\n-- New stuff:\r\ndata GithubRequest a = GithubRequestGet Url\r\n | ...\r\n\r\n-- or alternatively\r\ndata GithubRequest a where\r\n GithubRequestGet :: Url -> GithubRequest a\r\n GithubRequestMultiGet :: Url -> GithubRequest [a]\r\n\r\nexecGithubRequest :: FromJSON a => GithubRequest a -> IO (Either Error a)\r\nexecGithubRequest' :: FromJSON a => Maybe GithubAuth -> GithubRequest a -> IO (Either Error a)\r\n\r\npublicOrganizationForRequest :: String -> GithubRequest [SimpleOrganisation]\r\npublicOrganizationForRequest org = GithubRequestGet ...\r\n\r\n-- Old IO methods become:\r\npublicOrganizationsFor :: String -> IO (Either Error [SimpleOrganization])\r\npublicOrganizationsFor = execGithubRequest . publicOrganizationForRequest\r\n\r\npublicOrganizationsFor' :: Maybe GithubAuth -> String -> IO (Either Error [SimpleOrganization])\r\npublicOrganizationsFor' auth = execGithubRequest' auth . publicOrganizationForRequest\r\n```\r\n\r\nHow does this sound? I can make a refactoring, it's quite straight-forward.", + "score": 0.7265285 + } + ] +} diff --git a/fixtures/list-teams.json b/fixtures/list-teams.json new file mode 100644 index 00000000..f4ec6b8d --- /dev/null +++ b/fixtures/list-teams.json @@ -0,0 +1,13 @@ +[ + { + "id": 1, + "url": "https://api.github.com/teams/1", + "name": "Justice League", + "slug": "justice-league", + "description": "A great team.", + "privacy": "closed", + "permission": "admin", + "members_url": "https://api.github.com/teams/1/members{/member}", + "repositories_url": "https://api.github.com/teams/1/repos" + } +] diff --git a/fixtures/members-list.json b/fixtures/members-list.json new file mode 100644 index 00000000..d581825b --- /dev/null +++ b/fixtures/members-list.json @@ -0,0 +1,21 @@ +[ + { + "login": "octocat", + "id": 1, + "avatar_url": "https://github.com/images/error/octocat_happy.gif", + "gravatar_id": "", + "url": "https://api.github.com/users/octocat", + "html_url": "https://github.com/octocat", + "followers_url": "https://api.github.com/users/octocat/followers", + "following_url": "https://api.github.com/users/octocat/following{/other_user}", + "gists_url": "https://api.github.com/users/octocat/gists{/gist_id}", + "starred_url": "https://api.github.com/users/octocat/starred{/owner}{/repo}", + "subscriptions_url": "https://api.github.com/users/octocat/subscriptions", + "organizations_url": "https://api.github.com/users/octocat/orgs", + "repos_url": "https://api.github.com/users/octocat/repos", + "events_url": "https://api.github.com/users/octocat/events{/privacy}", + "received_events_url": "https://api.github.com/users/octocat/received_events", + "type": "User", + "site_admin": false + } +] diff --git a/fixtures/pull-request-approved-review.json b/fixtures/pull-request-approved-review.json new file mode 100644 index 00000000..d675f9af --- /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" +} \ No newline at end of file diff --git a/fixtures/pull-request-opened.json b/fixtures/pull-request-opened.json new file mode 100644 index 00000000..1dfcddf0 --- /dev/null +++ b/fixtures/pull-request-opened.json @@ -0,0 +1,311 @@ +{ + "url": "https://api.github.com/repos/phadej/github/pulls/9", + "id": 144079630, + "html_url": "https://github.com/phadej/github/pull/9", + "diff_url": "https://github.com/phadej/github/pull/9.diff", + "patch_url": "https://github.com/phadej/github/pull/9.patch", + "issue_url": "https://api.github.com/repos/phadej/github/issues/9", + "number": 9, + "state": "open", + "locked": false, + "title": "Fetch my pull requests", + "user": { + "login": "phadej", + "id": 123898390, + "avatar_url": "https://avatars3.githubusercontent.com/u/123898390?v=4", + "gravatar_id": "", + "url": "https://api.github.com/users/phadej", + "html_url": "https://github.com/phadej", + "followers_url": "https://api.github.com/users/phadej/followers", + "following_url": "https://api.github.com/users/phadej/following{/other_user}", + "gists_url": "https://api.github.com/users/phadej/gists{/gist_id}", + "starred_url": "https://api.github.com/users/phadej/starred{/owner}{/repo}", + "subscriptions_url": "https://api.github.com/users/phadej/subscriptions", + "organizations_url": "https://api.github.com/users/phadej/orgs", + "repos_url": "https://api.github.com/users/phadej/repos", + "events_url": "https://api.github.com/users/phadej/events{/privacy}", + "received_events_url": "https://api.github.com/users/phadej/received_events", + "type": "User", + "site_admin": false + }, + "body": "", + "created_at": "2017-10-01T17:22:12Z", + "updated_at": "2017-10-01T17:22:12Z", + "closed_at": null, + "merged_at": null, + "merge_commit_sha": null, + "assignee": null, + "assignees": [ + ], + "milestone": null, + "commits_url": "https://api.github.com/repos/phadej/github/pulls/9/commits", + "review_comments_url": "https://api.github.com/repos/phadej/github/pulls/9/comments", + "review_comment_url": "https://api.github.com/repos/phadej/github/pulls/comments{/number}", + "comments_url": "https://api.github.com/repos/phadej/github/issues/9/comments", + "statuses_url": "https://api.github.com/repos/phadej/github/statuses/20218048bb9529de09f1fdaa9126f60ffeb07ce5", + "head": { + "label": "phadej:fetch-my-pull-requests", + "ref": "fetch-my-pull-requests", + "sha": "20218048bb9529de09f1fdaa9126f60ffeb07ce5", + "user": { + "login": "phadej", + "id": 123898390, + "avatar_url": "https://avatars3.githubusercontent.com/u/123898390?v=4", + "gravatar_id": "", + "url": "https://api.github.com/users/phadej", + "html_url": "https://github.com/phadej", + "followers_url": "https://api.github.com/users/phadej/followers", + "following_url": "https://api.github.com/users/phadej/following{/other_user}", + "gists_url": "https://api.github.com/users/phadej/gists{/gist_id}", + "starred_url": "https://api.github.com/users/phadej/starred{/owner}{/repo}", + "subscriptions_url": "https://api.github.com/users/phadej/subscriptions", + "organizations_url": "https://api.github.com/users/phadej/orgs", + "repos_url": "https://api.github.com/users/phadej/repos", + "events_url": "https://api.github.com/users/phadej/events{/privacy}", + "received_events_url": "https://api.github.com/users/phadej/received_events", + "type": "User", + "site_admin": false + }, + "repo": { + "id": 102602684, + "name": "github", + "full_name": "phadej/github", + "owner": { + "login": "phadej", + "id": 123898390, + "avatar_url": "https://avatars3.githubusercontent.com/u/123898390?v=4", + "gravatar_id": "", + "url": "https://api.github.com/users/phadej", + "html_url": "https://github.com/phadej", + "followers_url": "https://api.github.com/users/phadej/followers", + "following_url": "https://api.github.com/users/phadej/following{/other_user}", + "gists_url": "https://api.github.com/users/phadej/gists{/gist_id}", + "starred_url": "https://api.github.com/users/phadej/starred{/owner}{/repo}", + "subscriptions_url": "https://api.github.com/users/phadej/subscriptions", + "organizations_url": "https://api.github.com/users/phadej/orgs", + "repos_url": "https://api.github.com/users/phadej/repos", + "events_url": "https://api.github.com/users/phadej/events{/privacy}", + "received_events_url": "https://api.github.com/users/phadej/received_events", + "type": "User", + "site_admin": false + }, + "private": true, + "html_url": "https://github.com/phadej/github", + "description": null, + "fork": false, + "url": "https://api.github.com/repos/phadej/github", + "forks_url": "https://api.github.com/repos/phadej/github/forks", + "keys_url": "https://api.github.com/repos/phadej/github/keys{/key_id}", + "collaborators_url": "https://api.github.com/repos/phadej/github/collaborators{/collaborator}", + "teams_url": "https://api.github.com/repos/phadej/github/teams", + "hooks_url": "https://api.github.com/repos/phadej/github/hooks", + "issue_events_url": "https://api.github.com/repos/phadej/github/issues/events{/number}", + "events_url": "https://api.github.com/repos/phadej/github/events", + "assignees_url": "https://api.github.com/repos/phadej/github/assignees{/user}", + "branches_url": "https://api.github.com/repos/phadej/github/branches{/branch}", + "tags_url": "https://api.github.com/repos/phadej/github/tags", + "blobs_url": "https://api.github.com/repos/phadej/github/git/blobs{/sha}", + "git_tags_url": "https://api.github.com/repos/phadej/github/git/tags{/sha}", + "git_refs_url": "https://api.github.com/repos/phadej/github/git/refs{/sha}", + "trees_url": "https://api.github.com/repos/phadej/github/git/trees{/sha}", + "statuses_url": "https://api.github.com/repos/phadej/github/statuses/{sha}", + "languages_url": "https://api.github.com/repos/phadej/github/languages", + "stargazers_url": "https://api.github.com/repos/phadej/github/stargazers", + "contributors_url": "https://api.github.com/repos/phadej/github/contributors", + "subscribers_url": "https://api.github.com/repos/phadej/github/subscribers", + "subscription_url": "https://api.github.com/repos/phadej/github/subscription", + "commits_url": "https://api.github.com/repos/phadej/github/commits{/sha}", + "git_commits_url": "https://api.github.com/repos/phadej/github/git/commits{/sha}", + "comments_url": "https://api.github.com/repos/phadej/github/comments{/number}", + "issue_comment_url": "https://api.github.com/repos/phadej/github/issues/comments{/number}", + "contents_url": "https://api.github.com/repos/phadej/github/contents/{+path}", + "compare_url": "https://api.github.com/repos/phadej/github/compare/{base}...{head}", + "merges_url": "https://api.github.com/repos/phadej/github/merges", + "archive_url": "https://api.github.com/repos/phadej/github/{archive_format}{/ref}", + "downloads_url": "https://api.github.com/repos/phadej/github/downloads", + "issues_url": "https://api.github.com/repos/phadej/github/issues{/number}", + "pulls_url": "https://api.github.com/repos/phadej/github/pulls{/number}", + "milestones_url": "https://api.github.com/repos/phadej/github/milestones{/number}", + "notifications_url": "https://api.github.com/repos/phadej/github/notifications{?since,all,participating}", + "labels_url": "https://api.github.com/repos/phadej/github/labels{/name}", + "releases_url": "https://api.github.com/repos/phadej/github/releases{/id}", + "deployments_url": "https://api.github.com/repos/phadej/github/deployments", + "created_at": "2017-09-06T11:54:37Z", + "updated_at": "2017-09-06T11:55:42Z", + "pushed_at": "2017-10-01T16:58:54Z", + "git_url": "git://github.com/phadej/github.git", + "ssh_url": "git@github.com:phadej/github.git", + "clone_url": "https://github.com/phadej/github.git", + "svn_url": "https://github.com/phadej/github", + "homepage": null, + "size": 335, + "stargazers_count": 0, + "watchers_count": 0, + "language": "Haskell", + "has_issues": true, + "has_projects": true, + "has_downloads": true, + "has_wiki": true, + "has_pages": false, + "forks_count": 0, + "mirror_url": null, + "open_issues_count": 1, + "forks": 0, + "open_issues": 1, + "watchers": 0, + "default_branch": "master" + } + }, + "base": { + "label": "phadej:master", + "ref": "master", + "sha": "cb686149c0d88af16de61488a1ba70a6c71a2b65", + "user": { + "login": "phadej", + "id": 123898390, + "avatar_url": "https://avatars3.githubusercontent.com/u/123898390?v=4", + "gravatar_id": "", + "url": "https://api.github.com/users/phadej", + "html_url": "https://github.com/phadej", + "followers_url": "https://api.github.com/users/phadej/followers", + "following_url": "https://api.github.com/users/phadej/following{/other_user}", + "gists_url": "https://api.github.com/users/phadej/gists{/gist_id}", + "starred_url": "https://api.github.com/users/phadej/starred{/owner}{/repo}", + "subscriptions_url": "https://api.github.com/users/phadej/subscriptions", + "organizations_url": "https://api.github.com/users/phadej/orgs", + "repos_url": "https://api.github.com/users/phadej/repos", + "events_url": "https://api.github.com/users/phadej/events{/privacy}", + "received_events_url": "https://api.github.com/users/phadej/received_events", + "type": "User", + "site_admin": false + }, + "repo": { + "id": 102602684, + "name": "github", + "full_name": "phadej/github", + "owner": { + "login": "phadej", + "id": 123898390, + "avatar_url": "https://avatars3.githubusercontent.com/u/123898390?v=4", + "gravatar_id": "", + "url": "https://api.github.com/users/phadej", + "html_url": "https://github.com/phadej", + "followers_url": "https://api.github.com/users/phadej/followers", + "following_url": "https://api.github.com/users/phadej/following{/other_user}", + "gists_url": "https://api.github.com/users/phadej/gists{/gist_id}", + "starred_url": "https://api.github.com/users/phadej/starred{/owner}{/repo}", + "subscriptions_url": "https://api.github.com/users/phadej/subscriptions", + "organizations_url": "https://api.github.com/users/phadej/orgs", + "repos_url": "https://api.github.com/users/phadej/repos", + "events_url": "https://api.github.com/users/phadej/events{/privacy}", + "received_events_url": "https://api.github.com/users/phadej/received_events", + "type": "User", + "site_admin": false + }, + "private": true, + "html_url": "https://github.com/phadej/github", + "description": null, + "fork": false, + "url": "https://api.github.com/repos/phadej/github", + "forks_url": "https://api.github.com/repos/phadej/github/forks", + "keys_url": "https://api.github.com/repos/phadej/github/keys{/key_id}", + "collaborators_url": "https://api.github.com/repos/phadej/github/collaborators{/collaborator}", + "teams_url": "https://api.github.com/repos/phadej/github/teams", + "hooks_url": "https://api.github.com/repos/phadej/github/hooks", + "issue_events_url": "https://api.github.com/repos/phadej/github/issues/events{/number}", + "events_url": "https://api.github.com/repos/phadej/github/events", + "assignees_url": "https://api.github.com/repos/phadej/github/assignees{/user}", + "branches_url": "https://api.github.com/repos/phadej/github/branches{/branch}", + "tags_url": "https://api.github.com/repos/phadej/github/tags", + "blobs_url": "https://api.github.com/repos/phadej/github/git/blobs{/sha}", + "git_tags_url": "https://api.github.com/repos/phadej/github/git/tags{/sha}", + "git_refs_url": "https://api.github.com/repos/phadej/github/git/refs{/sha}", + "trees_url": "https://api.github.com/repos/phadej/github/git/trees{/sha}", + "statuses_url": "https://api.github.com/repos/phadej/github/statuses/{sha}", + "languages_url": "https://api.github.com/repos/phadej/github/languages", + "stargazers_url": "https://api.github.com/repos/phadej/github/stargazers", + "contributors_url": "https://api.github.com/repos/phadej/github/contributors", + "subscribers_url": "https://api.github.com/repos/phadej/github/subscribers", + "subscription_url": "https://api.github.com/repos/phadej/github/subscription", + "commits_url": "https://api.github.com/repos/phadej/github/commits{/sha}", + "git_commits_url": "https://api.github.com/repos/phadej/github/git/commits{/sha}", + "comments_url": "https://api.github.com/repos/phadej/github/comments{/number}", + "issue_comment_url": "https://api.github.com/repos/phadej/github/issues/comments{/number}", + "contents_url": "https://api.github.com/repos/phadej/github/contents/{+path}", + "compare_url": "https://api.github.com/repos/phadej/github/compare/{base}...{head}", + "merges_url": "https://api.github.com/repos/phadej/github/merges", + "archive_url": "https://api.github.com/repos/phadej/github/{archive_format}{/ref}", + "downloads_url": "https://api.github.com/repos/phadej/github/downloads", + "issues_url": "https://api.github.com/repos/phadej/github/issues{/number}", + "pulls_url": "https://api.github.com/repos/phadej/github/pulls{/number}", + "milestones_url": "https://api.github.com/repos/phadej/github/milestones{/number}", + "notifications_url": "https://api.github.com/repos/phadej/github/notifications{?since,all,participating}", + "labels_url": "https://api.github.com/repos/phadej/github/labels{/name}", + "releases_url": "https://api.github.com/repos/phadej/github/releases{/id}", + "deployments_url": "https://api.github.com/repos/phadej/github/deployments", + "created_at": "2017-09-06T11:54:37Z", + "updated_at": "2017-09-06T11:55:42Z", + "pushed_at": "2017-10-01T16:58:54Z", + "git_url": "git://github.com/phadej/github.git", + "ssh_url": "git@github.com:phadej/github.git", + "clone_url": "https://github.com/phadej/github.git", + "svn_url": "https://github.com/phadej/github", + "homepage": null, + "size": 335, + "stargazers_count": 0, + "watchers_count": 0, + "language": "Haskell", + "has_issues": true, + "has_projects": true, + "has_downloads": true, + "has_wiki": true, + "has_pages": false, + "forks_count": 0, + "mirror_url": null, + "open_issues_count": 1, + "forks": 0, + "open_issues": 1, + "watchers": 0, + "default_branch": "master" + } + }, + "_links": { + "self": { + "href": "https://api.github.com/repos/phadej/github/pulls/9" + }, + "html": { + "href": "https://github.com/phadej/github/pull/9" + }, + "issue": { + "href": "https://api.github.com/repos/phadej/github/issues/9" + }, + "comments": { + "href": "https://api.github.com/repos/phadej/github/issues/9/comments" + }, + "review_comments": { + "href": "https://api.github.com/repos/phadej/github/pulls/9/comments" + }, + "review_comment": { + "href": "https://api.github.com/repos/phadej/github/pulls/comments{/number}" + }, + "commits": { + "href": "https://api.github.com/repos/phadej/github/pulls/9/commits" + }, + "statuses": { + "href": "https://api.github.com/repos/phadej/github/statuses/20218048bb9529de09f1fdaa9126f60ffeb07ce5" + } + }, + "author_association": "OWNER", + "merged": false, + "mergeable": null, + "rebaseable": null, + "mergeable_state": "unknown", + "merged_by": null, + "comments": 0, + "review_comments": 0, + "maintainer_can_modify": false, + "commits": 6, + "additions": 363, + "deletions": 48, + "changed_files": 19 +} diff --git a/fixtures/pull-request-pending-review.json b/fixtures/pull-request-pending-review.json new file mode 100644 index 00000000..bea632a7 --- /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" +} \ No newline at end of file diff --git a/fixtures/pull-request-review-requested.json b/fixtures/pull-request-review-requested.json new file mode 100644 index 00000000..7a9adca2 --- /dev/null +++ b/fixtures/pull-request-review-requested.json @@ -0,0 +1,351 @@ +{ + "url": "https://api.github.com/repos/phadej/github/pulls/9", + "id": 144079630, + "html_url": "https://github.com/phadej/github/pull/9", + "diff_url": "https://github.com/phadej/github/pull/9.diff", + "patch_url": "https://github.com/phadej/github/pull/9.patch", + "issue_url": "https://api.github.com/repos/phadej/github/issues/9", + "number": 9, + "state": "open", + "locked": false, + "title": "Fetch my pull requests", + "user": { + "login": "phadej", + "id": 123898390, + "avatar_url": "https://avatars3.githubusercontent.com/u/123898390?v=4", + "gravatar_id": "", + "url": "https://api.github.com/users/phadej", + "html_url": "https://github.com/phadej", + "followers_url": "https://api.github.com/users/phadej/followers", + "following_url": "https://api.github.com/users/phadej/following{/other_user}", + "gists_url": "https://api.github.com/users/phadej/gists{/gist_id}", + "starred_url": "https://api.github.com/users/phadej/starred{/owner}{/repo}", + "subscriptions_url": "https://api.github.com/users/phadej/subscriptions", + "organizations_url": "https://api.github.com/users/phadej/orgs", + "repos_url": "https://api.github.com/users/phadej/repos", + "events_url": "https://api.github.com/users/phadej/events{/privacy}", + "received_events_url": "https://api.github.com/users/phadej/received_events", + "type": "User", + "site_admin": false + }, + "body": "", + "created_at": "2017-10-01T17:22:12Z", + "updated_at": "2017-10-01T17:22:12Z", + "closed_at": null, + "merged_at": null, + "merge_commit_sha": null, + "assignee": null, + "assignees": [ + { + "login": "phadej", + "id": 123898390, + "avatar_url": "https://avatars3.githubusercontent.com/u/123898390?v=4", + "gravatar_id": "", + "url": "https://api.github.com/users/phadej", + "html_url": "https://github.com/phadej", + "followers_url": "https://api.github.com/users/phadej/followers", + "following_url": "https://api.github.com/users/phadej/following{/other_user}", + "gists_url": "https://api.github.com/users/phadej/gists{/gist_id}", + "starred_url": "https://api.github.com/users/phadej/starred{/owner}{/repo}", + "subscriptions_url": "https://api.github.com/users/phadej/subscriptions", + "organizations_url": "https://api.github.com/users/phadej/orgs", + "repos_url": "https://api.github.com/users/phadej/repos", + "events_url": "https://api.github.com/users/phadej/events{/privacy}", + "received_events_url": "https://api.github.com/users/phadej/received_events", + "type": "User", + "site_admin": false + } + ], + "requested_reviewers": [ + { + "login": "phadej", + "id": 123898390, + "avatar_url": "https://avatars3.githubusercontent.com/u/123898390?v=4", + "gravatar_id": "", + "url": "https://api.github.com/users/phadej", + "html_url": "https://github.com/phadej", + "followers_url": "https://api.github.com/users/phadej/followers", + "following_url": "https://api.github.com/users/phadej/following{/other_user}", + "gists_url": "https://api.github.com/users/phadej/gists{/gist_id}", + "starred_url": "https://api.github.com/users/phadej/starred{/owner}{/repo}", + "subscriptions_url": "https://api.github.com/users/phadej/subscriptions", + "organizations_url": "https://api.github.com/users/phadej/orgs", + "repos_url": "https://api.github.com/users/phadej/repos", + "events_url": "https://api.github.com/users/phadej/events{/privacy}", + "received_events_url": "https://api.github.com/users/phadej/received_events", + "type": "User", + "site_admin": false + } + ], + "milestone": null, + "commits_url": "https://api.github.com/repos/phadej/github/pulls/9/commits", + "review_comments_url": "https://api.github.com/repos/phadej/github/pulls/9/comments", + "review_comment_url": "https://api.github.com/repos/phadej/github/pulls/comments{/number}", + "comments_url": "https://api.github.com/repos/phadej/github/issues/9/comments", + "statuses_url": "https://api.github.com/repos/phadej/github/statuses/20218048bb9529de09f1fdaa9126f60ffeb07ce5", + "head": { + "label": "phadej:fetch-my-pull-requests", + "ref": "fetch-my-pull-requests", + "sha": "20218048bb9529de09f1fdaa9126f60ffeb07ce5", + "user": { + "login": "phadej", + "id": 123898390, + "avatar_url": "https://avatars3.githubusercontent.com/u/123898390?v=4", + "gravatar_id": "", + "url": "https://api.github.com/users/phadej", + "html_url": "https://github.com/phadej", + "followers_url": "https://api.github.com/users/phadej/followers", + "following_url": "https://api.github.com/users/phadej/following{/other_user}", + "gists_url": "https://api.github.com/users/phadej/gists{/gist_id}", + "starred_url": "https://api.github.com/users/phadej/starred{/owner}{/repo}", + "subscriptions_url": "https://api.github.com/users/phadej/subscriptions", + "organizations_url": "https://api.github.com/users/phadej/orgs", + "repos_url": "https://api.github.com/users/phadej/repos", + "events_url": "https://api.github.com/users/phadej/events{/privacy}", + "received_events_url": "https://api.github.com/users/phadej/received_events", + "type": "User", + "site_admin": false + }, + "repo": { + "id": 102602684, + "name": "github", + "full_name": "phadej/github", + "owner": { + "login": "phadej", + "id": 123898390, + "avatar_url": "https://avatars3.githubusercontent.com/u/123898390?v=4", + "gravatar_id": "", + "url": "https://api.github.com/users/phadej", + "html_url": "https://github.com/phadej", + "followers_url": "https://api.github.com/users/phadej/followers", + "following_url": "https://api.github.com/users/phadej/following{/other_user}", + "gists_url": "https://api.github.com/users/phadej/gists{/gist_id}", + "starred_url": "https://api.github.com/users/phadej/starred{/owner}{/repo}", + "subscriptions_url": "https://api.github.com/users/phadej/subscriptions", + "organizations_url": "https://api.github.com/users/phadej/orgs", + "repos_url": "https://api.github.com/users/phadej/repos", + "events_url": "https://api.github.com/users/phadej/events{/privacy}", + "received_events_url": "https://api.github.com/users/phadej/received_events", + "type": "User", + "site_admin": false + }, + "private": true, + "html_url": "https://github.com/phadej/github", + "description": null, + "fork": false, + "url": "https://api.github.com/repos/phadej/github", + "forks_url": "https://api.github.com/repos/phadej/github/forks", + "keys_url": "https://api.github.com/repos/phadej/github/keys{/key_id}", + "collaborators_url": "https://api.github.com/repos/phadej/github/collaborators{/collaborator}", + "teams_url": "https://api.github.com/repos/phadej/github/teams", + "hooks_url": "https://api.github.com/repos/phadej/github/hooks", + "issue_events_url": "https://api.github.com/repos/phadej/github/issues/events{/number}", + "events_url": "https://api.github.com/repos/phadej/github/events", + "assignees_url": "https://api.github.com/repos/phadej/github/assignees{/user}", + "branches_url": "https://api.github.com/repos/phadej/github/branches{/branch}", + "tags_url": "https://api.github.com/repos/phadej/github/tags", + "blobs_url": "https://api.github.com/repos/phadej/github/git/blobs{/sha}", + "git_tags_url": "https://api.github.com/repos/phadej/github/git/tags{/sha}", + "git_refs_url": "https://api.github.com/repos/phadej/github/git/refs{/sha}", + "trees_url": "https://api.github.com/repos/phadej/github/git/trees{/sha}", + "statuses_url": "https://api.github.com/repos/phadej/github/statuses/{sha}", + "languages_url": "https://api.github.com/repos/phadej/github/languages", + "stargazers_url": "https://api.github.com/repos/phadej/github/stargazers", + "contributors_url": "https://api.github.com/repos/phadej/github/contributors", + "subscribers_url": "https://api.github.com/repos/phadej/github/subscribers", + "subscription_url": "https://api.github.com/repos/phadej/github/subscription", + "commits_url": "https://api.github.com/repos/phadej/github/commits{/sha}", + "git_commits_url": "https://api.github.com/repos/phadej/github/git/commits{/sha}", + "comments_url": "https://api.github.com/repos/phadej/github/comments{/number}", + "issue_comment_url": "https://api.github.com/repos/phadej/github/issues/comments{/number}", + "contents_url": "https://api.github.com/repos/phadej/github/contents/{+path}", + "compare_url": "https://api.github.com/repos/phadej/github/compare/{base}...{head}", + "merges_url": "https://api.github.com/repos/phadej/github/merges", + "archive_url": "https://api.github.com/repos/phadej/github/{archive_format}{/ref}", + "downloads_url": "https://api.github.com/repos/phadej/github/downloads", + "issues_url": "https://api.github.com/repos/phadej/github/issues{/number}", + "pulls_url": "https://api.github.com/repos/phadej/github/pulls{/number}", + "milestones_url": "https://api.github.com/repos/phadej/github/milestones{/number}", + "notifications_url": "https://api.github.com/repos/phadej/github/notifications{?since,all,participating}", + "labels_url": "https://api.github.com/repos/phadej/github/labels{/name}", + "releases_url": "https://api.github.com/repos/phadej/github/releases{/id}", + "deployments_url": "https://api.github.com/repos/phadej/github/deployments", + "created_at": "2017-09-06T11:54:37Z", + "updated_at": "2017-09-06T11:55:42Z", + "pushed_at": "2017-10-01T16:58:54Z", + "git_url": "git://github.com/phadej/github.git", + "ssh_url": "git@github.com:phadej/github.git", + "clone_url": "https://github.com/phadej/github.git", + "svn_url": "https://github.com/phadej/github", + "homepage": null, + "size": 335, + "stargazers_count": 0, + "watchers_count": 0, + "language": "Haskell", + "has_issues": true, + "has_projects": true, + "has_downloads": true, + "has_wiki": true, + "has_pages": false, + "forks_count": 0, + "mirror_url": null, + "open_issues_count": 1, + "forks": 0, + "open_issues": 1, + "watchers": 0, + "default_branch": "master" + } + }, + "base": { + "label": "phadej:master", + "ref": "master", + "sha": "cb686149c0d88af16de61488a1ba70a6c71a2b65", + "user": { + "login": "phadej", + "id": 123898390, + "avatar_url": "https://avatars3.githubusercontent.com/u/123898390?v=4", + "gravatar_id": "", + "url": "https://api.github.com/users/phadej", + "html_url": "https://github.com/phadej", + "followers_url": "https://api.github.com/users/phadej/followers", + "following_url": "https://api.github.com/users/phadej/following{/other_user}", + "gists_url": "https://api.github.com/users/phadej/gists{/gist_id}", + "starred_url": "https://api.github.com/users/phadej/starred{/owner}{/repo}", + "subscriptions_url": "https://api.github.com/users/phadej/subscriptions", + "organizations_url": "https://api.github.com/users/phadej/orgs", + "repos_url": "https://api.github.com/users/phadej/repos", + "events_url": "https://api.github.com/users/phadej/events{/privacy}", + "received_events_url": "https://api.github.com/users/phadej/received_events", + "type": "User", + "site_admin": false + }, + "repo": { + "id": 102602684, + "name": "github", + "full_name": "phadej/github", + "owner": { + "login": "phadej", + "id": 123898390, + "avatar_url": "https://avatars3.githubusercontent.com/u/123898390?v=4", + "gravatar_id": "", + "url": "https://api.github.com/users/phadej", + "html_url": "https://github.com/phadej", + "followers_url": "https://api.github.com/users/phadej/followers", + "following_url": "https://api.github.com/users/phadej/following{/other_user}", + "gists_url": "https://api.github.com/users/phadej/gists{/gist_id}", + "starred_url": "https://api.github.com/users/phadej/starred{/owner}{/repo}", + "subscriptions_url": "https://api.github.com/users/phadej/subscriptions", + "organizations_url": "https://api.github.com/users/phadej/orgs", + "repos_url": "https://api.github.com/users/phadej/repos", + "events_url": "https://api.github.com/users/phadej/events{/privacy}", + "received_events_url": "https://api.github.com/users/phadej/received_events", + "type": "User", + "site_admin": false + }, + "private": true, + "html_url": "https://github.com/phadej/github", + "description": null, + "fork": false, + "url": "https://api.github.com/repos/phadej/github", + "forks_url": "https://api.github.com/repos/phadej/github/forks", + "keys_url": "https://api.github.com/repos/phadej/github/keys{/key_id}", + "collaborators_url": "https://api.github.com/repos/phadej/github/collaborators{/collaborator}", + "teams_url": "https://api.github.com/repos/phadej/github/teams", + "hooks_url": "https://api.github.com/repos/phadej/github/hooks", + "issue_events_url": "https://api.github.com/repos/phadej/github/issues/events{/number}", + "events_url": "https://api.github.com/repos/phadej/github/events", + "assignees_url": "https://api.github.com/repos/phadej/github/assignees{/user}", + "branches_url": "https://api.github.com/repos/phadej/github/branches{/branch}", + "tags_url": "https://api.github.com/repos/phadej/github/tags", + "blobs_url": "https://api.github.com/repos/phadej/github/git/blobs{/sha}", + "git_tags_url": "https://api.github.com/repos/phadej/github/git/tags{/sha}", + "git_refs_url": "https://api.github.com/repos/phadej/github/git/refs{/sha}", + "trees_url": "https://api.github.com/repos/phadej/github/git/trees{/sha}", + "statuses_url": "https://api.github.com/repos/phadej/github/statuses/{sha}", + "languages_url": "https://api.github.com/repos/phadej/github/languages", + "stargazers_url": "https://api.github.com/repos/phadej/github/stargazers", + "contributors_url": "https://api.github.com/repos/phadej/github/contributors", + "subscribers_url": "https://api.github.com/repos/phadej/github/subscribers", + "subscription_url": "https://api.github.com/repos/phadej/github/subscription", + "commits_url": "https://api.github.com/repos/phadej/github/commits{/sha}", + "git_commits_url": "https://api.github.com/repos/phadej/github/git/commits{/sha}", + "comments_url": "https://api.github.com/repos/phadej/github/comments{/number}", + "issue_comment_url": "https://api.github.com/repos/phadej/github/issues/comments{/number}", + "contents_url": "https://api.github.com/repos/phadej/github/contents/{+path}", + "compare_url": "https://api.github.com/repos/phadej/github/compare/{base}...{head}", + "merges_url": "https://api.github.com/repos/phadej/github/merges", + "archive_url": "https://api.github.com/repos/phadej/github/{archive_format}{/ref}", + "downloads_url": "https://api.github.com/repos/phadej/github/downloads", + "issues_url": "https://api.github.com/repos/phadej/github/issues{/number}", + "pulls_url": "https://api.github.com/repos/phadej/github/pulls{/number}", + "milestones_url": "https://api.github.com/repos/phadej/github/milestones{/number}", + "notifications_url": "https://api.github.com/repos/phadej/github/notifications{?since,all,participating}", + "labels_url": "https://api.github.com/repos/phadej/github/labels{/name}", + "releases_url": "https://api.github.com/repos/phadej/github/releases{/id}", + "deployments_url": "https://api.github.com/repos/phadej/github/deployments", + "created_at": "2017-09-06T11:54:37Z", + "updated_at": "2017-09-06T11:55:42Z", + "pushed_at": "2017-10-01T16:58:54Z", + "git_url": "git://github.com/phadej/github.git", + "ssh_url": "git@github.com:phadej/github.git", + "clone_url": "https://github.com/phadej/github.git", + "svn_url": "https://github.com/phadej/github", + "homepage": null, + "size": 335, + "stargazers_count": 0, + "watchers_count": 0, + "language": "Haskell", + "has_issues": true, + "has_projects": true, + "has_downloads": true, + "has_wiki": true, + "has_pages": false, + "forks_count": 0, + "mirror_url": null, + "open_issues_count": 1, + "forks": 0, + "open_issues": 1, + "watchers": 0, + "default_branch": "master" + } + }, + "_links": { + "self": { + "href": "https://api.github.com/repos/phadej/github/pulls/9" + }, + "html": { + "href": "https://github.com/phadej/github/pull/9" + }, + "issue": { + "href": "https://api.github.com/repos/phadej/github/issues/9" + }, + "comments": { + "href": "https://api.github.com/repos/phadej/github/issues/9/comments" + }, + "review_comments": { + "href": "https://api.github.com/repos/phadej/github/pulls/9/comments" + }, + "review_comment": { + "href": "https://api.github.com/repos/phadej/github/pulls/comments{/number}" + }, + "commits": { + "href": "https://api.github.com/repos/phadej/github/pulls/9/commits" + }, + "statuses": { + "href": "https://api.github.com/repos/phadej/github/statuses/20218048bb9529de09f1fdaa9126f60ffeb07ce5" + } + }, + "author_association": "OWNER", + "merged": false, + "mergeable": null, + "rebaseable": null, + "mergeable_state": "unknown", + "merged_by": null, + "comments": 0, + "review_comments": 0, + "maintainer_can_modify": false, + "commits": 6, + "additions": 363, + "deletions": 48, + "changed_files": 19 +} diff --git a/fixtures/pull-request-team-review-requested.json b/fixtures/pull-request-team-review-requested.json new file mode 100644 index 00000000..7eeb71f7 --- /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 index 00000000..363ca887 --- /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/fixtures/user-organizations.json b/fixtures/user-organizations.json new file mode 100644 index 00000000..f8830228 --- /dev/null +++ b/fixtures/user-organizations.json @@ -0,0 +1,9 @@ +[ + { + "login": "github", + "id": 1, + "url": "https://api.github.com/orgs/github", + "avatar_url": "https://github.com/images/error/octocat_happy.gif", + "description": "A great organization" + } +] diff --git a/fixtures/user.json b/fixtures/user.json new file mode 100644 index 00000000..ab58bf99 --- /dev/null +++ b/fixtures/user.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": "User", + "site_admin": false, + "name": "Mike Burns", + "company": "thoughtbot", + "blog": "http://mike-burns.com/", + "location": "Stockholm, Sweden", + "email": "mburns@thoughtbot.com", + "hireable": true, + "bio": null, + "public_repos": 35, + "public_gists": 32, + "followers": 171, + "following": 0, + "created_at": "2008-04-03T17:54:24Z", + "updated_at": "2015-10-02T16:53:25Z" +} diff --git a/github.cabal b/github.cabal index 9dbde7e8..759c9f95 100644 --- a/github.cabal +++ b/github.cabal @@ -1,169 +1,271 @@ --- github.cabal auto-generated by cabal init. For additional options, --- see --- http://www.haskell.org/cabal/release/cabal-latest/doc/users-guide/authors.html#pkg-descr. --- The name of the package. -Name: github - --- The package version. See the Haskell package versioning policy --- (http://www.haskell.org/haskellwiki/Package_versioning_policy) for --- standards guiding when and how versions should be incremented. -Version: 0.7.1 - --- A short (one-line) description of the package. -Synopsis: Access to the Github API, v3. - --- A longer description of the package. -Description: The Github API provides programmatic access to the full - Github Web site, from Issues to Gists to repos down to the underlying git data - like references and trees. This library wraps all of that, exposing a basic but - Haskell-friendly set of functions and data structures. - . - For more of an overview please see the README: - --- The license under which the package is released. -License: BSD3 - --- The file containing the license text. -License-file: LICENSE - --- The package author(s). -Author: Mike Burns, John Wiegley - --- An email address to which users can send suggestions, bug reports, --- and patches. -Maintainer: johnw@fpcomplete.com - -Homepage: https://github.com/fpco/github - --- A copyright notice. -Copyright: Copyright 2012-2013 Mike Burns, Copyright 2013 John Wiegley - -Category: Network APIs - -Build-type: Simple - --- Extra files to be distributed with the package, such as examples or --- a README. -Extra-source-files: README.md - ,samples/Gists/Comments/ShowComment.hs - ,samples/Gists/Comments/ShowComments.hs - ,samples/Gists/ListGists.hs - ,samples/Gists/ShowGist.hs - ,samples/GitData/Commits/GitShow.hs - ,samples/GitData/References/GitLsRemote.hs - ,samples/GitData/References/GitLsRemoteTags.hs - ,samples/GitData/References/GitLsRemoteWithRef.hs - ,samples/GitData/Trees/GitLsTree.hs - ,samples/GitData/Trees/GitLsTreeRecursively.hs - ,samples/Issues/Comments/ShowComment.hs - ,samples/Issues/Comments/ShowComments.hs - ,samples/Issues/Events/ShowEvent.hs - ,samples/Issues/Events/ShowIssueEvents.hs - ,samples/Issues/Events/ShowRepoEvents.hs - ,samples/Issues/Labels/ShowIssueLabels.hs - ,samples/Issues/Labels/ShowLabel.hs - ,samples/Issues/Labels/ShowMilestoneLabels.hs - ,samples/Issues/Labels/ShowRepoLabels.hs - ,samples/Issues/Milestones/ShowMilestone.hs - ,samples/Issues/Milestones/ShowMilestones.hs - ,samples/Issues/ShowIssue.hs - ,samples/Issues/ShowRepoIssues.hs - ,samples/Organizations/Members/ShowMembers.hs - ,samples/Organizations/ShowPublicOrganization.hs - ,samples/Organizations/ShowPublicOrganizations.hs - ,samples/Pulls/Diff.hs - ,samples/Pulls/ListPulls.hs - ,samples/Pulls/ReviewComments/ListComments.hs - ,samples/Pulls/ReviewComments/ShowComment.hs - ,samples/Pulls/ShowCommits.hs - ,samples/Pulls/ShowPull.hs - ,samples/Search/SearchRepos.hs - ,samples/Repos/Collaborators/IsCollaborator.hs - ,samples/Repos/Collaborators/ListCollaborators.hs - ,samples/Repos/Commits/CommitComment.hs - ,samples/Repos/Commits/CommitComments.hs - ,samples/Repos/Commits/GitDiff.hs - ,samples/Repos/Commits/GitLog.hs - ,samples/Repos/Commits/GitShow.hs - ,samples/Repos/Commits/RepoComments.hs - ,samples/Repos/Forks/ListForks.hs - ,samples/Repos/ListBranches.hs - ,samples/Repos/ListContributors.hs - ,samples/Repos/ListContributorsWithAnonymous.hs - ,samples/Repos/ListLanguages.hs - ,samples/Repos/ListOrgRepos.hs - ,samples/Repos/ListTags.hs - ,samples/Repos/ListUserRepos.hs - ,samples/Repos/ShowRepo.hs - ,samples/Repos/Watching/ListWatched.hs - ,samples/Repos/Watching/ListWatchers.hs - ,samples/Repos/Starring/ListStarred.hs - ,samples/Users/Followers/ListFollowers.hs - ,samples/Users/Followers/ListFollowing.hs - ,samples/Users/ShowUser.hs - ,LICENSE - - --- Constraint on the version of Cabal needed to build this package. -Cabal-version: >=1.6 +cabal-version: 2.4 +name: github +version: 0.30.0.1 +synopsis: Access to the GitHub API, v3. +category: Network +description: + The GitHub API provides programmatic access to the full + GitHub Web site, from Issues to Gists to repos down to the underlying git data + like references and trees. This library wraps all of that, exposing a basic but + Haskell-friendly set of functions and data structures. + . + For supported endpoints see "GitHub" module. + . + > import qualified GitHub as GH + > + > main :: IO () + > main = do + > possibleUser <- GH.github' GH.userInfoForR "phadej" + > print possibleUser + . + For more of an overview please see the README: + +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.2 + 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/fpco/github.git - -Library - -- Modules exported by the library. - Exposed-modules: Github.Data, - Github.Data.Definitions, - Github.Gists, - Github.Gists.Comments, - Github.GitData.Commits, - Github.GitData.References, - Github.GitData.Trees, - Github.GitData.Blobs, - Github.Issues, - Github.Issues.Comments, - Github.Issues.Events, - Github.Issues.Labels, - Github.Issues.Milestones, - Github.Organizations, - Github.Organizations.Members, - Github.PullRequests, - Github.Repos, - Github.Repos.Collaborators, - Github.Repos.Commits, - Github.Repos.Forks, - Github.Repos.Watching, - Github.Repos.Starring, - Github.Users, - Github.Users.Followers - Github.Search - - -- Packages needed in order to build this package. - Build-depends: base >= 4.0 && < 5.0, - time, - aeson == 0.6.1.0, - attoparsec >= 0.10.3.0, - bytestring, - case-insensitive >= 0.4.0.4, - containers, - hashable, - text, - old-locale, - HTTP, - network, - http-conduit >= 1.8, - conduit, - failure, - http-types, - data-default, - vector, - unordered-containers >= 0.2 && < 0.3 - - -- Modules not exported by this package. - Other-modules: Github.Private - - -- Extra tools (e.g. alex, hsc2hs, ...) needed to build the source. - -- Build-tools: - - GHC-Options: -Wall -fno-warn-orphans + type: git + location: https://github.com/haskell-github/github.git + +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.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 + GitHub.Data.Id + GitHub.Data.Invitation + GitHub.Data.Issues + GitHub.Data.Milestone + GitHub.Data.Name + GitHub.Data.Options + GitHub.Data.PublicSSHKeys + GitHub.Data.PullRequests + GitHub.Data.RateLimit + GitHub.Data.Reactions + GitHub.Data.Releases + GitHub.Data.Repos + GitHub.Data.Request + GitHub.Data.Reviews + GitHub.Data.Search + GitHub.Data.Statuses + GitHub.Data.Teams + GitHub.Data.URL + GitHub.Data.Webhooks + GitHub.Data.Webhooks.Validate + GitHub.Endpoints.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 + GitHub.Endpoints.GitData.Commits + GitHub.Endpoints.GitData.References + GitHub.Endpoints.GitData.Trees + GitHub.Endpoints.Issues + GitHub.Endpoints.Issues.Comments + GitHub.Endpoints.Issues.Events + GitHub.Endpoints.Issues.Labels + GitHub.Endpoints.Issues.Milestones + GitHub.Endpoints.Organizations + GitHub.Endpoints.Organizations.Members + GitHub.Endpoints.Organizations.OutsideCollaborators + GitHub.Endpoints.Organizations.Teams + GitHub.Endpoints.PullRequests + 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 + GitHub.Endpoints.Search + 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.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 >=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 + + if flag(openssl) + build-depends: + HsOpenSSL >=0.11.4.16 && <0.12 + , HsOpenSSL-x509-system >=0.1.0.3 && <0.2 + , http-client-openssl >=0.2.2.0 && <0.4 + + else + build-depends: + http-client-tls >=0.3.5.3 && <0.4 + , tls >=1.4.1 + +test-suite github-test + default-language: Haskell2010 + type: exitcode-stdio-1.0 + hs-source-dirs: spec + main-is: Spec.hs + ghc-options: -Wall -threaded + build-tool-depends: hspec-discover:hspec-discover >=2.7.1 && <2.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.EventsSpec + GitHub.IssuesSpec + GitHub.OrganizationsSpec + GitHub.PublicSSHKeysSpec + GitHub.PullRequestReviewsSpec + GitHub.PullRequestsSpec + GitHub.RateLimitSpec + GitHub.ReleasesSpec + GitHub.ReposSpec + GitHub.ReviewDecodeSpec + GitHub.SearchSpec + GitHub.UsersSpec + + 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/samples/Activity/Starring/StarRepo.hs b/samples/Activity/Starring/StarRepo.hs new file mode 100644 index 00000000..1174c380 --- /dev/null +++ b/samples/Activity/Starring/StarRepo.hs @@ -0,0 +1,17 @@ +{-# LANGUAGE OverloadedStrings #-} +module StarRepo where + +import qualified GitHub.Endpoints.Activity.Starring as GH + +import qualified Data.Text as T +import qualified Data.Text.IO as T + +main :: IO () +main = do + let owner = "haskell-github" + repo = "github" + result <- GH.starRepo (GH.OAuth "your-token") + (GH.mkOwnerName owner) (GH.mkRepoName repo) + case result of + Left err -> putStrLn $ "Error: " ++ show err + Right () -> T.putStrLn $ T.concat ["Starred: ", owner, "/", repo] diff --git a/samples/Activity/Starring/UnstarRepo.hs b/samples/Activity/Starring/UnstarRepo.hs new file mode 100644 index 00000000..3ecfe196 --- /dev/null +++ b/samples/Activity/Starring/UnstarRepo.hs @@ -0,0 +1,17 @@ +{-# LANGUAGE OverloadedStrings #-} +module UnstarRepo where + +import qualified GitHub.Endpoints.Activity.Starring as GH + +import qualified Data.Text as T +import qualified Data.Text.IO as T + +main :: IO () +main = do + let owner = "haskell-github" + repo = "github" + result <- GH.unstarRepo (GH.OAuth "your-token") + (GH.mkOwnerName owner) (GH.mkRepoName repo) + case result of + Left err -> putStrLn $ "Error: " ++ show err + Right () -> T.putStrLn $ T.concat ["Unstarred: ", owner, "/", repo] diff --git a/samples/Enterprise/CreateOrganization.hs b/samples/Enterprise/CreateOrganization.hs new file mode 100644 index 00000000..32fc97cc --- /dev/null +++ b/samples/Enterprise/CreateOrganization.hs @@ -0,0 +1,30 @@ +{-# LANGUAGE NoImplicitPrelude #-} +{-# LANGUAGE OverloadedStrings #-} +module Main (main) where + +import Common + +import qualified GitHub +import qualified GitHub.Enterprise as GitHub + +main :: IO () +main = do + args <- getArgs + result <- case args of + [api_endpoint, token, org_login, org_admin, org_profile_name] -> + GitHub.github + (GitHub.EnterpriseOAuth + (fromString api_endpoint) + (fromString token) + ) + GitHub.createOrganizationR + (GitHub.CreateOrganization + (GitHub.mkOrganizationName $ fromString org_login) + (GitHub.mkUserName $ fromString org_admin) + (Just $ fromString org_profile_name) + ) + _ -> + error "usage: CreateOrganization " + case result of + Left err -> putStrLn $ "Error: " <> tshow err + Right org -> putStrLn $ tshow org diff --git a/samples/Enterprise/RenameOrganization.hs b/samples/Enterprise/RenameOrganization.hs new file mode 100644 index 00000000..c16fdf56 --- /dev/null +++ b/samples/Enterprise/RenameOrganization.hs @@ -0,0 +1,29 @@ +{-# LANGUAGE NoImplicitPrelude #-} +{-# LANGUAGE OverloadedStrings #-} +module Main (main) where + +import Common + +import qualified GitHub +import qualified GitHub.Enterprise as GitHub + +main :: IO () +main = do + args <- getArgs + result <- case args of + [api_endpoint, token, current_name, new_name] -> + GitHub.github + (GitHub.EnterpriseOAuth + (fromString api_endpoint) + (fromString token) + ) + GitHub.renameOrganizationR + (GitHub.mkOrganizationName $ fromString current_name) + (GitHub.RenameOrganization + (GitHub.mkOrganizationName $ fromString new_name) + ) + _ -> + error "usage: RenameOrganization " + case result of + Left err -> putStrLn $ "Error: " <> tshow err + Right x -> putStrLn $ tshow x diff --git a/samples/Gists/Comments/ShowComment.hs b/samples/Gists/Comments/ShowComment.hs index 7338f119..093d21d5 100644 --- a/samples/Gists/Comments/ShowComment.hs +++ b/samples/Gists/Comments/ShowComment.hs @@ -10,7 +10,7 @@ main = do formatComment comment = (Github.githubOwnerLogin $ Github.gistCommentUser comment) ++ "\n" ++ - (formatGithubDate $ Github.gistCommentUpdatedAt comment) ++ "\n\n" ++ + (formatDate $ Github.gistCommentUpdatedAt comment) ++ "\n\n" ++ (Github.gistCommentBody comment) -formatGithubDate = show . Github.fromGithubDate +formatDate = show . Github.fromDate diff --git a/samples/Gists/Comments/ShowComments.hs b/samples/Gists/Comments/ShowComments.hs index 86011660..9473a71c 100644 --- a/samples/Gists/Comments/ShowComments.hs +++ b/samples/Gists/Comments/ShowComments.hs @@ -11,7 +11,7 @@ main = do formatComment comment = (Github.githubOwnerLogin $ Github.gistCommentUser comment) ++ "\n" ++ - (formatGithubDate $ Github.gistCommentUpdatedAt comment) ++ "\n\n" ++ + (formatDate $ Github.gistCommentUpdatedAt comment) ++ "\n\n" ++ (Github.gistCommentBody comment) -formatGithubDate = show . Github.fromGithubDate +formatDate = show . Github.fromDate diff --git a/samples/Gists/DeleteGist.hs b/samples/Gists/DeleteGist.hs new file mode 100644 index 00000000..e950d939 --- /dev/null +++ b/samples/Gists/DeleteGist.hs @@ -0,0 +1,16 @@ +{-# LANGUAGE OverloadedStrings #-} +module DeleteGist where + +import qualified GitHub.Data.Name as N +import qualified GitHub.Endpoints.Gists as GH + +import qualified Data.Text as T +import qualified Data.Text.IO as T + +main :: IO () +main = do + let gid = "your-gist-id" + result <- GH.deleteGist (GH.OAuth "your-token") gid + case result of + Left err -> putStrLn $ "Error: " ++ show err + Right () -> T.putStrLn $ T.concat ["Deleted: ", N.untagName gid] diff --git a/samples/Gists/StarGist.hs b/samples/Gists/StarGist.hs new file mode 100644 index 00000000..f4941cd6 --- /dev/null +++ b/samples/Gists/StarGist.hs @@ -0,0 +1,16 @@ +{-# LANGUAGE OverloadedStrings #-} +module StarGist where + +import qualified GitHub.Data.Name as N +import qualified GitHub.Endpoints.Gists as GH + +import qualified Data.Text as T +import qualified Data.Text.IO as T + +main :: IO () +main = do + let gid = "your-gist-id" + result <- GH.starGist (GH.OAuth "your-token") gid + case result of + Left err -> putStrLn $ "Error: " ++ show err + Right () -> T.putStrLn $ T.concat ["Starred: ", N.untagName gid] diff --git a/samples/Gists/UnstarGist.hs b/samples/Gists/UnstarGist.hs new file mode 100644 index 00000000..d1731934 --- /dev/null +++ b/samples/Gists/UnstarGist.hs @@ -0,0 +1,16 @@ +{-# LANGUAGE OverloadedStrings #-} +module UnstarGist where + +import qualified GitHub.Data.Name as N +import qualified GitHub.Endpoints.Gists as GH + +import qualified Data.Text as T +import qualified Data.Text.IO as T + +main :: IO () +main = do + let gid = "your-gist-id" + result <- GH.unstarGist (GH.OAuth "your-token") gid + case result of + Left err -> putStrLn $ "Error: " ++ show err + Right () -> T.putStrLn $ T.concat ["Unstarred: ", N.untagName gid] diff --git a/samples/GitData/Commits/GitShow.hs b/samples/GitData/Commits/GitShow.hs index ea234b60..042dd812 100644 --- a/samples/GitData/Commits/GitShow.hs +++ b/samples/GitData/Commits/GitShow.hs @@ -13,7 +13,7 @@ formatCommit :: Github.GitCommit -> String formatCommit commit = "commit " ++ (fromJust $ Github.gitCommitSha commit) ++ "\nAuthor: " ++ (formatAuthor author) ++ - "\nDate: " ++ (show $ Github.fromGithubDate $ Github.gitUserDate author) ++ + "\nDate: " ++ (show $ Github.fromDate $ Github.gitUserDate author) ++ "\n\n\t" ++ (Github.gitCommitMessage commit) ++ "\n" where author = Github.gitCommitAuthor commit diff --git a/samples/GitData/References/GitCreateReference.hs b/samples/GitData/References/GitCreateReference.hs new file mode 100644 index 00000000..e56e1a2a --- /dev/null +++ b/samples/GitData/References/GitCreateReference.hs @@ -0,0 +1,19 @@ +module GitCreateRef where + +import qualified Github.Auth as Auth +import Github.GitData.References + +main :: IO () +main = do + let auth = Auth.OAuth "oauthtoken" + newlyCreatedGitRef <- createReference auth "myrepo" "myowner" NewGitReference { + newGitReferenceRef = "refs/heads/fav_tag" + ,newGitReferenceSha = "aa218f56b14c9653891f9e74264a383fa43fefbd" + } + case newlyCreatedGitRef of + (Left err) -> putStrLn $ "Error: " ++ show err + (Right newRef) -> putStrLn . formatReference $ newRef + +formatReference :: GitReference -> String +formatReference ref = + (gitObjectSha $ gitReferenceObject ref) ++ "\t" ++ (gitReferenceRef ref) diff --git a/samples/Issues/Comments/ShowComment.hs b/samples/Issues/Comments/ShowComment.hs index 94012d7e..ccfff2fe 100644 --- a/samples/Issues/Comments/ShowComment.hs +++ b/samples/Issues/Comments/ShowComment.hs @@ -11,5 +11,5 @@ main = do formatComment comment = (Github.githubOwnerLogin $ Github.issueCommentUser comment) ++ " commented " ++ - (show $ Github.fromGithubDate $ Github.issueCommentUpdatedAt comment) ++ + (show $ Github.fromDate $ Github.issueCommentUpdatedAt comment) ++ "\n" ++ (Github.issueCommentBody comment) diff --git a/samples/Issues/Comments/ShowComments.hs b/samples/Issues/Comments/ShowComments.hs index c8ee71bc..2b8466ed 100644 --- a/samples/Issues/Comments/ShowComments.hs +++ b/samples/Issues/Comments/ShowComments.hs @@ -13,5 +13,5 @@ main = do formatComment comment = (Github.githubOwnerLogin $ Github.issueCommentUser comment) ++ " commented " ++ - (show $ Github.fromGithubDate $ Github.issueCommentUpdatedAt comment) ++ + (show $ Github.fromDate $ Github.issueCommentUpdatedAt comment) ++ "\n" ++ (Github.issueCommentBody comment) diff --git a/samples/Issues/CreateIssue.hs b/samples/Issues/CreateIssue.hs index d1565a55..6d930c93 100644 --- a/samples/Issues/CreateIssue.hs +++ b/samples/Issues/CreateIssue.hs @@ -1,22 +1,53 @@ +{-# LANGUAGE LambdaCase #-} {-# LANGUAGE OverloadedStrings #-} -module CreateIssue where -import qualified Github.Issues as Github +import Data.String (fromString) +import qualified Data.Text as Text (unpack) +import qualified Data.Vector as Vector (fromList) +import qualified GitHub.Auth as GitHub +import qualified GitHub.Data.Issues as GitHub +import qualified GitHub.Endpoints.Issues as GitHub +import qualified GitHub.Request as GitHub +import System.Environment (lookupEnv) +import qualified System.Exit as Exit (die) + +self :: String +self = "github-create-issue" + +main :: IO () main = do - let auth = Github.GithubBasicAuth "user" "password" - newiss = (Github.newIssue "A new issue") { - Github.newIssueBody = Just "Issue description text goes here" + token <- lookupEnv "GITHUB_TOKEN" >>= \case + Nothing -> die "variable GITHUB_TOKEN not set" + Just token -> return $ fromString token + + let auth = GitHub.OAuth token + newiss = (GitHub.newIssue "A new issue") + { GitHub.newIssueBody = Just "Issue description text goes here" + , GitHub.newIssueLabels = Just $ Vector.fromList ["foo", "bar", "baz"] } - possibleIssue <- Github.createIssue auth "thoughtbot" "paperclip" newiss - putStrLn $ either (\e -> "Error: " ++ show e) - formatIssue - possibleIssue - -formatIssue issue = - (Github.githubOwnerLogin $ Github.issueUser issue) ++ - " opened this issue " ++ - (show $ Github.fromGithubDate $ Github.issueCreatedAt issue) ++ "\n" ++ - (Github.issueState issue) ++ " with " ++ - (show $ Github.issueComments issue) ++ " comments" ++ "\n\n" ++ - (Github.issueTitle issue) + request = GitHub.createIssueR "haskell-github" "playground" newiss + + GitHub.github auth request >>= \case + Left err -> die $ show err + Right issue -> putStrLn $ formatIssue issue + +die :: String -> IO a +die msg = Exit.die $ concat [ self, ": Error: ", msg ] + +formatIssue :: GitHub.Issue -> String +formatIssue issue = concat + [ formatUser issue + , " opened this issue " + , show $ GitHub.issueCreatedAt issue + , "\n" + , show $ GitHub.issueState issue + , " with " + , show $ GitHub.issueComments issue + , " comments\n\n" + , Text.unpack $ GitHub.issueTitle issue + ] + +formatUser :: GitHub.Issue -> String +formatUser issue = + Text.unpack . GitHub.untagName . GitHub.simpleUserLogin $ GitHub.issueUser issue diff --git a/samples/Issues/EditIssue.hs b/samples/Issues/EditIssue.hs index c6f6f019..01948992 100644 --- a/samples/Issues/EditIssue.hs +++ b/samples/Issues/EditIssue.hs @@ -1,10 +1,11 @@ {-# LANGUAGE OverloadedStrings #-} module EditIssue where +import qualified Github.Auth as Github import qualified Github.Issues as Github main = do - let auth = Github.GithubBasicAuth "user" "password" + let auth = Github.BasicAuth "user" "password" issueid = 3 edit = Github.editOfIssue { Github.editIssueState = Just "closed" } possibleIssue <- Github.editIssue auth "thoughtbot" "paperclip" issueid edit @@ -15,7 +16,7 @@ main = do formatIssue issue = (Github.githubOwnerLogin $ Github.issueUser issue) ++ " opened this issue " ++ - (show $ Github.fromGithubDate $ Github.issueCreatedAt issue) ++ "\n" ++ + (show $ Github.fromDate $ Github.issueCreatedAt issue) ++ "\n" ++ (Github.issueState issue) ++ " with " ++ (show $ Github.issueComments issue) ++ " comments" ++ "\n\n" ++ (Github.issueTitle issue) diff --git a/samples/Issues/Events/ShowEvent.hs b/samples/Issues/Events/ShowEvent.hs index 1c3d5a3c..bf7b1f1e 100644 --- a/samples/Issues/Events/ShowEvent.hs +++ b/samples/Issues/Events/ShowEvent.hs @@ -34,5 +34,5 @@ formatEvent event = formatEvent' event (Github.eventType event) "Issue assigned to " ++ loginName event ++ " on " ++ createdAt event loginName = Github.githubOwnerLogin . Github.eventActor -createdAt = show . Github.fromGithubDate . Github.eventCreatedAt +createdAt = show . Github.fromDate . Github.eventCreatedAt withCommitId event f = maybe "" f (Github.eventCommitId event) diff --git a/samples/Issues/Events/ShowIssueEvents.hs b/samples/Issues/Events/ShowIssueEvents.hs index dc8a56e9..f4553033 100644 --- a/samples/Issues/Events/ShowIssueEvents.hs +++ b/samples/Issues/Events/ShowIssueEvents.hs @@ -34,5 +34,5 @@ formatEvent event = formatEvent' event (Github.eventType event) "Issue assigned to " ++ loginName event ++ " on " ++ createdAt event loginName = Github.githubOwnerLogin . Github.eventActor -createdAt = show . Github.fromGithubDate . Github.eventCreatedAt +createdAt = show . Github.fromDate . Github.eventCreatedAt withCommitId event f = maybe "" f (Github.eventCommitId event) diff --git a/samples/Issues/Events/ShowRepoEvents.hs b/samples/Issues/Events/ShowRepoEvents.hs index df2a6ba0..fc2e66f8 100644 --- a/samples/Issues/Events/ShowRepoEvents.hs +++ b/samples/Issues/Events/ShowRepoEvents.hs @@ -36,6 +36,6 @@ formatEvent event = "assigned to " ++ loginName event ++ " on " ++ createdAt event loginName = Github.githubOwnerLogin . Github.eventActor -createdAt = show . Github.fromGithubDate . Github.eventCreatedAt +createdAt = show . Github.fromDate . Github.eventCreatedAt withCommitId event f = maybe "" f (Github.eventCommitId event) issueNumber = show . Github.issueNumber . fromJust . Github.eventIssue diff --git a/samples/Issues/IssueReport/Issues.hs b/samples/Issues/IssueReport/Issues.hs index 089a499f..da2fb1ba 100644 --- a/samples/Issues/IssueReport/Issues.hs +++ b/samples/Issues/IssueReport/Issues.hs @@ -1,15 +1,15 @@ {-# LANGUAGE OverloadedStrings #-} module Main where +import qualified Github.Auth as Github import qualified Github.Issues as Github -import qualified Data.ByteString as B import Report -- The example requires wl-pprint module "The Wadler/Leijen Pretty Printer" -import Text.PrettyPrint.Leijen +import Text.PrettyPrint.ANSI.Leijen -auth :: Maybe (B.ByteString, B.ByteString) -auth = Just ("yourgithub id", "somepassword") +auth :: Maybe Github.Auth +auth = Just $ Github.BasicAuth "yourgithub id" "somepassword" mkIssue :: ReportedIssue -> Doc mkIssue (Issue n t h) = hsep [ @@ -18,12 +18,12 @@ mkIssue (Issue n t h) = hsep [ fill 5 (text (show h))] vissues :: ([Doc], [Doc], [Doc]) -> Doc -vissues (x, y, z) = hsep [(vcat x), align (vcat y), align (vcat z)] +vissues (x, y, z) = hsep [(vcat x), align (vcat y), align (vcat z)] mkDoc :: Report -> Doc mkDoc (Report issues total) = vsep [ text "Report for the milestone", - (vsep . map mkIssue) issues, + (vsep . map mkIssue) issues, text ("Total hours : " ++ (show total) ++" hours") ] @@ -31,7 +31,7 @@ mkFullDoc :: [Github.Issue] -> Doc mkFullDoc = mkDoc . prepareReport -- The public repo is used as private are quite sensitive for this report --- +-- -- The main idea is to use labels like 1h, 2h etc for man-hour estimation of issues -- on private repos for development "on hire" -- @@ -43,4 +43,4 @@ main = do possibleIssues <- Github.issuesForRepo' auth "paulrzcz" "hquantlib" limitations case possibleIssues of (Left err) -> putStrLn $ "Error: " ++ show err - (Right issues) -> putDoc $ mkFullDoc issues + (Right issues) -> putDoc $ mkFullDoc issues diff --git a/samples/Issues/IssueReport/IssuesEnterprise.hs b/samples/Issues/IssueReport/IssuesEnterprise.hs new file mode 100644 index 00000000..7b2c2531 --- /dev/null +++ b/samples/Issues/IssueReport/IssuesEnterprise.hs @@ -0,0 +1,48 @@ +{-# LANGUAGE OverloadedStrings #-} +module Main where + +import qualified Github.Auth as Github +import qualified Github.Issues as Github +import Report + +-- The example requires wl-pprint module "The Wadler/Leijen Pretty Printer" +import Text.PrettyPrint.ANSI.Leijen + +auth :: Maybe Github.Auth +auth = Just $ Github.EnterpriseOAuth + "https://github.example.com/api" + "1a79a4d60de6718e8e5b326e338ae533" + +mkIssue :: ReportedIssue -> Doc +mkIssue (Issue n t h) = hsep [ + fill 5 (text ("#" ++ (show n))), + fill 50 (text t), + fill 5 (text (show h))] + +vissues :: ([Doc], [Doc], [Doc]) -> Doc +vissues (x, y, z) = hsep [(vcat x), align (vcat y), align (vcat z)] + +mkDoc :: Report -> Doc +mkDoc (Report issues total) = vsep [ + text "Report for the milestone", + (vsep . map mkIssue) issues, + text ("Total hours : " ++ (show total) ++" hours") + ] + +mkFullDoc :: [Github.Issue] -> Doc +mkFullDoc = mkDoc . prepareReport + +-- The public repo is used as private are quite sensitive for this report +-- +-- The main idea is to use labels like 1h, 2h etc for man-hour estimation of issues +-- on private repos for development "on hire" +-- +-- This tool is used to generate report on work done for the customer +-- +main :: IO () +main = do + let limitations = [Github.OnlyClosed, Github.MilestoneId 4] + possibleIssues <- Github.issuesForRepo' auth "paulrzcz" "hquantlib" limitations + case possibleIssues of + (Left err) -> putStrLn $ "Error: " ++ show err + (Right issues) -> putDoc $ mkFullDoc issues diff --git a/samples/Issues/IssueReport/Report.hs b/samples/Issues/IssueReport/Report.hs index 307bba95..76abe4f8 100644 --- a/samples/Issues/IssueReport/Report.hs +++ b/samples/Issues/IssueReport/Report.hs @@ -45,7 +45,7 @@ sumUp = foldl s 0.0 s z (Just x) = z+x toNames :: [Github.IssueLabel] -> [Maybe Double] -toNames = map (toValue . Github.labelName) +toNames = map (toValue . Github.labelName) isValue :: String -> Bool isValue label = (label =~ ("^[0-9]h" :: String)) :: Bool diff --git a/samples/Issues/Labels/CreateLabels.hs b/samples/Issues/Labels/CreateLabels.hs new file mode 100644 index 00000000..d68f6f31 --- /dev/null +++ b/samples/Issues/Labels/CreateLabels.hs @@ -0,0 +1,16 @@ +{-# LANGUAGE OverloadedStrings #-} +module CreateLabels where + +import Data.List (intercalate) +import qualified Github.Auth as Github +import qualified Github.Issues.Labels as Github +main = do + let auth = Github.BasicAuth "user" "password" + possibleLabel <- Github.createLabel auth "thoughtbot" "papperclip" "sample label" "ff00ff" + case possibleLabel of + (Left error) -> putStrLn $ "Error: " ++ show error + (Right label) -> putStrLn . formatLabel $ label + +formatLabel label = Github.labelName label ++ + ", colored " ++ + Github.labelColor label diff --git a/samples/Issues/Labels/ShowRepoLabels.hs b/samples/Issues/Labels/ShowRepoLabels.hs index 1c96d399..ae574283 100644 --- a/samples/Issues/Labels/ShowRepoLabels.hs +++ b/samples/Issues/Labels/ShowRepoLabels.hs @@ -1,7 +1,7 @@ module ShowRepoLabels where +import Data.List (intercalate) import qualified Github.Issues.Labels as Github -import Data.List (intercalate) main = do possibleLabels <- Github.labelsOnRepo "thoughtbot" "paperclip" diff --git a/samples/Issues/Milestones/ShowMilestone.hs b/samples/Issues/Milestones/ShowMilestone.hs index d49a4279..b2a3cf0a 100644 --- a/samples/Issues/Milestones/ShowMilestone.hs +++ b/samples/Issues/Milestones/ShowMilestone.hs @@ -20,5 +20,5 @@ formatDueOn Nothing = "" formatDueOn (Just milestoneDate) = ", is due on " ++ dueOn milestoneDate loginName = Github.githubOwnerLogin . Github.milestoneCreator -createdAt = show . Github.fromGithubDate . Github.milestoneCreatedAt -dueOn = show . Github.fromGithubDate +createdAt = show . Github.fromDate . Github.milestoneCreatedAt +dueOn = show . Github.fromDate diff --git a/samples/Issues/Milestones/ShowMilestones.hs b/samples/Issues/Milestones/ShowMilestones.hs index 45163f04..5b109626 100644 --- a/samples/Issues/Milestones/ShowMilestones.hs +++ b/samples/Issues/Milestones/ShowMilestones.hs @@ -20,5 +20,5 @@ formatDueOn Nothing = "" formatDueOn (Just milestoneDate) = ", is due on " ++ dueOn milestoneDate loginName = Github.githubOwnerLogin . Github.milestoneCreator -createdAt = show . Github.fromGithubDate . Github.milestoneCreatedAt -dueOn = show . Github.fromGithubDate +createdAt = show . Github.fromDate . Github.milestoneCreatedAt +dueOn = show . Github.fromDate diff --git a/samples/Issues/ShowIssue.hs b/samples/Issues/ShowIssue.hs index 981e6dca..804742ef 100644 --- a/samples/Issues/ShowIssue.hs +++ b/samples/Issues/ShowIssue.hs @@ -11,7 +11,7 @@ main = do formatIssue issue = (Github.githubOwnerLogin $ Github.issueUser issue) ++ " opened this issue " ++ - (show $ Github.fromGithubDate $ Github.issueCreatedAt issue) ++ "\n" ++ + (show $ Github.fromDate $ Github.issueCreatedAt issue) ++ "\n" ++ (Github.issueState issue) ++ " with " ++ (show $ Github.issueComments issue) ++ " comments" ++ "\n\n" ++ (Github.issueTitle issue) diff --git a/samples/Issues/ShowRepoIssues.hs b/samples/Issues/ShowRepoIssues.hs index f55044fe..5f54026b 100644 --- a/samples/Issues/ShowRepoIssues.hs +++ b/samples/Issues/ShowRepoIssues.hs @@ -1,21 +1,42 @@ -module ShowRepoIssue where +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE OverloadedStrings #-} -import qualified Github.Issues as Github -import Data.List (intercalate) +import Data.Foldable (toList) +import Data.List (intercalate) +import Data.Vector (Vector) +import qualified GitHub as Github + +main :: IO () main = do - let limitations = [Github.OnlyClosed, Github.Mentions "mike-burns", Github.AssignedTo "jyurek"] - possibleIssues <- Github.issuesForRepo "thoughtbot" "paperclip" limitations - case possibleIssues of - (Left error) -> putStrLn $ "Error: " ++ show error - (Right issues) -> - putStrLn $ intercalate "\n\n" $ map formatIssue issues - -formatIssue issue = - (Github.githubOwnerLogin $ Github.issueUser issue) ++ - " opened this issue " ++ - (show $ Github.fromGithubDate $ Github.issueCreatedAt issue) ++ "\n" ++ - (Github.issueState issue) ++ " with " ++ - (show $ Github.issueComments issue) ++ " comments" ++ "\n\n" ++ - (Github.issueTitle issue) + let filt = Github.stateClosed <> Github.optionsMentioned "mike-burns" <> Github.optionsAssignee "jyurek" + printIssues =<< do + Github.github' $ Github.issuesForRepoR "thoughtbot" "paperclip" filt Github.FetchAll + + printIssues =<< do + Github.github' $ Github.issuesForRepoR "haskell-github" "playground" Github.stateClosed Github.FetchAll + +printIssues :: Either Github.Error (Vector Github.Issue) -> IO () +printIssues = \case + Left err -> + putStrLn $ "Error: " ++ show err + Right issues -> + putStrLn $ intercalate "\n\n" $ map formatIssue $ toList issues + +formatIssue :: Github.Issue -> String +formatIssue issue = concat + + [ show $ Github.simpleUserLogin $ Github.issueUser issue + , " opened this issue " + , show $ Github.issueCreatedAt issue + , ".\n" + + , "It is currently " + , show $ Github.issueState issue + , maybe "" (\ r -> " with reason " ++ show r) $ Github.issueStateReason issue + , " with " + , show $ Github.issueComments issue + , " comments.\n\n" + , show $ Github.issueTitle issue + ] diff --git a/samples/LICENSE b/samples/LICENSE new file mode 120000 index 00000000..ea5b6064 --- /dev/null +++ b/samples/LICENSE @@ -0,0 +1 @@ +../LICENSE \ No newline at end of file diff --git a/samples/Operational/Operational.hs b/samples/Operational/Operational.hs new file mode 100644 index 00000000..1fc7f897 --- /dev/null +++ b/samples/Operational/Operational.hs @@ -0,0 +1,53 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE OverloadedStrings #-} + +module Main (main) where + +import Common +import Prelude () + +import Control.Exception (throw) +import Control.Monad.IO.Class (liftIO) +import Control.Monad.Operational (Program, ProgramViewT (..), singleton, view) +import Control.Monad.Trans.Except (ExceptT (..), runExceptT) +import Network.HTTP.Client (Manager, newManager, responseBody) + +import qualified GitHub as GH + +data R a where + R :: FromJSON a => GH.Request 'GH.RA a -> R a + +type GithubMonad a = Program R a + +runMonad :: GH.AuthMethod auth => Manager -> auth -> GithubMonad a -> ExceptT GH.Error IO a +runMonad mgr auth m = case view m of + Return a -> return a + R req :>>= k -> do + res <- ExceptT $ GH.executeRequestWithMgrAndRes mgr auth req + liftIO $ print $ GH.limitsFromHttpResponse res + runMonad mgr auth (k (responseBody res)) + +githubRequest :: FromJSON a => GH.Request 'GH.RA a -> GithubMonad a +githubRequest = singleton . R + +main :: IO () +main = GH.withOpenSSL $ do + manager <- newManager GH.tlsManagerSettings + auth' <- getAuth + case auth' of + Nothing -> do + (owner, rl) <- runExceptT (runMonad manager () script) >>= either throw return + print owner + print rl + Just auth -> do + (owner, rl) <- runExceptT (runMonad manager auth script) >>= either throw return + print owner + print rl + +script :: Program R (GH.Owner, GH.Limits) +script = do + repo <- githubRequest $ GH.repositoryR "haskell-github" "github" + owner <- githubRequest $ GH.ownerInfoForR (GH.simpleOwnerLogin . GH.repoOwner $ repo) + rl <- githubRequest GH.rateLimitR + return (owner, GH.rateLimitCore rl) diff --git a/samples/Organizations/Teams/CreateTeamFor.hs b/samples/Organizations/Teams/CreateTeamFor.hs new file mode 100644 index 00000000..df270bce --- /dev/null +++ b/samples/Organizations/Teams/CreateTeamFor.hs @@ -0,0 +1,21 @@ +{-# LANGUAGE OverloadedStrings #-} + +module CreateTeamFor where + +import qualified Github.Auth as Github +import qualified Github.Teams as Github +import System.Environment (getArgs) + +main = do + args <- getArgs + result <- case args of + [token, org, team, desc, repos] -> + Github.createTeamFor' + (Github.OAuth token) + org + (Github.CreateTeam team (Just desc) (read repos :: [String]) Github.PrivacyClosed Github.PermissionPull) + _ -> + error "usage: CreateTeamFor <[\"repos\"]>" + case result of + Left err -> putStrLn $ "Error: " ++ show err + Right team -> putStrLn $ show team diff --git a/samples/Organizations/Teams/ListTeamsForOrganization.hs b/samples/Organizations/Teams/ListTeamsForOrganization.hs new file mode 100644 index 00000000..52331e82 --- /dev/null +++ b/samples/Organizations/Teams/ListTeamsForOrganization.hs @@ -0,0 +1,17 @@ +{-# LANGUAGE OverloadedStrings #-} + +module ListTeamsForOrganization where + +import qualified Github.Auth as Github +import qualified Github.Organizations.Teams as Github +import System.Environment (getArgs) + +main = do + args <- getArgs + result <- case args of + [team, token] -> Github.teamsOf' (Just $ Github.OAuth token) team + [team] -> Github.teamsOf team + _ -> error "usage: ListTeamsForOrganization [auth token]" + case result of + Left err -> putStrLn $ "Error: " ++ show err + Right teams -> mapM_ (putStrLn . show) teams diff --git a/samples/Organizations/Teams/skipped-for-now b/samples/Organizations/Teams/skipped-for-now deleted file mode 100644 index 10a9e1d5..00000000 --- a/samples/Organizations/Teams/skipped-for-now +++ /dev/null @@ -1,2 +0,0 @@ -I can't get all the API calls to work properly on this page from curl so I'm -skipping for now: http://developer.github.com/v3/orgs/teams/ diff --git a/samples/Pulls/Comments/ListComments.hs b/samples/Pulls/Comments/ListComments.hs new file mode 100644 index 00000000..60ae4a07 --- /dev/null +++ b/samples/Pulls/Comments/ListComments.hs @@ -0,0 +1,29 @@ +{-# LANGUAGE OverloadedStrings #-} +module ListComments where + +import qualified GitHub.Endpoints.PullRequests.Comments as GitHub +import GitHub.Data.Id (Id(Id)) +import Data.Monoid ((<>)) +import Data.Text (Text, unpack, pack) +import Data.Time.Format + +main :: IO () +main = do + possiblePullRequestComments <- GitHub.pullRequestCommentsIO "thoughtbot" "factory_girl" (Id 256) + case possiblePullRequestComments of + (Left err) -> putStrLn $ "Error: " <> show err + (Right comments) -> putStrLn . unpack $ foldr (\a b -> a <> "\n\n" <> b) "" (formatComment <$> comments) + +formatComment :: GitHub.Comment -> Text +formatComment comment = + "Author: " <> formatAuthor (GitHub.commentUser comment) <> + "\nUpdated: " <> pack (formatTime' (GitHub.commentUpdatedAt comment)) <> + (maybe "" (\u -> "\nURL: " <> GitHub.getUrl u) $ GitHub.commentHtmlUrl comment) <> + "\n\n" <> GitHub.commentBody comment + +formatAuthor :: GitHub.SimpleUser -> Text +formatAuthor user = + GitHub.untagName (GitHub.simpleUserLogin user) <> " (" <> GitHub.getUrl (GitHub.simpleUserUrl user) <> ")" + +formatTime' :: (FormatTime t) => t -> String +formatTime' = formatTime defaultTimeLocale "%T, %F (%Z)" diff --git a/samples/Pulls/Comments/ShowComment.hs b/samples/Pulls/Comments/ShowComment.hs new file mode 100644 index 00000000..a0c2a2ba --- /dev/null +++ b/samples/Pulls/Comments/ShowComment.hs @@ -0,0 +1,29 @@ +{-# LANGUAGE OverloadedStrings #-} +module ShowComment where + +import qualified GitHub.Endpoints.PullRequests.Comments as GitHub +import GitHub.Data.Id (Id(Id)) +import Data.Monoid ((<>)) +import Data.Text (Text, unpack, pack) +import Data.Time.Format + +main :: IO () +main = do + possiblePullRequestComment <- GitHub.pullRequestComment "thoughtbot" "factory_girl" (Id 301819) + case possiblePullRequestComment of + (Left err) -> putStrLn $ "Error: " <> show err + (Right comment) -> putStrLn . unpack $ formatComment comment + +formatComment :: GitHub.Comment -> Text +formatComment comment = + "Author: " <> formatAuthor (GitHub.commentUser comment) <> + "\nUpdated: " <> pack (formatTime' (GitHub.commentUpdatedAt comment)) <> + (maybe "" (\u -> "\nURL: " <> GitHub.getUrl u) $ GitHub.commentHtmlUrl comment) <> + "\n\n" <> GitHub.commentBody comment + +formatAuthor :: GitHub.SimpleUser -> Text +formatAuthor user = + GitHub.untagName (GitHub.simpleUserLogin user) <> " (" <> GitHub.getUrl (GitHub.simpleUserUrl user) <> ")" + +formatTime' :: (FormatTime t) => t -> String +formatTime' = formatTime defaultTimeLocale "%T, %F (%Z)" diff --git a/samples/Pulls/IsMergedPull.hs b/samples/Pulls/IsMergedPull.hs new file mode 100644 index 00000000..8e772f17 --- /dev/null +++ b/samples/Pulls/IsMergedPull.hs @@ -0,0 +1,11 @@ +module CheckIfPullMerged where + +import qualified Github.PullRequests as Github +import Github.Auth + +main :: IO () +main = do + mergeResult <- Github.isPullRequestMerged (OAuth "authtoken") "thoughtbot" "paperclip" 575 + case mergeResult of + (Left err) -> putStrLn $ "Error: " ++ (show err) + (Right stat) -> putStrLn $ (show stat) diff --git a/samples/Pulls/ListPulls.hs b/samples/Pulls/ListPulls.hs index 58b9adce..747afb00 100644 --- a/samples/Pulls/ListPulls.hs +++ b/samples/Pulls/ListPulls.hs @@ -15,9 +15,9 @@ formatPullRequest pullRequest = (take 80 $ Github.pullRequestBody pullRequest) ++ "\n" ++ (Github.githubOwnerLogin $ Github.pullRequestUser pullRequest) ++ " submitted to thoughtbot/paperclip " ++ - (formatGithubDate $ Github.pullRequestCreatedAt pullRequest) ++ + (formatDate $ Github.pullRequestCreatedAt pullRequest) ++ " updated " ++ - (formatGithubDate $ Github.pullRequestUpdatedAt pullRequest) ++ "\n" ++ + (formatDate $ Github.pullRequestUpdatedAt pullRequest) ++ "\n" ++ (Github.pullRequestHtmlUrl pullRequest) -formatGithubDate = show . Github.fromGithubDate +formatDate = show . Github.fromDate diff --git a/samples/Pulls/MergePull.hs b/samples/Pulls/MergePull.hs new file mode 100644 index 00000000..c67902c2 --- /dev/null +++ b/samples/Pulls/MergePull.hs @@ -0,0 +1,11 @@ +module MergePullRequest where + +import qualified Github.PullRequests as Github +import Github.Auth + +main :: IO () +main = do + mergeResult <- Github.mergePullRequest (OAuth "authtoken") "thoughtbot" "paperclip" 575 (Just "Merge message") + case mergeResult of + (Left err) -> putStrLn $ "Error: " ++ (show err) + (Right stat) -> putStrLn $ (show stat) diff --git a/samples/Pulls/ReviewComments/ListComments.hs b/samples/Pulls/ReviewComments/ListComments.hs deleted file mode 100644 index 11e9b1b9..00000000 --- a/samples/Pulls/ReviewComments/ListComments.hs +++ /dev/null @@ -1,21 +0,0 @@ -module ListComments where - -import qualified Github.PullRequests.ReviewComments as Github -import Data.List - -main = do - possiblePullRequestComments <- Github.pullRequestReviewComments "thoughtbot" "factory_girl" 256 - case possiblePullRequestComments of - (Left error) -> putStrLn $ "Error: " ++ (show error) - (Right comments) -> putStrLn $ intercalate "\n\n" $ map formatComment comments - -formatComment :: Github.Comment -> String -formatComment comment = - "Author: " ++ (formatAuthor $ Github.commentUser comment) ++ - "\nUpdated: " ++ (show $ Github.commentUpdatedAt comment) ++ - (maybe "" ("\nURL: "++) $ Github.commentHtmlUrl comment) ++ - "\n\n" ++ (Github.commentBody comment) - -formatAuthor :: Github.GithubOwner -> String -formatAuthor user = - (Github.githubOwnerLogin user) ++ " (" ++ (Github.githubOwnerUrl user) ++ ")" diff --git a/samples/Pulls/ReviewComments/ShowComment.hs b/samples/Pulls/ReviewComments/ShowComment.hs deleted file mode 100644 index 57c5fe21..00000000 --- a/samples/Pulls/ReviewComments/ShowComment.hs +++ /dev/null @@ -1,22 +0,0 @@ -module ShowComments where - -import qualified Github.PullRequests.ReviewComments as Github -import Data.List - -main = do - possiblePullRequestComment <- Github.pullRequestReviewComment "thoughtbot" "factory_girl" 301819 - case possiblePullRequestComment of - (Left error) -> putStrLn $ "Error: " ++ (show error) - (Right comment) -> putStrLn $ formatComment comment - -formatComment :: Github.Comment -> String -formatComment comment = - "Author: " ++ (formatAuthor $ Github.commentUser comment) ++ - "\nUpdated: " ++ (show $ Github.commentUpdatedAt comment) ++ - (maybe "" ("\nURL: "++) $ Github.commentHtmlUrl comment) ++ - "\n\n" ++ (Github.commentBody comment) - -formatAuthor :: Github.GithubOwner -> String -formatAuthor user = - (Github.githubOwnerLogin user) ++ " (" ++ (Github.githubOwnerUrl user) ++ ")" - diff --git a/samples/Pulls/ShowPull.hs b/samples/Pulls/ShowPull.hs index 2388717a..f95a661c 100644 --- a/samples/Pulls/ShowPull.hs +++ b/samples/Pulls/ShowPull.hs @@ -12,7 +12,7 @@ main = do formatPullRequest p = (Github.githubOwnerLogin $ Github.detailedPullRequestUser p) ++ " opened this pull request " ++ - (formatGithubDate $ Github.detailedPullRequestCreatedAt p) ++ "\n" ++ + (formatDate $ Github.detailedPullRequestCreatedAt p) ++ "\n" ++ (Github.detailedPullRequestTitle p) ++ "\n" ++ (Github.detailedPullRequestBody p) ++ "\n" ++ (Github.detailedPullRequestState p) ++ "\n" ++ @@ -21,4 +21,4 @@ formatPullRequest p = (show $ Github.detailedPullRequestComments p) ++ " comments\n" ++ (Github.detailedPullRequestHtmlUrl p) -formatGithubDate = show . Github.fromGithubDate +formatDate = show . Github.fromDate diff --git a/samples/Pulls/UpdatePull.hs b/samples/Pulls/UpdatePull.hs new file mode 100644 index 00000000..2c36021a --- /dev/null +++ b/samples/Pulls/UpdatePull.hs @@ -0,0 +1,18 @@ +module MergePullRequest where + +import qualified Github.PullRequests as Github +import Github.Auth +import Github.Data + +main :: IO () +main = do + mergeResult <- Github.updatePullRequest (OAuth "authtoken") "repoOwner" "repoName" 22 EditPullRequest + { editPullRequestTitle = Just "Brand new title" + , editPullRequestBody = Nothing + , editPullRequestState = Just EditPullRequestStateClosed + , editPullRequestBase = Nothing + , editPullRequestMaintainerCanModify = Just True + } + case mergeResult of + (Left err) -> putStrLn $ "Error: " ++ (show err) + (Right dpr) -> putStrLn . show $ dpr diff --git a/samples/RateLimit.hs b/samples/RateLimit.hs new file mode 100644 index 00000000..399fd925 --- /dev/null +++ b/samples/RateLimit.hs @@ -0,0 +1,7 @@ +module RateLimit where + +import qualified Github.RateLimit as Github + +main = do + x <- Github.rateLimit + print x diff --git a/samples/Repos/Collaborators/IsCollaborator.hs b/samples/Repos/Collaborators/IsCollaborator.hs index 865744d8..1b891c55 100644 --- a/samples/Repos/Collaborators/IsCollaborator.hs +++ b/samples/Repos/Collaborators/IsCollaborator.hs @@ -5,7 +5,7 @@ import Data.List main = do let userName = "ubuwaits" - possiblyIsCollaborator <- Github.isCollaboratorOn userName "thoughtbot" "paperclip" + possiblyIsCollaborator <- Github.isCollaboratorOn Nothing userName "thoughtbot" "paperclip" case possiblyIsCollaborator of (Left error) -> putStrLn $ "Error: " ++ (show error) (Right True) -> diff --git a/samples/Repos/Collaborators/ListCollaborators.hs b/samples/Repos/Collaborators/ListCollaborators.hs index 6a579fbd..7bba7952 100644 --- a/samples/Repos/Collaborators/ListCollaborators.hs +++ b/samples/Repos/Collaborators/ListCollaborators.hs @@ -10,6 +10,6 @@ main = do (Right collaborators) -> putStrLn $ intercalate "\n" $ map formatAuthor collaborators -formatAuthor :: Github.GithubOwner -> String +formatAuthor :: Github.Owner -> String formatAuthor user = (Github.githubOwnerLogin user) ++ " (" ++ (Github.githubOwnerUrl user) ++ ")" diff --git a/samples/Repos/Commits/CommitComment.hs b/samples/Repos/Commits/CommitComment.hs index 890be574..8b542fe5 100644 --- a/samples/Repos/Commits/CommitComment.hs +++ b/samples/Repos/Commits/CommitComment.hs @@ -16,6 +16,6 @@ formatComment comment = (maybe "" ("\nURL: "++) $ Github.commentHtmlUrl comment) ++ "\n\n" ++ (Github.commentBody comment) -formatAuthor :: Github.GithubOwner -> String +formatAuthor :: Github.Owner -> String formatAuthor user = (Github.githubOwnerLogin user) ++ " (" ++ (Github.githubOwnerUrl user) ++ ")" diff --git a/samples/Repos/Commits/CommitComments.hs b/samples/Repos/Commits/CommitComments.hs index c0141a7f..fbf39607 100644 --- a/samples/Repos/Commits/CommitComments.hs +++ b/samples/Repos/Commits/CommitComments.hs @@ -17,6 +17,6 @@ formatComment comment = (maybe "" ("\nURL: "++) $ Github.commentHtmlUrl comment) ++ "\n\n" ++ (Github.commentBody comment) -formatAuthor :: Github.GithubOwner -> String +formatAuthor :: Github.Owner -> String formatAuthor user = (Github.githubOwnerLogin user) ++ " (" ++ (Github.githubOwnerUrl user) ++ ")" diff --git a/samples/Repos/Commits/GitDiff.hs b/samples/Repos/Commits/GitDiff.hs index 55d5a08f..c671b391 100644 --- a/samples/Repos/Commits/GitDiff.hs +++ b/samples/Repos/Commits/GitDiff.hs @@ -1,13 +1,22 @@ -module GitDiff where +{-# LANGUAGE NoImplicitPrelude #-} +{-# LANGUAGE OverloadedStrings #-} -import qualified Github.Repos.Commits as Github -import Data.List +module Main where +import Common +import qualified GitHub.Endpoints.Repos.Commits as Github +import qualified Data.Text.IO as Text + +main :: IO () main = do possibleDiff <- Github.diff "thoughtbot" "paperclip" "41f685f6e01396936bb8cd98e7cca517e2c7d96b" "HEAD" - either (\error -> putStrLn $ "Error: " ++ (show error)) - (putStrLn . showDiff) - possibleDiff + either (fail . show) (Text.putStrLn . showDiff) possibleDiff + + -- Check special case: when a file only changes file permissions in the commits, GitHub returns a null "sha" field for that file. + -- See https://github.com/scott-fleischman/repo-change-file-permission + diffFillNullSha <- Github.diff "scott-fleischman" "repo-change-file-permission" "80fdf8f83fcd8181411919fbf47394b878c591a0" "77a95bbebeb78f4fb25c6a10c3c940b6fe1caa27" + either (fail . show) (const $ Text.putStrLn "Successfully parsed diff with a file with a null sha") diffFillNullSha -showDiff diff = - intercalate "\n\n" $ map Github.filePatch $ Github.diffFiles diff + where + showDiff diff = + foldl (\x y -> x <> "\n\n" <> y) "" $ concatMap (maybe [] pure . Github.filePatch) $ Github.diffFiles diff diff --git a/samples/Repos/Commits/GitLog.hs b/samples/Repos/Commits/GitLog.hs index ba4fd241..c244458f 100644 --- a/samples/Repos/Commits/GitLog.hs +++ b/samples/Repos/Commits/GitLog.hs @@ -13,7 +13,7 @@ formatCommit :: Github.Commit -> String formatCommit commit = "commit " ++ (Github.commitSha commit) ++ "\nAuthor: " ++ (formatAuthor author) ++ - "\nDate: " ++ (show $ Github.fromGithubDate $ Github.gitUserDate author) ++ + "\nDate: " ++ (show $ Github.fromDate $ Github.gitUserDate author) ++ "\n\n\t" ++ (Github.gitCommitMessage gitCommit) where author = Github.gitCommitAuthor gitCommit gitCommit = Github.commitGitCommit commit diff --git a/samples/Repos/Commits/GitShow.hs b/samples/Repos/Commits/GitShow.hs index 83bd1b14..9b5ab8a2 100644 --- a/samples/Repos/Commits/GitShow.hs +++ b/samples/Repos/Commits/GitShow.hs @@ -13,12 +13,12 @@ formatCommit :: Github.Commit -> String formatCommit commit = "commit " ++ (Github.commitSha commit) ++ "\nAuthor: " ++ (formatAuthor author) ++ - "\nDate: " ++ (show $ Github.fromGithubDate $ Github.gitUserDate author) ++ + "\nDate: " ++ (show $ Github.fromDate $ Github.gitUserDate author) ++ "\n\n\t" ++ (Github.gitCommitMessage gitCommit) ++ "\n" ++ patches where author = Github.gitCommitAuthor gitCommit gitCommit = Github.commitGitCommit commit - patches = + patches = intercalate "\n" $ map Github.filePatch $ Github.commitFiles commit formatAuthor :: Github.GitUser -> String diff --git a/samples/Repos/Commits/RepoComments.hs b/samples/Repos/Commits/RepoComments.hs index 1698100c..c885942a 100644 --- a/samples/Repos/Commits/RepoComments.hs +++ b/samples/Repos/Commits/RepoComments.hs @@ -17,6 +17,6 @@ formatComment comment = (maybe "" ("\nURL: "++) $ Github.commentHtmlUrl comment) ++ "\n\n" ++ (Github.commentBody comment) -formatAuthor :: Github.GithubOwner -> String +formatAuthor :: Github.Owner -> String formatAuthor user = (Github.githubOwnerLogin user) ++ " (" ++ (Github.githubOwnerUrl user) ++ ")" diff --git a/samples/Repos/Contents.hs b/samples/Repos/Contents.hs new file mode 100644 index 00000000..3132c6f5 --- /dev/null +++ b/samples/Repos/Contents.hs @@ -0,0 +1,116 @@ +{-# LANGUAGE NoImplicitPrelude #-} +{-# LANGUAGE OverloadedStrings #-} + +module Main where + +import Common hiding + (getContents, intercalate, take, truncate, unlines) +import qualified Data.ByteString.Base64 as Base64 +import Data.Text + (Text, intercalate, take, unlines) +import Data.Text.Encoding (decodeUtf8, encodeUtf8) +import Data.Text.IO (putStrLn) +import qualified Data.Vector as Vector +import qualified GitHub.Data as GitHub +import qualified GitHub.Endpoints.Repos.Contents as GitHub + +main :: IO () +main = do + putStrLn "Root" + putStrLn "====" + getContents "" + + putStrLn "LICENSE" + putStrLn "=======" + getContents "LICENSE" + + createUpdateDeleteSampleFile + +getContents :: Text -> IO () +getContents path = do + contents <- GitHub.contentsFor "mike-burns" "ohlaunch" path Nothing + putStrLn $ either (("Error: " <>) . tshow) formatContents contents + +formatContents :: GitHub.Content -> Text +formatContents (GitHub.ContentFile fileData) = + formatContentInfo (GitHub.contentFileInfo fileData) <> + unlines + [ tshow (GitHub.contentFileSize fileData) <> " bytes" + , "encoding: " <> GitHub.contentFileEncoding fileData + , "data: " <> truncate (GitHub.contentFileContent fileData) + ] + +formatContents (GitHub.ContentDirectory items) = + intercalate "\n\n" . map formatItem . Vector.toList $ items + +formatContentInfo :: GitHub.ContentInfo -> Text +formatContentInfo contentInfo = + unlines + [ "name: " <> GitHub.contentName contentInfo + , "path: " <> GitHub.contentPath contentInfo + , "sha: " <> GitHub.contentSha contentInfo + , "url: " <> (GitHub.getUrl . GitHub.contentUrl) contentInfo + , "git url: " <> (GitHub.getUrl . GitHub.contentGitUrl) contentInfo + , "html url: " <> (GitHub.getUrl . GitHub.contentHtmlUrl) contentInfo + ] + +formatItem :: GitHub.ContentItem -> Text +formatItem item = + "type: " <> tshow (GitHub.contentItemType item) <> "\n" <> + formatContentInfo (GitHub.contentItemInfo item) + +truncate :: Text -> Text +truncate str = take 40 str <> "... (truncated)" + +createUpdateDeleteSampleFile :: IO () +createUpdateDeleteSampleFile = do + let + auth = GitHub.OAuth "oauthtoken" + owner = "repoOwner" + repo = "repoName" + author = GitHub.Author + { GitHub.authorName = "John Doe" + , GitHub.authorEmail = "johndoe@example.com" + } + defaultBranch = Nothing + base64Encode = decodeUtf8 . Base64.encode . encodeUtf8 + createResult <- failOnError $ GitHub.createFile auth owner repo + GitHub.CreateFile + { GitHub.createFilePath = "sample.txt" + , GitHub.createFileMessage = "Add sample.txt" + , GitHub.createFileContent = base64Encode "Hello" + , GitHub.createFileBranch = defaultBranch + , GitHub.createFileAuthor = Just author + , GitHub.createFileCommitter = Just author + } + + let getResultSHA = GitHub.contentSha . GitHub.contentResultInfo . GitHub.contentResultContent + let createFileSHA = getResultSHA createResult + updateResult <- failOnError $ GitHub.updateFile auth owner repo + GitHub.UpdateFile + { GitHub.updateFilePath = "sample.txt" + , GitHub.updateFileMessage = "Update sample.txt" + , GitHub.updateFileContent = base64Encode "Hello world!" + , GitHub.updateFileSHA = createFileSHA + , GitHub.updateFileBranch = defaultBranch + , GitHub.updateFileAuthor = Just author + , GitHub.updateFileCommitter = Just author + } + + let updateFileSHA = getResultSHA updateResult + failOnError $ GitHub.deleteFile auth owner repo + GitHub.DeleteFile + { GitHub.deleteFilePath = "sample.txt" + , GitHub.deleteFileMessage = "Delete sample.txt" + , GitHub.deleteFileSHA = updateFileSHA + , GitHub.deleteFileBranch = defaultBranch + , GitHub.deleteFileAuthor = Just author + , GitHub.deleteFileCommitter = Just author + } + +failOnError :: IO (Either GitHub.Error a) -> IO a +failOnError c = c >>= go + where + go r = case r of + Left err -> fail . show $ err + Right x -> return x diff --git a/samples/Repos/DeployKeys/CreateDeployKey.hs b/samples/Repos/DeployKeys/CreateDeployKey.hs new file mode 100644 index 00000000..953e299a --- /dev/null +++ b/samples/Repos/DeployKeys/CreateDeployKey.hs @@ -0,0 +1,19 @@ +{-# LANGUAGE OverloadedStrings #-} +module Main (main) where + +import qualified GitHub as GH +import Data.Text (Text) + +main :: IO () +main = do + let auth = GH.OAuth "auth_token" + eDeployKey <- GH.github auth GH.createRepoDeployKeyR "your_owner" "your_repo" newDeployKey + case eDeployKey of + Left err -> putStrLn $ "Error: " ++ show err + Right deployKey -> print deployKey + +newDeployKey :: GH.NewRepoDeployKey +newDeployKey = GH.NewRepoDeployKey publicKey "test-key" True + where + publicKey :: Text + publicKey = "your_public_key" diff --git a/samples/Repos/DeployKeys/DeleteDeployKey.hs b/samples/Repos/DeployKeys/DeleteDeployKey.hs new file mode 100644 index 00000000..5ec89733 --- /dev/null +++ b/samples/Repos/DeployKeys/DeleteDeployKey.hs @@ -0,0 +1,14 @@ +{-# LANGUAGE OverloadedStrings #-} +module Main (main) where + +import GitHub.Data.Id (Id (..)) +import qualified GitHub.Endpoints.Repos.DeployKeys as DK +import qualified GitHub.Auth as Auth + +main :: IO () +main = do + let auth = Auth.OAuth "auth_token" + eDeployKey <- DK.deleteRepoDeployKey' auth "your_owner" "your_repo" (Id 18530161) + case eDeployKey of + (Left err) -> putStrLn $ "Error: " ++ (show err) + (Right _) -> putStrLn $ "Deleted deploy key!" diff --git a/samples/Repos/DeployKeys/ListDeployKeys.hs b/samples/Repos/DeployKeys/ListDeployKeys.hs new file mode 100644 index 00000000..070eb297 --- /dev/null +++ b/samples/Repos/DeployKeys/ListDeployKeys.hs @@ -0,0 +1,18 @@ +{-# LANGUAGE OverloadedStrings #-} +module Main (main) where + +import qualified GitHub as GH +import Data.List (intercalate) +import Data.Vector (toList) + +main :: IO () +main = do + let auth = GH.OAuth "auth_token" + eDeployKeys <- GH.github auth GH.deployKeysForR "your_owner" "your_repo" GH.FetchAll + case eDeployKeys of + Left err -> putStrLn $ "Error: " ++ show err + Right deployKeys -> putStrLn $ intercalate "\n" $ map formatRepoDeployKey (toList deployKeys) + +formatRepoDeployKey :: DK.RepoDeployKey -> String +formatRepoDeployKey = show + diff --git a/samples/Repos/DeployKeys/ShowDeployKey.hs b/samples/Repos/DeployKeys/ShowDeployKey.hs new file mode 100644 index 00000000..6df4d11c --- /dev/null +++ b/samples/Repos/DeployKeys/ShowDeployKey.hs @@ -0,0 +1,19 @@ +{-# LANGUAGE OverloadedStrings #-} +module Main (main) where + +import GitHub.Data.Id (Id (..)) +import qualified GitHub.Data.DeployKeys as DK +import qualified GitHub.Endpoints.Repos.DeployKeys as DK +import qualified GitHub.Auth as Auth + +main :: IO () +main = do + let auth = Auth.OAuth "auth_token" + eDeployKey <- DK.deployKeyFor' auth "your_owner" "your_repo" (Id 18528451) + case eDeployKey of + (Left err) -> putStrLn $ "Error: " ++ (show err) + (Right deployKey) -> putStrLn $ formatRepoDeployKey deployKey + +formatRepoDeployKey :: DK.RepoDeployKey -> String +formatRepoDeployKey = show + diff --git a/samples/Repos/Forks/ListForks.hs b/samples/Repos/Forks/ListForks.hs index 6543844f..9b2c5a7c 100644 --- a/samples/Repos/Forks/ListForks.hs +++ b/samples/Repos/Forks/ListForks.hs @@ -12,7 +12,10 @@ main = do formatFork fork = (Github.githubOwnerLogin $ Github.repoOwner fork) ++ "\t" ++ (formatPushedAt $ Github.repoPushedAt fork) ++ "\n" ++ - (Github.repoCloneUrl fork) + (formatCloneUrl $ Github.repoCloneUrl fork) formatPushedAt Nothing = "" -formatPushedAt (Just pushedAt) = show $ Github.fromGithubDate pushedAt +formatPushedAt (Just pushedAt) = show $ Github.fromDate pushedAt + +formatCloneUrl Nothing = "" +formatCloneUrl (Just cloneUrl) = cloneUrl diff --git a/samples/Repos/GetReadme.hs b/samples/Repos/GetReadme.hs new file mode 100644 index 00000000..353e226a --- /dev/null +++ b/samples/Repos/GetReadme.hs @@ -0,0 +1,11 @@ +module GetReadme where + +import qualified Github.Repos as Github +import Data.List +import Data.Maybe + +main = do + possibleReadme <- Github.readmeFor "jwiegley" "github" + case possibleReadme of + (Left error) -> putStrLn $ "Error: " ++ (show error) + (Right (Github.ContentFile cd)) -> putStrLn $ (show cd) diff --git a/samples/Repos/ListOrgRepos.hs b/samples/Repos/ListOrgRepos.hs index 17793a06..970ea464 100644 --- a/samples/Repos/ListOrgRepos.hs +++ b/samples/Repos/ListOrgRepos.hs @@ -14,13 +14,14 @@ formatRepo repo = (Github.repoName repo) ++ "\t" ++ (fromMaybe "" $ Github.repoDescription repo) ++ "\n" ++ (Github.repoHtmlUrl repo) ++ "\n" ++ - (Github.repoCloneUrl repo) ++ "\t" ++ + (fromMaybe "" $ Github.repoCloneUrl repo) ++ "\t" ++ (formatDate $ Github.repoUpdatedAt repo) ++ "\n" ++ formatLanguage (Github.repoLanguage repo) ++ "watchers: " ++ (show $ Github.repoWatchers repo) ++ "\t" ++ "forks: " ++ (show $ Github.repoForks repo) -formatDate = show . Github.fromGithubDate +formatDate (Just date) = show . Github.fromDate $ date +formatDate Nothing = "????" formatLanguage (Just language) = "language: " ++ language ++ "\t" formatLanguage Nothing = "" diff --git a/samples/Repos/ListUserRepos.hs b/samples/Repos/ListUserRepos.hs index 09ab1d80..f80a4c9c 100644 --- a/samples/Repos/ListUserRepos.hs +++ b/samples/Repos/ListUserRepos.hs @@ -14,13 +14,14 @@ formatRepo repo = (Github.repoName repo) ++ "\t" ++ (fromMaybe "" $ Github.repoDescription repo) ++ "\n" ++ (Github.repoHtmlUrl repo) ++ "\n" ++ - (Github.repoCloneUrl repo) ++ "\t" ++ + (fromMaybe "" $ Github.repoCloneUrl repo) ++ "\t" ++ (formatDate $ Github.repoUpdatedAt repo) ++ "\n" ++ formatLanguage (Github.repoLanguage repo) ++ "watchers: " ++ (show $ Github.repoWatchers repo) ++ "\t" ++ "forks: " ++ (show $ Github.repoForks repo) -formatDate = show . Github.fromGithubDate +formatDate (Just date) = show . Github.fromDate $ date +formatDate Nothing = "" formatLanguage (Just language) = "language: " ++ language ++ "\t" formatLanguage Nothing = "" diff --git a/samples/Repos/ShowRepo.hs b/samples/Repos/ShowRepo.hs index 8274224b..ac72069a 100644 --- a/samples/Repos/ShowRepo.hs +++ b/samples/Repos/ShowRepo.hs @@ -5,22 +5,21 @@ import Data.List import Data.Maybe main = do - possibleRepo <- Github.userRepo "mike-burns" "trylambda" + possibleRepo <- Github.repository "mike-burns" "trylambda" case possibleRepo of - (Left error) -> putStrLn $ "Error: " ++ (show error) - (Right repo) -> putStrLn $ formatRepo repo + Left error -> putStrLn $ "Error: " ++ show error + Right repo -> putStrLn $ formatRepo repo -formatRepo repo = - (Github.repoName repo) ++ "\t" ++ - (fromMaybe "" $ Github.repoDescription repo) ++ "\n" ++ - (Github.repoHtmlUrl repo) ++ "\n" ++ - (Github.repoCloneUrl repo) ++ "\t" ++ - (formatDate $ Github.repoUpdatedAt repo) ++ "\n" ++ +formatRepo repo = Github.repoName repo ++ "\t" ++ + fromMaybe "" (Github.repoDescription repo) ++ "\n" ++ + Github.repoHtmlUrl repo ++ "\n" ++ + fromMaybe "" (Github.repoCloneUrl repo) ++ "\t" ++ + maybe "" formatDate (Github.repoUpdatedAt repo) ++ "\n" ++ formatLanguage (Github.repoLanguage repo) ++ - "watchers: " ++ (show $ Github.repoWatchers repo) ++ "\t" ++ - "forks: " ++ (show $ Github.repoForks repo) + "watchers: " ++ show (Github.repoWatchers repo) ++ "\t" ++ + "forks: " ++ show (Github.repoForks repo) -formatDate = show . Github.fromGithubDate +formatDate = show . Github.fromDate formatLanguage (Just language) = "language: " ++ language ++ "\t" formatLanguage Nothing = "" diff --git a/samples/Repos/Starring/ListStarred.hs b/samples/Repos/Starring/ListStarred.hs index fec084ac..d7516a81 100644 --- a/samples/Repos/Starring/ListStarred.hs +++ b/samples/Repos/Starring/ListStarred.hs @@ -14,11 +14,12 @@ formatRepo repo = (Github.repoName repo) ++ "\t" ++ (fromMaybe "" $ Github.repoDescription repo) ++ "\n" ++ (Github.repoHtmlUrl repo) ++ "\n" ++ - (Github.repoCloneUrl repo) ++ "\t" ++ + (fromMaybe "" $ Github.repoCloneUrl repo) ++ "\t" ++ (formatDate $ Github.repoUpdatedAt repo) ++ "\n" ++ formatLanguage (Github.repoLanguage repo) -formatDate = show . Github.fromGithubDate +formatDate (Just date) = show . Github.fromDate $ date +formatDate Nothing = "" formatLanguage (Just language) = "language: " ++ language ++ "\t" formatLanguage Nothing = "" diff --git a/samples/Repos/Watching/ListWatched.hs b/samples/Repos/Watching/ListWatched.hs index c2f1f8ba..8d12ff70 100644 --- a/samples/Repos/Watching/ListWatched.hs +++ b/samples/Repos/Watching/ListWatched.hs @@ -14,13 +14,14 @@ formatRepo repo = (Github.repoName repo) ++ "\t" ++ (fromMaybe "" $ Github.repoDescription repo) ++ "\n" ++ (Github.repoHtmlUrl repo) ++ "\n" ++ - (Github.repoCloneUrl repo) ++ "\t" ++ + (fromMaybe "" $ Github.repoCloneUrl repo) ++ "\t" ++ (formatDate $ Github.repoUpdatedAt repo) ++ "\n" ++ formatLanguage (Github.repoLanguage repo) ++ "watchers: " ++ (show $ Github.repoWatchers repo) ++ "\t" ++ "forks: " ++ (show $ Github.repoForks repo) -formatDate = show . Github.fromGithubDate +formatDate (Just date) = show . Github.fromDate $ date +formatDate Nothing = "" formatLanguage (Just language) = "language: " ++ language ++ "\t" formatLanguage Nothing = "" diff --git a/samples/Repos/Watching/ListWatchers.hs b/samples/Repos/Watching/ListWatchers.hs index fa869b86..bbc0d078 100644 --- a/samples/Repos/Watching/ListWatchers.hs +++ b/samples/Repos/Watching/ListWatchers.hs @@ -9,6 +9,6 @@ main = do (intercalate "\n" . map formatWatcher) possibleWatchers -formatWatcher :: Github.GithubOwner -> String +formatWatcher :: Github.Owner -> String formatWatcher user = (Github.githubOwnerLogin user) ++ " (" ++ (Github.githubOwnerUrl user) ++ ")" diff --git a/samples/Repos/Watching/Unwatch.hs b/samples/Repos/Watching/Unwatch.hs new file mode 100644 index 00000000..42dc28a8 --- /dev/null +++ b/samples/Repos/Watching/Unwatch.hs @@ -0,0 +1,17 @@ +{-# LANGUAGE OverloadedStrings #-} + +module Main where + +import qualified GitHub as GH +import qualified Data.Text as T +import qualified Data.Text.IO as T + +main :: IO () +main = do + let auth = GH.BasicAuth "" "" + owner = "haskell-github" + repo = "github" + result <- GH.github auth GH.unwatchRepoR (GH.mkOwnerName owner) (GH.mkRepoName repo) + case result of + Left err -> putStrLn $ "Error: " ++ show err + Right () -> T.putStrLn $ T.concat ["No longer watching: ", owner, "/", repo] diff --git a/samples/Repos/Webhooks/CreateWebhook.hs b/samples/Repos/Webhooks/CreateWebhook.hs new file mode 100644 index 00000000..dbfe62f9 --- /dev/null +++ b/samples/Repos/Webhooks/CreateWebhook.hs @@ -0,0 +1,24 @@ +module CreateWebhook where + +import Github.Repos.Webhooks +import qualified Github.Auth as Auth +import Github.Data.Definitions +import qualified Data.Map as M + +main :: IO () +main = do + let auth = Auth.OAuth "oauthtoken" + let config = M.fromList [("url", "https://foo3.io"), ("content_type", "application/json"), ("insecure_ssl", "1")] + let webhookDef = NewRepoWebhook { + newRepoWebhookName = "web", + newRepoWebhookConfig = config, + newRepoWebhookEvents = Just [WebhookWildcardEvent], + newRepoWebhookActive = Just True + } + newWebhook <- createRepoWebhook' auth "repoOwner" "repoName" webhookDef + case newWebhook of + (Left err) -> putStrLn $ "Error: " ++ (show err) + (Right webhook) -> putStrLn $ formatRepoWebhook webhook + +formatRepoWebhook :: RepoWebhook -> String +formatRepoWebhook (RepoWebhook _ _ _ name _ _ _ _ _ _) = show name diff --git a/samples/Repos/Webhooks/DeleteWebhook.hs b/samples/Repos/Webhooks/DeleteWebhook.hs new file mode 100644 index 00000000..67b9b8b7 --- /dev/null +++ b/samples/Repos/Webhooks/DeleteWebhook.hs @@ -0,0 +1,12 @@ +module DeleteWebhook where + +import Github.Repos.Webhooks +import qualified Github.Auth as Auth + +main :: IO () +main = do + let auth = Auth.OAuth "oauthtoken" + resp <- deleteRepoWebhook' auth "repoOwner" "repoName" 123 + case resp of + (Left err) -> putStrLn $ "Error: " ++ (show err) + (Right stat) -> putStrLn $ "Resp: " ++ (show stat) diff --git a/samples/Repos/Webhooks/EditWebhook.hs b/samples/Repos/Webhooks/EditWebhook.hs new file mode 100644 index 00000000..fceff2f2 --- /dev/null +++ b/samples/Repos/Webhooks/EditWebhook.hs @@ -0,0 +1,23 @@ +module EditWebhook where + +import Github.Repos.Webhooks +import qualified Github.Auth as Auth +import Github.Data.Definitions + +main :: IO () +main = do + let auth = Auth.OAuth "oauthtoken" + let editWebhookDef = EditRepoWebhook { + editRepoWebhookRemoveEvents = Just [WebhookWildcardEvent], + editRepoWebhookAddEvents = Just [WebhookCommitCommentEvent, WebhookGollumEvent], + editRepoWebhookConfig = Nothing, + editRepoWebhookEvents = Nothing, + editRepoWebhookActive = Just True + } + newWebhook <- editRepoWebhook' auth "repoOwner" "repoName" 123 editWebhookDef + case newWebhook of + (Left err) -> putStrLn $ "Error: " ++ (show err) + (Right webhook) -> putStrLn $ formatRepoWebhook webhook + +formatRepoWebhook :: RepoWebhook -> String +formatRepoWebhook (RepoWebhook _ _ _ name _ _ _ _ _ _) = show name diff --git a/samples/Repos/Webhooks/ListWebhook.hs b/samples/Repos/Webhooks/ListWebhook.hs new file mode 100644 index 00000000..2c66d449 --- /dev/null +++ b/samples/Repos/Webhooks/ListWebhook.hs @@ -0,0 +1,16 @@ +module ListWebhook where + +import qualified Github.Repos.Webhooks as W +import qualified Github.Auth as Auth +import qualified Github.Data.Definitions as Def + +main :: IO () +main = do + let auth = Auth.OAuth "oauthtoken" + possibleWebhook <- W.webhookFor' auth "repoOwner" "repoName" 123 + case possibleWebhook of + (Left err) -> putStrLn $ "Error: " ++ (show err) + (Right webhook) -> putStrLn $ formatRepoWebhook webhook + +formatRepoWebhook :: Def.RepoWebhook -> String +formatRepoWebhook (Def.RepoWebhook _ _ _ name _ _ _ _ _ _) = show name diff --git a/samples/Repos/Webhooks/ListWebhooks.hs b/samples/Repos/Webhooks/ListWebhooks.hs new file mode 100644 index 00000000..0da564c4 --- /dev/null +++ b/samples/Repos/Webhooks/ListWebhooks.hs @@ -0,0 +1,17 @@ +module ListWebhooks where + +import qualified Github.Repos.Webhooks as W +import qualified Github.Auth as Auth +import qualified Github.Data.Definitions as Def +import Data.List + +main :: IO () +main = do + let auth = Auth.OAuth "oauthtoken" + possibleWebhooks <- W.webhooksFor' auth "repoOwner" "repoName" + case possibleWebhooks of + (Left err) -> putStrLn $ "Error: " ++ (show err) + (Right webhooks) -> putStrLn $ intercalate "\n" $ map formatRepoWebhook webhooks + +formatRepoWebhook :: Def.RepoWebhook -> String +formatRepoWebhook (Def.RepoWebhook _ _ _ name _ _ _ _ _ _) = show name diff --git a/samples/Repos/Webhooks/PingWebhook.hs b/samples/Repos/Webhooks/PingWebhook.hs new file mode 100644 index 00000000..6cd959ad --- /dev/null +++ b/samples/Repos/Webhooks/PingWebhook.hs @@ -0,0 +1,12 @@ +module PingWebhook where + +import Github.Repos.Webhooks +import qualified Github.Auth as Auth + +main :: IO () +main = do + let auth = Auth.OAuth "oauthtoken" + resp <- pingRepoWebhook' auth "repoOwner" "repoName" 123 + case resp of + (Left err) -> putStrLn $ "Error: " ++ (show err) + (Right stat) -> putStrLn $ "Resp: " ++ (show stat) diff --git a/samples/Repos/Webhooks/TestPushWebhook.hs b/samples/Repos/Webhooks/TestPushWebhook.hs new file mode 100644 index 00000000..ce1cf9c4 --- /dev/null +++ b/samples/Repos/Webhooks/TestPushWebhook.hs @@ -0,0 +1,12 @@ +module TestPushWebhook where + +import Github.Repos.Webhooks +import qualified Github.Auth as Auth + +main :: IO () +main = do + let auth = Auth.OAuth "oauthtoken" + resp <- testPushRepoWebhook' auth "repoOwner" "repoName" 123 + case resp of + (Left err) -> putStrLn $ "Error: " ++ (show err) + (Right stat) -> putStrLn $ "Resp: " ++ (show stat) diff --git a/samples/Search/SearchCode.hs b/samples/Search/SearchCode.hs new file mode 100644 index 00000000..f5b472cb --- /dev/null +++ b/samples/Search/SearchCode.hs @@ -0,0 +1,33 @@ +{-# LANGUAGE OverloadedStrings #-} + +module Main where + +import qualified GitHub +import Control.Monad (forM_) +import Data.List (intercalate) +import qualified Data.Text as T + +main :: IO () +main = do + let query = "Code repo:haskell-github/github" + result <- GitHub.github' GitHub.searchCodeR query 1000 + case result of + Left e -> putStrLn $ "Error: " ++ show e + Right r -> do + forM_ (GitHub.searchResultResults r) $ \r -> do + putStrLn $ formatCode r + putStrLn "" + putStrLn $ "Count: " ++ show (GitHub.searchResultTotalCount r) + ++ " matches for the query: \"" ++ T.unpack query ++ "\"" + +formatCode :: GitHub.Code -> String +formatCode r = + let fields = [ ("Name", show . GitHub.codeName) + , ("Path", show . GitHub.codePath) + , ("Sha", show . GitHub.codeSha) + , ("URL", show . GitHub.codeHtmlUrl) + ] + in intercalate "\n" $ map fmt fields + where fmt (s,f) = fill 12 (s ++ ":") ++ " " ++ f r + fill n s = s ++ replicate n' ' ' + where n' = max 0 (n - length s) diff --git a/samples/Search/SearchIssues.hs b/samples/Search/SearchIssues.hs new file mode 100644 index 00000000..288aef73 --- /dev/null +++ b/samples/Search/SearchIssues.hs @@ -0,0 +1,29 @@ +{-# LANGUAGE OverloadedStrings #-} +module Main where + +import qualified GitHub +import qualified Data.Text as T +import Control.Monad (forM_) +import Data.Monoid ((<>)) + +main :: IO () +main = do + let query = "build repo:haskell-github/github" + result <- GitHub.github' GitHub.searchIssuesR query 1000 + case result of + Left e -> putStrLn $ "Error: " ++ show e + Right r -> do + forM_ (GitHub.searchResultResults r) $ \r -> do + putStrLn $ formatIssue r + putStrLn "" + putStrLn $ "Count: " ++ show (GitHub.searchResultTotalCount r) + ++ " matches for the query: \"" ++ T.unpack query ++ "\"" + +formatIssue :: GitHub.Issue -> String +formatIssue issue = + (show $ GitHub.issueUser issue) <> + " opened this issue " <> + (show $ GitHub.issueCreatedAt issue) <> "\n" <> + (show $ GitHub.issueState issue) <> " with " <> + (show $ GitHub.issueComments issue) <> " comments" <> "\n\n" <> + (T.unpack $ GitHub.issueTitle issue) diff --git a/samples/Search/SearchRepos.hs b/samples/Search/SearchRepos.hs index cd3dcd36..e09c2bfc 100644 --- a/samples/Search/SearchRepos.hs +++ b/samples/Search/SearchRepos.hs @@ -1,56 +1,59 @@ {-# LANGUAGE OverloadedStrings #-} -module SearchRepos where +module Main where -import qualified Github.Search as Github -import qualified Github.Data as Github -import Control.Monad (forM,forM_) +import qualified GitHub +import Control.Monad (forM_) import Data.Maybe (fromMaybe) +import Data.Monoid ((<>)) import Data.List (intercalate) import System.Environment (getArgs) import Text.Printf (printf) import Data.Time.Clock (getCurrentTime, UTCTime(..)) -import Data.Time.LocalTime (utc,utcToLocalTime,localDay,localTimeOfDay,TimeOfDay(..)) +import Data.Time.LocalTime (utc,utcToLocalTime,localDay) import Data.Time.Calendar (toGregorian) +import Data.Text (Text) +import qualified Data.Text as T +main :: IO () main = do args <- getArgs date <- case args of - (x:_) -> return x - otherwise -> today - let query = "q=language%3Ahaskell created%3A>" ++ date ++ "&per_page=100" - let auth = Nothing - result <- Github.searchRepos' auth query + (x:_) -> return $ T.pack x + _ -> today + let query = ("language:haskell created:>" <> date) :: Text + result <- GitHub.github' GitHub.searchReposR query 1000 case result of Left e -> putStrLn $ "Error: " ++ show e - Right r -> do forM_ (Github.searchReposRepos r) (\r -> do - putStrLn $ formatRepo r - putStrLn "" - ) - putStrLn $ "Count: " ++ show n ++ " Haskell repos created since " ++ date - where n = Github.searchReposTotalCount r + Right r -> do + forM_ (GitHub.searchResultResults r) $ \r -> do + putStrLn $ formatRepo r + putStrLn "" + putStrLn $ "Count: " ++ show (GitHub.searchResultTotalCount r) + ++ " Haskell repos created since " ++ T.unpack date -- | return today (in UTC) formatted as YYYY-MM-DD -today :: IO String +today :: IO Text today = do now <- getCurrentTime let day = localDay $ utcToLocalTime utc now (y,m,d) = toGregorian day - in return $ printf "%d-%02d-%02d" y m d + in return $ T.pack $ printf "%d-%02d-%02d" y m d -formatRepo :: Github.Repo -> String +formatRepo :: GitHub.Repo -> String formatRepo r = - let fields = [ ("Name", Github.repoName) - ,("URL", Github.repoHtmlUrl) - ,("Description", orEmpty . Github.repoDescription) - ,("Created-At", formatDate . Github.repoCreatedAt) - ,("Pushed-At", formatMaybeDate . Github.repoPushedAt) + let fields = [ ("Name", show . GitHub.repoName) + ,("URL", show . GitHub.repoHtmlUrl) + ,("Description", show . orEmpty . GitHub.repoDescription) + ,("Created-At", formatMaybeDate . GitHub.repoCreatedAt) + ,("Pushed-At", formatMaybeDate . GitHub.repoPushedAt) + ,("Stars", show . GitHub.repoStargazersCount) ] in intercalate "\n" $ map fmt fields where fmt (s,f) = fill 12 (s ++ ":") ++ " " ++ f r orEmpty = fromMaybe "" fill n s = s ++ replicate n' ' ' - where n' = max 0 (n - length s) + where n' = max 0 (n - length s) -formatMaybeDate = maybe "???" formatDate -formatDate = show . Github.fromGithubDate +formatMaybeDate :: Maybe UTCTime -> String +formatMaybeDate = maybe "???" show diff --git a/samples/Teams/DeleteTeam.hs b/samples/Teams/DeleteTeam.hs new file mode 100644 index 00000000..b354d94c --- /dev/null +++ b/samples/Teams/DeleteTeam.hs @@ -0,0 +1,18 @@ +{-# LANGUAGE NoImplicitPrelude #-} +{-# LANGUAGE OverloadedStrings #-} +module Main (main) where + +import Common + +import qualified GitHub +import qualified GitHub.Endpoints.Organizations.Teams as GitHub + +main :: IO () +main = do + args <- getArgs + result <- case args of + [token, team_id] -> GitHub.deleteTeam' (GitHub.OAuth $ fromString token) (GitHub.mkTeamId $ read team_id) + _ -> error "usage: DeleteTeam " + case result of + Left err -> putStrLn $ "Error: " <> tshow err + Right team -> putStrLn $ tshow team diff --git a/samples/Teams/EditTeam.hs b/samples/Teams/EditTeam.hs new file mode 100644 index 00000000..7e83e5c9 --- /dev/null +++ b/samples/Teams/EditTeam.hs @@ -0,0 +1,23 @@ +{-# LANGUAGE NoImplicitPrelude #-} +{-# LANGUAGE OverloadedStrings #-} +module Main (main) where + +import Common + +import qualified GitHub + +main :: IO () +main = do + args <- getArgs + result <- case args of + [token, team_id, team_name, desc] -> + GitHub.github + (GitHub.OAuth $ fromString token) + GitHub.editTeamR + (GitHub.mkTeamId $ read team_id) + (GitHub.EditTeam (GitHub.mkTeamName $ fromString team_name) (Just $ fromString desc) Nothing Nothing) + _ -> + error "usage: EditTeam " + case result of + Left err -> putStrLn $ "Error: " <> tshow err + Right team -> putStrLn $ tshow team diff --git a/samples/Teams/ListRepos.hs b/samples/Teams/ListRepos.hs new file mode 100644 index 00000000..a03dc143 --- /dev/null +++ b/samples/Teams/ListRepos.hs @@ -0,0 +1,18 @@ +{-# LANGUAGE OverloadedStrings #-} +module Main (main) where + +import Common +import Prelude () + +import qualified GitHub as GH + +main :: IO () +main = do + args <- getArgs + possibleRepos <- case args of + [team_id, token] -> GH.github (GH.OAuth $ fromString token) GH.listTeamReposR (GH.mkTeamId $ read team_id) + [team_id] -> GH.github' GH.listTeamReposR (GH.mkTeamId $ read team_id) + _ -> error "usage: TeamListRepos [auth token]" + case possibleRepos of + Left err -> putStrLn $ "Error: " <> tshow err + Right repos -> putStrLn $ tshow repos diff --git a/samples/Teams/ListTeamsCurrent.hs b/samples/Teams/ListTeamsCurrent.hs new file mode 100644 index 00000000..eefd1e70 --- /dev/null +++ b/samples/Teams/ListTeamsCurrent.hs @@ -0,0 +1,17 @@ +{-# LANGUAGE NoImplicitPrelude #-} +{-# LANGUAGE OverloadedStrings #-} +module Main (main) where + +import Common + +import qualified GitHub as GH + +main :: IO () +main = do + args <- getArgs + result <- case args of + [token] -> GH.github (GH.OAuth $ fromString token) GH.listTeamsCurrentR GH.FetchAll + _ -> error "usage: ListTeamsCurrent " + case result of + Left err -> putStrLn $ "Error: " <> tshow err + Right teams -> mapM_ (putStrLn . tshow) teams diff --git a/samples/Teams/Memberships/AddTeamMembershipFor.hs b/samples/Teams/Memberships/AddTeamMembershipFor.hs new file mode 100644 index 00000000..58c120a2 --- /dev/null +++ b/samples/Teams/Memberships/AddTeamMembershipFor.hs @@ -0,0 +1,22 @@ +{-# LANGUAGE NoImplicitPrelude #-} +{-# LANGUAGE OverloadedStrings #-} +module Main (main) where + +import Common + +import qualified GitHub + +main :: IO () +main = do + args <- getArgs + result <- case args of + [token, team_id, username] -> GitHub.github + (GitHub.OAuth $ fromString token) + GitHub.addTeamMembershipForR + (GitHub.mkTeamId $ read team_id) + (GitHub.mkOwnerName $ fromString username) + GitHub.RoleMember + _ -> fail "usage: AddTeamMembershipFor " + case result of + Left err -> putStrLn $ "Error: " <> tshow err + Right team -> putStrLn $ tshow team diff --git a/samples/Teams/Memberships/DeleteTeamMembershipFor.hs b/samples/Teams/Memberships/DeleteTeamMembershipFor.hs new file mode 100644 index 00000000..1d7b7ed5 --- /dev/null +++ b/samples/Teams/Memberships/DeleteTeamMembershipFor.hs @@ -0,0 +1,23 @@ +{-# LANGUAGE NoImplicitPrelude #-} +{-# LANGUAGE OverloadedStrings #-} +module Main (main) where + +import Common + +import qualified GitHub +import qualified GitHub.Endpoints.Organizations.Teams as GitHub + +main :: IO () +main = do + args <- getArgs + result <- case args of + [token, team_id, username] -> + GitHub.deleteTeamMembershipFor' + (GitHub.OAuth $ fromString token) + (GitHub.mkTeamId $ read team_id) + (GitHub.mkOwnerName $ fromString username) + _ -> + error "usage: DeleteTeamMembershipFor " + case result of + Left err -> putStrLn $ "Error: " <> tshow err + Right team -> putStrLn $ tshow team diff --git a/samples/Teams/Memberships/TeamMembershipInfoFor.hs b/samples/Teams/Memberships/TeamMembershipInfoFor.hs new file mode 100644 index 00000000..89a6fa82 --- /dev/null +++ b/samples/Teams/Memberships/TeamMembershipInfoFor.hs @@ -0,0 +1,22 @@ +{-# LANGUAGE NoImplicitPrelude #-} +{-# LANGUAGE OverloadedStrings #-} +module Main (main) where + +import Common + +import qualified GitHub +import qualified GitHub.Endpoints.Organizations.Teams as GitHub + +main :: IO () +main = do + args <- getArgs + result <- case args of + [team_id, username, token] -> + GitHub.teamMembershipInfoFor' (Just $ GitHub.OAuth $ fromString token) (GitHub.mkTeamId $ read team_id) (GitHub.mkOwnerName $ fromString username) + [team_id, username] -> + GitHub.teamMembershipInfoFor (GitHub.mkTeamId $ read team_id) (GitHub.mkOwnerName $ fromString username) + _ -> + error "usage: TeamMembershipInfoFor [token]" + case result of + Left err -> putStrLn $ "Error: " <> tshow err + Right team -> putStrLn $ tshow team diff --git a/samples/Teams/Repos/AddOrUpdateTeamRepo.hs b/samples/Teams/Repos/AddOrUpdateTeamRepo.hs new file mode 100644 index 00000000..7e4b6034 --- /dev/null +++ b/samples/Teams/Repos/AddOrUpdateTeamRepo.hs @@ -0,0 +1,25 @@ +{-# LANGUAGE NoImplicitPrelude #-} +{-# LANGUAGE OverloadedStrings #-} +module Main (main) where + +import Common + +import qualified GitHub +import qualified GitHub.Endpoints.Organizations.Teams as GitHub + +main :: IO () +main = do + args <- getArgs + result <- case args of + [token, team_id, org, repo] -> + GitHub.addOrUpdateTeamRepo' + (GitHub.OAuth $ fromString token) + (GitHub.mkTeamId $ read team_id) + (GitHub.mkOrganizationName $ fromString org) + (GitHub.mkRepoName $ fromString repo) + GitHub.PermissionPull + _ -> + error "usage: AddOrUpdateTeamRepo " + case result of + Left err -> putStrLn $ "Error: " <> tshow err + Right team -> putStrLn $ tshow team diff --git a/samples/Teams/TeamInfoFor.hs b/samples/Teams/TeamInfoFor.hs new file mode 100644 index 00000000..7a8744f8 --- /dev/null +++ b/samples/Teams/TeamInfoFor.hs @@ -0,0 +1,18 @@ +{-# LANGUAGE NoImplicitPrelude #-} +{-# LANGUAGE OverloadedStrings #-} +module Main (main) where + +import Common + +import qualified GitHub as GH + +main :: IO () +main = do + args <- getArgs + result <- case args of + [team_id, token] -> GH.github (GH.OAuth $ fromString token) GH.teamInfoForR (GH.mkTeamId $ read team_id) + [team_id] -> GH.github' GH.teamInfoForR (GH.mkTeamId $ read team_id) + _ -> error "usage: TeamInfoFor [auth token]" + case result of + Left err -> putStrLn $ "Error: " <> tshow err + Right team -> putStrLn $ tshow team diff --git a/samples/Users/Emails/ListEmails.hs b/samples/Users/Emails/ListEmails.hs new file mode 100644 index 00000000..548b861e --- /dev/null +++ b/samples/Users/Emails/ListEmails.hs @@ -0,0 +1,17 @@ +{-# LANGUAGE OverloadedStrings #-} +module Main (main) where + +import Common +import Prelude () +import qualified GitHub.Endpoints.Users.Emails as GitHub + + +main :: IO () +main = do + emails <- GitHub.currentUserEmails' (GitHub.OAuth "token") + putStrLn $ either (("Error: " <>) . tshow) + (foldMap ((<> "\n") . formatEmail)) + emails + +formatEmail :: GitHub.Email -> Text +formatEmail e = GitHub.emailAddress e <> if GitHub.emailPrimary e then " [primary]" else "" diff --git a/samples/Users/Followers/Example.hs b/samples/Users/Followers/Example.hs new file mode 100644 index 00000000..6d71c8a5 --- /dev/null +++ b/samples/Users/Followers/Example.hs @@ -0,0 +1,20 @@ +{-# LANGUAGE NoImplicitPrelude #-} +{-# LANGUAGE OverloadedStrings #-} + +import Prelude () +import Prelude.Compat + +import Data.Text (Text, pack) +import Data.Text.IO as T (putStrLn) + +import qualified GitHub.Endpoints.Users.Followers as GitHub + +main :: IO () +main = do + possibleUsers <- GitHub.usersFollowing "mike-burns" + T.putStrLn $ either (("Error: " <>) . pack . show) + (foldMap ((<> "\n") . formatUser)) + possibleUsers + +formatUser :: GitHub.SimpleUser -> Text +formatUser = GitHub.untagName . GitHub.simpleUserLogin diff --git a/samples/Users/Followers/ListFollowers.hs b/samples/Users/Followers/ListFollowers.hs index b8a3a6d4..dc5df3fe 100644 --- a/samples/Users/Followers/ListFollowers.hs +++ b/samples/Users/Followers/ListFollowers.hs @@ -1,12 +1,18 @@ -module ListFollowers where +{-# LANGUAGE OverloadedStrings #-} +module Main (main) where -import qualified Github.Users.Followers as Github -import Data.List (intercalate) +import Common +import Prelude () +import qualified GitHub + +main :: IO () main = do - possibleUsers <- Github.usersFollowing "mike-burns" - putStrLn $ either (("Error: "++) . show) - (intercalate "\n" . map formatUser) - possibleUsers + auth <- getAuth + possibleUsers <- GitHub.executeRequestMaybe auth $ GitHub.usersFollowingR "mike-burns" GitHub.FetchAll + putStrLn $ either (("Error: " <>) . tshow) + (foldMap ((<> "\n") . formatUser)) + possibleUsers -formatUser = Github.githubOwnerLogin +formatUser :: GitHub.SimpleUser -> Text +formatUser = GitHub.untagName . GitHub.simpleUserLogin diff --git a/samples/Users/Followers/ListFollowing.hs b/samples/Users/Followers/ListFollowing.hs index 62c6c2dd..81953aee 100644 --- a/samples/Users/Followers/ListFollowing.hs +++ b/samples/Users/Followers/ListFollowing.hs @@ -1,13 +1,19 @@ -module ListFollowing where +{-# LANGUAGE OverloadedStrings #-} +module Main (main) where -import qualified Github.Users.Followers as Github -import Data.List (intercalate) +import Common +import Prelude () +import qualified GitHub + +main :: IO () main = do - possibleUsers <- Github.usersFollowedBy "mike-burns" - putStrLn $ either (("Error: "++) . show) - (intercalate "\n" . map formatUser) - possibleUsers + auth <- getAuth + possibleUsers <- GitHub.executeRequestMaybe auth $ GitHub.usersFollowedByR "mike-burns" GitHub.FetchAll + putStrLn $ either (("Error: " <>) . tshow) + (foldMap ((<> "\n") . formatUser)) + possibleUsers -formatUser = Github.githubOwnerLogin +formatUser :: GitHub.SimpleUser -> Text +formatUser = GitHub.untagName . GitHub.simpleUserLogin diff --git a/samples/Users/PublicSSHKeys/CreatePublicSSHKey.hs b/samples/Users/PublicSSHKeys/CreatePublicSSHKey.hs new file mode 100644 index 00000000..7ccdf478 --- /dev/null +++ b/samples/Users/PublicSSHKeys/CreatePublicSSHKey.hs @@ -0,0 +1,21 @@ +{-# LANGUAGE OverloadedStrings #-} +module Main (main) where + +import qualified GitHub.Data.PublicSSHKeys as PK +import qualified GitHub.Endpoints.Users.PublicSSHKeys as PK +import qualified GitHub.Auth as Auth + +main :: IO () +main = do + let auth = Auth.OAuth "auth_token" + ePublicSSHKey <- PK.createUserPublicSSHKey' auth newPublicSSHKey + case ePublicSSHKey of + Left err -> putStrLn $ "Error: " ++ show err + Right publicSSHKey -> print publicSSHKey + +newPublicSSHKey :: PK.NewPublicSSHKey +newPublicSSHKey = + PK.NewPublicSSHKey + { PK.newPublicSSHKeyKey = "test-key" + , PK.newPublicSSHKeyTitle = "some-name-for-your-key" + } diff --git a/samples/Users/PublicSSHKeys/DeletePublicSSHKey.hs b/samples/Users/PublicSSHKeys/DeletePublicSSHKey.hs new file mode 100644 index 00000000..f1f28b17 --- /dev/null +++ b/samples/Users/PublicSSHKeys/DeletePublicSSHKey.hs @@ -0,0 +1,14 @@ +{-# LANGUAGE OverloadedStrings #-} +module Main (main) where + +import GitHub.Data.Id (Id (..)) +import qualified GitHub.Endpoints.Users.PublicSSHKeys as PK +import qualified GitHub.Auth as Auth + +main :: IO () +main = do + let auth = Auth.OAuth "auth_token" + ePublicSSHKey <- PK.deleteUserPublicSSHKey' auth (Id 18530161) + case ePublicSSHKey of + (Left err) -> putStrLn $ "Error: " ++ (show err) + (Right _) -> putStrLn $ "Deleted public SSH key!" diff --git a/samples/Users/PublicSSHKeys/ListPublicSSHKeys.hs b/samples/Users/PublicSSHKeys/ListPublicSSHKeys.hs new file mode 100644 index 00000000..2a485127 --- /dev/null +++ b/samples/Users/PublicSSHKeys/ListPublicSSHKeys.hs @@ -0,0 +1,23 @@ +{-# LANGUAGE OverloadedStrings #-} +module Main (main) where + +import qualified GitHub.Endpoints.Users.PublicSSHKeys as PK +import qualified GitHub.Auth as Auth +import Data.List (intercalate) +import Data.Vector (toList) + +main :: IO () +main = do + -- Fetch the SSH public keys of another user + ePublicSSHKeys <- PK.publicSSHKeysFor' "github_name" + case ePublicSSHKeys of + (Left err) -> putStrLn $ "Error: " ++ (show err) + (Right publicSSHKeys) -> putStrLn $ intercalate "\n" $ map show (toList publicSSHKeys) + + -- Fetch my SSH public keys + let auth = Auth.OAuth "auth_token" + eMyPublicSSHKeys <- PK.publicSSHKeys' auth + case eMyPublicSSHKeys of + (Left err) -> putStrLn $ "Error: " ++ (show err) + (Right publicSSHKeys) -> putStrLn $ intercalate "\n" $ map show (toList publicSSHKeys) + diff --git a/samples/Users/PublicSSHKeys/ShowPublicSSHKey.hs b/samples/Users/PublicSSHKeys/ShowPublicSSHKey.hs new file mode 100644 index 00000000..249a3728 --- /dev/null +++ b/samples/Users/PublicSSHKeys/ShowPublicSSHKey.hs @@ -0,0 +1,14 @@ +{-# LANGUAGE OverloadedStrings #-} +module Main (main) where + +import GitHub.Data.Id (Id (..)) +import qualified GitHub.Endpoints.Users.PublicSSHKeys as PK +import qualified GitHub.Auth as Auth + +main :: IO () +main = do + let auth = Auth.OAuth "auth_token" + ePublicSSHKey <- PK.publicSSHKey' auth (Id 18528451) + case ePublicSSHKey of + (Left err) -> putStrLn $ "Error: " ++ (show err) + (Right publicSSHKey) -> putStrLn $ show publicSSHKey diff --git a/samples/Users/ShowUser.hs b/samples/Users/ShowUser.hs index ae212fbe..9ec6e423 100644 --- a/samples/Users/ShowUser.hs +++ b/samples/Users/ShowUser.hs @@ -1,52 +1,43 @@ -module ShowUser where +{-# LANGUAGE OverloadedStrings #-} +module Main (main) where + +import Common +import Prelude () -import qualified Github.Users as Github import Data.Maybe (fromMaybe) -main = do - possibleUser <- Github.userInfoFor "mike-burns" - putStrLn $ either (("Error: "++) . show) formatUser possibleUser +import qualified GitHub as GH -formatUser user@(Github.DetailedOrganization {}) = - "Organization: " ++ (formatName userName login) ++ "\t" ++ - (fromMaybe "" company) ++ "\t" ++ - (fromMaybe "" location) ++ "\n" ++ - (fromMaybe "" blog) ++ "\t" ++ "\n" ++ - htmlUrl ++ "\t" ++ (formatDate createdAt) ++ "\n\n" ++ - (fromMaybe "" bio) - where - userName = Github.detailedOwnerName user - login = Github.detailedOwnerLogin user - company = Github.detailedOwnerCompany user - location = Github.detailedOwnerLocation user - blog = Github.detailedOwnerBlog user - htmlUrl = Github.detailedOwnerHtmlUrl user - createdAt = Github.detailedOwnerCreatedAt user - bio = Github.detailedOwnerBio user +main :: IO () +main = do + mauth <- getAuth + possibleUser <- maybe GH.github' GH.github mauth GH.userInfoForR "mike-burns" + putStrLn $ either (("Error: " <>) . tshow) formatUser possibleUser -formatUser user@(Github.DetailedUser {}) = - (formatName userName login) ++ "\t" ++ (fromMaybe "" company) ++ "\t" ++ - (fromMaybe "" location) ++ "\n" ++ - (fromMaybe "" blog) ++ "\t" ++ "<" ++ email ++ ">" ++ "\n" ++ - htmlUrl ++ "\t" ++ (formatDate createdAt) ++ "\n" ++ - "hireable: " ++ (formatHireable isHireable) ++ "\n\n" ++ - (fromMaybe "" bio) +formatUser :: GH.User -> Text +formatUser user = + formatName userName login <> "\t" <> fromMaybe "" company <> "\t" <> + fromMaybe "" location <> "\n" <> + fromMaybe "" blog <> "\t" <> "<" <> fromMaybe "" email <> ">" <> "\n" <> + GH.getUrl htmlUrl <> "\t" <> tshow createdAt <> "\n" <> + "hireable: " <> formatHireable (fromMaybe False isHireable) <> "\n\n" <> + fromMaybe "" bio where - userName = Github.detailedOwnerName user - login = Github.detailedOwnerLogin user - company = Github.detailedOwnerCompany user - location = Github.detailedOwnerLocation user - blog = Github.detailedOwnerBlog user - email = Github.detailedOwnerEmail user - htmlUrl = Github.detailedOwnerHtmlUrl user - createdAt = Github.detailedOwnerCreatedAt user - isHireable = Github.detailedOwnerHireable user - bio = Github.detailedOwnerBio user + userName = GH.userName user + login = GH.userLogin user + company = GH.userCompany user + location = GH.userLocation user + blog = GH.userBlog user + email = GH.userEmail user + htmlUrl = GH.userHtmlUrl user + createdAt = GH.userCreatedAt user + isHireable = GH.userHireable user + bio = GH.userBio user -formatName Nothing login = login -formatName (Just name) login = name ++ "(" ++ login ++ ")" +formatName :: Maybe Text -> GH.Name GH.User -> Text +formatName Nothing login = GH.untagName login +formatName (Just name) login = name <> "(" <> GH.untagName login <> ")" +formatHireable :: Bool -> Text formatHireable True = "yes" formatHireable False = "no" - -formatDate = show . Github.fromGithubDate diff --git a/samples/Users/ShowUser2.hs b/samples/Users/ShowUser2.hs new file mode 100644 index 00000000..b0011c98 --- /dev/null +++ b/samples/Users/ShowUser2.hs @@ -0,0 +1,9 @@ +{-# LANGUAGE OverloadedStrings #-} +module Main (main) where + +import qualified GitHub as GH + +main :: IO () +main = do + possibleUser <- GH.executeRequest' $ GH.userInfoForR "phadej" + print possibleUser diff --git a/samples/github-samples.cabal b/samples/github-samples.cabal new file mode 100644 index 00000000..2e7a8699 --- /dev/null +++ b/samples/github-samples.cabal @@ -0,0 +1,226 @@ +cabal-version: 2.2 +name: github-samples +version: 0 +category: Examples +synopsis: Samples for github package +license: BSD-3-Clause +license-file: LICENSE +maintainer: Andreas Abel +description: Various samples of github package +build-type: Simple + +tested-with: + GHC == 9.14.1 + GHC == 9.12.2 + GHC == 9.10.2 + 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 + +library + hs-source-dirs: src + ghc-options: -Wall + build-depends: + , base >=4.11 && <5 + -- require base-4.11 because then (<>) is in Prelude + , github + , text + + exposed-modules: Common + default-language: Haskell2010 + +executable github-operational + default-language: Haskell2010 + main-is: Operational.hs + hs-source-dirs: Operational + ghc-options: -Wall -threaded + build-depends: + , base + , base-compat-batteries + , github + , github-samples + , http-client + , operational + , text + , transformers + , transformers-compat + +common deps + default-language: Haskell2010 + ghc-options: + -Wall + -threaded + build-depends: + , base + , base-compat-batteries + , base64-bytestring + , github + , github-samples + , text + , vector + +executable github-add-team-membership-for + import: deps + main-is: AddTeamMembershipFor.hs + hs-source-dirs: Teams/Memberships + +executable github-create-deploy-key + import: deps + main-is: CreateDeployKey.hs + hs-source-dirs: Repos/DeployKeys + +executable github-create-issue + import: deps + main-is: CreateIssue.hs + hs-source-dirs: Issues + +-- executable github-delete-deploy-key +-- import: deps +-- main-is: DeleteDeployKey.hs +-- hs-source-dirs: Repos/DeployKeys + +-- executable github-delete-team +-- import: deps +-- main-is: DeleteTeam.hs +-- hs-source-dirs: Teams + +-- executable github-delete-team-membership-for +-- import: deps +-- main-is: DeleteTeamMembershipFor.hs +-- hs-source-dirs: Teams/Memberships + +executable github-enterprise-create-organization + import: deps + main-is: CreateOrganization.hs + hs-source-dirs: Enterprise + +executable github-enterprise-rename-organization + import: deps + main-is: RenameOrganization.hs + hs-source-dirs: Enterprise + +executable github-edit-team + import: deps + main-is: EditTeam.hs + hs-source-dirs: Teams + +-- executable github-list-deploy-keys-for +-- import: deps +-- main-is: ListDeployKeys.hs +-- hs-source-dirs: Repos/DeployKeys + +executable github-list-followers + import: deps + main-is: ListFollowers.hs + hs-source-dirs: Users/Followers + +-- executable github-list-followers-example +-- import: deps +-- main-is: Example.hs +-- hs-source-dirs: Users/Followers + +executable github-list-following + import: deps + main-is: ListFollowing.hs + hs-source-dirs: Users/Followers + +executable github-list-team-current + import: deps + main-is: ListTeamsCurrent.hs + hs-source-dirs: Teams + +-- executable github-list-team-repos +-- import: deps +-- main-is: ListRepos.hs +-- hs-source-dirs: Teams + +-- executable github-repos-contents-example +-- import: deps +-- main-is: Contents.hs +-- hs-source-dirs: Repos + +-- executable github-show-deploy-key +-- import: deps +-- main-is: ShowDeployKey.hs +-- hs-source-dirs: Repos/DeployKeys + +executable github-show-repo-issues + import: deps + main-is: ShowRepoIssues.hs + hs-source-dirs: Issues + +executable github-show-user + import: deps + main-is: ShowUser.hs + hs-source-dirs: Users + +executable github-show-user-2 + import: deps + main-is: ShowUser2.hs + hs-source-dirs: Users + +executable github-search-code + import: deps + ghc-options: -Wall -threaded + main-is: SearchCode.hs + hs-source-dirs: Search + +executable github-search-issues + import: deps + ghc-options: -Wall -threaded + main-is: SearchIssues.hs + hs-source-dirs: Search + +executable github-search-repos + import: deps + ghc-options: -Wall -threaded + main-is: SearchRepos.hs + hs-source-dirs: Search + build-depends: time + +-- executable github-team-membership-info-for +-- import: deps +-- main-is: TeamMembershipInfoFor.hs +-- hs-source-dirs: Teams/Memberships + +executable github-teaminfo-for + import: deps + main-is: TeamInfoFor.hs + hs-source-dirs: Teams + +executable github-unwatch-repo + import: deps + main-is: Unwatch.hs + ghc-options: -Wall -threaded + hs-source-dirs: Repos/Watching + +-- executable github-create-public-ssh-key +-- import: deps +-- main-is: CreatePublicSSHKey.hs +-- hs-source-dirs: Users/PublicSSHKeys + +-- executable github-delete-public-ssh-key +-- import: deps +-- main-is: DeletePublicSSHKey.hs +-- hs-source-dirs: Users/PublicSSHKeys + +-- executable github-list-public-ssh-keys +-- import: deps +-- main-is: ListPublicSSHKeys.hs +-- hs-source-dirs: Users/PublicSSHKeys + +-- executable github-get-public-ssh-key +-- import: deps +-- main-is: ShowPublicSSHKey.hs +-- hs-source-dirs: Users/PublicSSHKeys + +-- executable github-repos-commits-diff +-- import: deps +-- main-is: GitDiff.hs +-- hs-source-dirs: Repos/Commits diff --git a/samples/src/Common.hs b/samples/src/Common.hs new file mode 100644 index 00000000..6051d2a4 --- /dev/null +++ b/samples/src/Common.hs @@ -0,0 +1,29 @@ +{-# LANGUAGE NoImplicitPrelude #-} +module Common ( + -- * Common stuff + getAuth, + tshow, + -- * Re-exports + putStrLn, + getArgs, + Proxy(..), + module GitHub.Internal.Prelude, + ) where + +import GitHub.Internal.Prelude hiding (putStrLn) + +import Data.Proxy (Proxy (..)) +import Data.Text.IO (putStrLn) +import System.Environment (lookupEnv) +import System.Environment (getArgs) + +import qualified Data.Text as T +import qualified GitHub + +getAuth :: IO (Maybe (GitHub.Auth)) +getAuth = do + token <- lookupEnv "GITHUB_TOKEN" + pure (GitHub.OAuth . fromString <$> token) + +tshow :: Show a => a -> Text +tshow = T.pack . show diff --git a/spec/GitHub/Actions/ArtifactsSpec.hs b/spec/GitHub/Actions/ArtifactsSpec.hs new file mode 100644 index 00000000..c3df8031 --- /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 index 00000000..c70596c3 --- /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 index 00000000..e9e32fa0 --- /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 index 00000000..43334741 --- /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 index 00000000..0a5643c9 --- /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 index 00000000..71c2aaad --- /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 new file mode 100644 index 00000000..43b3c234 --- /dev/null +++ b/spec/GitHub/ActivitySpec.hs @@ -0,0 +1,40 @@ +{-# LANGUAGE OverloadedStrings #-} +module GitHub.ActivitySpec where + +import qualified GitHub + +import GitHub.Auth (Auth (..)) +import GitHub.Endpoints.Activity.Starring (myStarredAcceptStarR) +import GitHub.Endpoints.Activity.Watching (watchersForR) +import GitHub.Request (executeRequest) + +import Data.Either.Compat (isRight) +import Data.String (fromString) +import System.Environment (lookupEnv) +import Test.Hspec (Spec, describe, it, pendingWith, shouldSatisfy) + +import qualified Data.Vector as V + +fromRightS :: Show a => Either a b -> b +fromRightS (Right b) = b +fromRightS (Left a) = error $ "Expected a Right and got a Left" ++ show a + +withAuth :: (Auth -> IO ()) -> IO () +withAuth action = do + mtoken <- lookupEnv "GITHUB_TOKEN" + case mtoken of + Nothing -> pendingWith "no GITHUB_TOKEN" + Just token -> action (OAuth $ fromString token) + +spec :: Spec +spec = do + describe "watchersForR" $ do + it "works" $ withAuth $ \auth -> do + cs <- executeRequest auth $ watchersForR "haskell-github" "github" GitHub.FetchAll + cs `shouldSatisfy` isRight + V.length (fromRightS cs) `shouldSatisfy` (> 10) + describe "myStarredR" $ do + it "works" $ withAuth $ \auth -> do + cs <- executeRequest auth $ myStarredAcceptStarR (GitHub.FetchAtLeast 31) + cs `shouldSatisfy` isRight + fromRightS cs `shouldSatisfy` (\xs -> V.length xs > 30) diff --git a/spec/GitHub/CommitsSpec.hs b/spec/GitHub/CommitsSpec.hs new file mode 100644 index 00000000..97f8c386 --- /dev/null +++ b/spec/GitHub/CommitsSpec.hs @@ -0,0 +1,63 @@ +{-# LANGUAGE OverloadedStrings #-} +module GitHub.CommitsSpec where + +import GitHub.Auth (Auth (..)) +import GitHub.Endpoints.Repos.Commits (commitSha, commitsForR, diffR, mkCommitName, FetchCount (..)) +import GitHub.Request (github) + +import Control.Monad (forM_) +import Data.Either.Compat (isRight) +import Data.List (nub, sort) +import Data.String (fromString) +import System.Environment (lookupEnv) +import Test.Hspec (Spec, describe, it, pendingWith, shouldBe, + shouldSatisfy) + +import qualified Data.Vector as V + +fromRightS :: Show a => Either a b -> b +fromRightS (Right b) = b +fromRightS (Left a) = error $ "Expected a Right and got a Left" ++ show a + +withAuth :: (Auth -> IO ()) -> IO () +withAuth action = do + mtoken <- lookupEnv "GITHUB_TOKEN" + case mtoken of + Nothing -> pendingWith "no GITHUB_TOKEN" + Just token -> action (OAuth $ fromString token) + +spec :: Spec +spec = do + describe "commitsFor" $ do + it "works" $ withAuth $ \auth -> do + cs <- 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 <- github auth commitsForR "haskell-github" "github" (FetchAtLeast 40) + cs `shouldSatisfy` isRight + let cs' = fromRightS cs + V.length cs' `shouldSatisfy` (< 70) + let hashes = sort $ map commitSha $ V.toList cs' + hashes `shouldBe` nub hashes + + describe "diff" $ do + it "works" $ withAuth $ \auth -> do + cs <- 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 <- github auth diffR "haskell-github" "github" (commitSha a) (commitSha b) + d `shouldSatisfy` isRight + + it "issue #155" $ withAuth $ \auth -> do + 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 new file mode 100644 index 00000000..fee7f50e --- /dev/null +++ b/spec/GitHub/EventsSpec.hs @@ -0,0 +1,36 @@ +{-# LANGUAGE OverloadedStrings #-} +module GitHub.EventsSpec where + +import Data.Either (isRight) +import Data.String (fromString) +import Prelude () +import Prelude.Compat +import System.Environment (lookupEnv) +import Test.Hspec (Spec, describe, it, shouldSatisfy, + pendingWith) + +import qualified GitHub +import GitHub.Data (Auth(..)) + +fromRightS :: Show a => Either a b -> b +fromRightS (Left xs) = error $ "Should be Right" ++ show xs +fromRightS (Right xs) = xs + +withAuth :: (Auth -> IO ()) -> IO () +withAuth action = do + mtoken <- lookupEnv "GITHUB_TOKEN" + case mtoken of + Nothing -> pendingWith "no GITHUB_TOKEN" + Just token -> action (OAuth $ fromString token) + +spec :: Spec +spec = do + describe "repositoryEventsR" $ do + it "returns non empty list of events" $ shouldSucceed $ + GitHub.repositoryEventsR "haskell-github" "github" 1 + describe "userEventsR" $ do + it "returns non empty list of events" $ shouldSucceed $ GitHub.userEventsR "phadej" 1 + where shouldSucceed f = withAuth $ \auth -> do + cs <- GitHub.executeRequest auth $ f + cs `shouldSatisfy` isRight + length (fromRightS cs) `shouldSatisfy` (> 1) diff --git a/spec/GitHub/IssuesSpec.hs b/spec/GitHub/IssuesSpec.hs new file mode 100644 index 00000000..e673975f --- /dev/null +++ b/spec/GitHub/IssuesSpec.hs @@ -0,0 +1,70 @@ +{-# LANGUAGE OverloadedStrings #-} +module GitHub.IssuesSpec where + +import qualified GitHub + +import Prelude () +import Prelude.Compat + +import Data.Either.Compat (isRight) +import Data.Foldable (for_) +import Data.String (fromString) +import 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 + +withAuth :: (GitHub.Auth -> IO ()) -> IO () +withAuth action = do + mtoken <- lookupEnv "GITHUB_TOKEN" + case mtoken of + Nothing -> pendingWith "no GITHUB_TOKEN" + Just token -> action (GitHub.OAuth $ fromString token) + +spec :: Spec +spec = do + describe "issuesForRepoR" $ do + it "works" $ withAuth $ \auth -> for_ repos $ \(owner, repo) -> do + cs <- GitHub.executeRequest auth $ + GitHub.issuesForRepoR owner repo mempty GitHub.FetchAll + case cs of + Left e -> + expectationFailure . show $ e + Right cs' -> do + for_ cs' $ \i -> do + cms <- GitHub.executeRequest auth $ + GitHub.commentsR owner repo (GitHub.issueNumber i) 1 + cms `shouldSatisfy` isRight + + 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") + , ("haskell-github", "github") + ] diff --git a/spec/GitHub/OrganizationsSpec.hs b/spec/GitHub/OrganizationsSpec.hs new file mode 100644 index 00000000..b6e7aea3 --- /dev/null +++ b/spec/GitHub/OrganizationsSpec.hs @@ -0,0 +1,54 @@ +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE TemplateHaskell #-} +module GitHub.OrganizationsSpec where + +import GitHub (FetchCount (..), github) +import GitHub.Auth (Auth (..)) +import GitHub.Data + (SimpleOrganization (..), SimpleOwner (..), SimpleTeam (..)) +import GitHub.Endpoints.Organizations (publicOrganizationsForR) +import GitHub.Endpoints.Organizations.Members (membersOfR) + +import Data.Aeson (eitherDecodeStrict) +import Data.Either.Compat (isRight) +import Data.FileEmbed (embedFile) +import Data.String (fromString) +import System.Environment (lookupEnv) +import Test.Hspec + (Spec, describe, it, pendingWith, shouldBe, shouldSatisfy) + +fromRightS :: Show a => Either a b -> b +fromRightS (Right b) = b +fromRightS (Left a) = error $ "Expected a Right and got a Left" ++ show a + +withAuth :: (Auth -> IO ()) -> IO () +withAuth action = do + mtoken <- lookupEnv "GITHUB_TOKEN" + case mtoken of + Nothing -> pendingWith "no GITHUB_TOKEN" + Just token -> action (OAuth $ fromString token) + +spec :: Spec +spec = do + describe "publicOrganizationsFor'" $ do + it "decodes simple organization json" $ do + let orgs = eitherDecodeStrict $(embedFile "fixtures/user-organizations.json") + simpleOrganizationLogin (head $ fromRightS orgs) `shouldBe` "github" + + it "returns information about the user's organizations" $ withAuth $ \auth -> do + orgs <- github auth publicOrganizationsForR "mike-burns" FetchAll + orgs `shouldSatisfy` isRight + + describe "teamsOf" $ do + it "parse" $ do + let ts = eitherDecodeStrict $(embedFile "fixtures/list-teams.json") + simpleTeamName (head $ fromRightS ts) `shouldBe` "Justice League" + + describe "membersOf" $ do + it "parse" $ do + let ms = eitherDecodeStrict $(embedFile "fixtures/members-list.json") + simpleOwnerLogin (head $ fromRightS ms) `shouldBe` "octocat" + + it "works" $ withAuth $ \auth -> do + ms <- github auth membersOfR "haskell" FetchAll + ms `shouldSatisfy` isRight diff --git a/spec/GitHub/PublicSSHKeysSpec.hs b/spec/GitHub/PublicSSHKeysSpec.hs new file mode 100644 index 00000000..25b17dae --- /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 new file mode 100644 index 00000000..1aed07e4 --- /dev/null +++ b/spec/GitHub/PullRequestReviewsSpec.hs @@ -0,0 +1,32 @@ +{-# LANGUAGE OverloadedStrings #-} +module GitHub.PullRequestReviewsSpec where + +import qualified GitHub +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) + +withAuth :: (GitHub.Auth -> IO ()) -> IO () +withAuth action = do + mtoken <- lookupEnv "GITHUB_TOKEN" + case mtoken of + Nothing -> pendingWith "no GITHUB_TOKEN" + Just token -> action (GitHub.OAuth $ fromString token) + +spec :: Spec +spec = do + describe "pullRequestReviewsR" $ do + it "works" $ withAuth $ \auth -> for_ prs $ \(owner, repo, prid) -> do + cs <- GitHub.executeRequest auth $ + GitHub.pullRequestReviewsR owner repo prid GitHub.FetchAll + cs `shouldSatisfy` isRight + where + prs = + [("haskell-github", "github", IssueNumber 268)] diff --git a/spec/GitHub/PullRequestsSpec.hs b/spec/GitHub/PullRequestsSpec.hs new file mode 100644 index 00000000..05945d01 --- /dev/null +++ b/spec/GitHub/PullRequestsSpec.hs @@ -0,0 +1,164 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE TemplateHaskell #-} +module GitHub.PullRequestsSpec where + +import qualified GitHub as GH + +import Prelude () +import Prelude.Compat + +import Data.Aeson + (FromJSON (..), eitherDecodeStrict, withObject, (.:)) +import Data.ByteString (ByteString) +import qualified Data.ByteString.Lazy.Char8 as LBS8 +import Data.Either.Compat (isRight) +import Data.FileEmbed (embedFile) +import Data.Foldable (for_) +import Data.String (fromString) +import Data.Tagged (Tagged (..)) +import Data.Text (Text) +import qualified Data.Vector as V +import System.Environment (lookupEnv) +import Test.Hspec + (Spec, describe, it, pendingWith, shouldBe, shouldSatisfy) + +fromRightS :: Show a => Either a b -> b +fromRightS (Right b) = b +fromRightS (Left a) = error $ "Expected a Right and got a Left" ++ show a + +withAuth :: (GH.Auth -> IO ()) -> IO () +withAuth action = do + mtoken <- lookupEnv "GITHUB_TOKEN" + case mtoken of + Nothing -> pendingWith "no GITHUB_TOKEN" + Just token -> action (GH.OAuth $ fromString token) + +spec :: Spec +spec = do + describe "pullRequestsForR" $ do + it "works" $ withAuth $ \auth -> for_ repos $ \(owner, repo) -> do + cs <- GH.executeRequest auth $ + GH.pullRequestsForR owner repo opts GH.FetchAll + cs `shouldSatisfy` isRight + + describe "pullRequestPatchR" $ + it "works" $ withAuth $ \auth -> do + Right patch <- GH.executeRequest auth $ + GH.pullRequestPatchR "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 (GH.simplePullRequestRequestedReviewers simplePullRequestOpened) + `shouldBe` 0 + + V.length (GH.pullRequestRequestedReviewers pullRequestOpened) + `shouldBe` 0 + + it "decodes a pull request 'review_requested' payload" $ do + V.length (GH.simplePullRequestRequestedReviewers simplePullRequestReviewRequested) + `shouldBe` 1 + + V.length (GH.pullRequestRequestedReviewers pullRequestReviewRequested) + `shouldBe` 1 + + 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 <- 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") + , ("haskell-github", "github") + ] + opts = GH.stateClosed + + simplePullRequestOpened :: GH.SimplePullRequest + simplePullRequestOpened = + fromRightS (eitherDecodeStrict prOpenedPayload) + + pullRequestOpened :: GH.PullRequest + pullRequestOpened = + fromRightS (eitherDecodeStrict prOpenedPayload) + + simplePullRequestReviewRequested :: GH.SimplePullRequest + simplePullRequestReviewRequested = + fromRightS (eitherDecodeStrict prReviewRequestedPayload) + + 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 index 00000000..dd649955 --- /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 new file mode 100644 index 00000000..a2988f91 --- /dev/null +++ b/spec/GitHub/ReleasesSpec.hs @@ -0,0 +1,53 @@ +{-# LANGUAGE OverloadedStrings #-} +module GitHub.ReleasesSpec where + +import qualified GitHub + +import GitHub.Auth (Auth (..)) +import GitHub.Endpoints.Repos.Releases + (Release (..), latestReleaseR, releaseByTagNameR, releaseR, releasesR) +import GitHub.Request (executeRequest) + +import Data.Either.Compat (isRight) +import Data.Proxy (Proxy (..)) +import Data.String (fromString) +import System.Environment (lookupEnv) +import Test.Hspec + (Spec, describe, it, pendingWith, shouldBe, shouldSatisfy) + +import qualified Data.Vector as V + +fromRightS :: Show a => Either a b -> b +fromRightS (Right b) = b +fromRightS (Left a) = error $ "Expected a Right and got a Left" ++ show a + +withAuth :: (Auth -> IO ()) -> IO () +withAuth action = do + mtoken <- lookupEnv "GITHUB_TOKEN" + case mtoken of + Nothing -> pendingWith "no GITHUB_TOKEN" + Just token -> action (OAuth $ fromString token) + +spec :: Spec +spec = do + let v154Id = GitHub.mkId (Proxy :: Proxy Release) 5254449 + v154Text = "v1.5.4" + describe "releasesR" $ do + it "works" $ withAuth $ \auth -> do + rs <- executeRequest auth $ releasesR "calleerlandsson" "pick" GitHub.FetchAll + rs `shouldSatisfy` isRight + V.length (fromRightS rs) `shouldSatisfy` (> 14) + describe "releaseR" $ do + it "works" $ withAuth $ \auth -> do + rs <- executeRequest auth $ releaseR "calleerlandsson" "pick" v154Id + rs `shouldSatisfy` isRight + releaseTagName (fromRightS rs)`shouldBe` v154Text + describe "latestReleaseR" $ do + it "works" $ withAuth $ \auth -> do + rs <- executeRequest auth $ latestReleaseR "calleerlandsson" "pick" + rs `shouldSatisfy` isRight + describe "releaseByTagNameR" $ do + it "works" $ withAuth $ \auth -> do + rs <- executeRequest auth $ releaseByTagNameR "calleerlandsson" "pick" v154Text + rs `shouldSatisfy` isRight + releaseId (fromRightS rs)`shouldBe` v154Id diff --git a/spec/GitHub/ReposSpec.hs b/spec/GitHub/ReposSpec.hs new file mode 100644 index 00000000..9ccc7066 --- /dev/null +++ b/spec/GitHub/ReposSpec.hs @@ -0,0 +1,58 @@ +{-# LANGUAGE CPP #-} +{-# LANGUAGE OverloadedStrings #-} + +#if __GLASGOW_HASKELL__ >= 900 +{-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-} +#endif + +module GitHub.ReposSpec where + +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 qualified Data.HashMap.Strict as HM + +fromRightS :: Show a => Either a b -> b +fromRightS (Right b) = b +fromRightS (Left a) = error $ "Expected a Right and got a Left" ++ show a + +withAuth :: (Auth -> IO ()) -> IO () +withAuth action = do + mtoken <- lookupEnv "GITHUB_TOKEN" + case mtoken of + Nothing -> pendingWith "no GITHUB_TOKEN" + Just token -> action (OAuth $ fromString token) + +spec :: Spec +spec = do + describe "repositoryR" $ do + it "works" $ withAuth $ \auth -> do + er <- github auth repositoryR "haskell-github" "github" + er `shouldSatisfy` isRight + let Right r = er + -- https://github.com/haskell-github/github/pull/219 + repoDefaultBranch r `shouldBe` Just "master" + + describe "currentUserRepos" $ do + it "works" $ withAuth $ \auth -> do + cs <- github auth currentUserReposR RepoPublicityAll FetchAll + cs `shouldSatisfy` isRight + + describe "userRepos" $ do + it "works" $ withAuth $ \auth -> do + cs <- github auth userReposR "phadej" RepoPublicityAll FetchAll + cs `shouldSatisfy` isRight + + describe "languagesFor'" $ do + it "works" $ withAuth $ \auth -> do + 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 index 00000000..76060513 --- /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 new file mode 100644 index 00000000..23c6b7a9 --- /dev/null +++ b/spec/GitHub/SearchSpec.hs @@ -0,0 +1,67 @@ +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE TemplateHaskell #-} +module GitHub.SearchSpec where + +import Prelude () +import Prelude.Compat + +import Data.Aeson (eitherDecodeStrict) +import Data.FileEmbed (embedFile) +import Data.Proxy (Proxy (..)) +import Data.String (fromString) +import System.Environment (lookupEnv) +import Test.Hspec (Spec, describe, it, pendingWith, shouldBe) + +import qualified Data.Vector as V + +import GitHub (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 +fromRightS (Left a) = error $ "Expected a Right and got a Left" ++ show a + +withAuth :: (Auth -> IO ()) -> IO () +withAuth action = do + mtoken <- lookupEnv "GITHUB_TOKEN" + case mtoken of + Nothing -> pendingWith "no GITHUB_TOKEN" + Just token -> action (OAuth $ fromString token) + +spec :: Spec +spec = do + describe "searchIssues" $ do + it "decodes issue search response JSON" $ do + let searchIssuesResult = fromRightS $ eitherDecodeStrict $(embedFile "fixtures/issue-search.json") :: SearchResult Issue + searchResultTotalCount searchIssuesResult `shouldBe` 2 + + let issues = searchResultResults searchIssuesResult + V.length issues `shouldBe` 2 + + let issue1 = issues V.! 0 + issueId issue1 `shouldBe` mkId (Proxy :: Proxy Issue) 123898390 + issueNumber issue1 `shouldBe` IssueNumber 130 + issueTitle issue1 `shouldBe` "Make test runner more robust" + issueState issue1 `shouldBe` StateClosed + + let issue2 = issues V.! 1 + issueId issue2 `shouldBe` mkId (Proxy :: Proxy Issue) 119694665 + issueNumber issue2 `shouldBe` IssueNumber 127 + issueTitle issue2 `shouldBe` "Decouple request creation from execution" + issueState issue2 `shouldBe` StateOpen + + it "performs an issue search via the API" $ withAuth $ \auth -> do + let query = "Decouple in:title repo: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 new file mode 100644 index 00000000..0b1913f5 --- /dev/null +++ b/spec/GitHub/UsersSpec.hs @@ -0,0 +1,82 @@ +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE TemplateHaskell #-} +module GitHub.UsersSpec where + +import Data.Aeson (eitherDecodeStrict) +import Data.Either.Compat (isLeft, isRight) +import Data.FileEmbed (embedFile) +import Data.String (fromString) +import System.Environment (lookupEnv) +import Test.Hspec + (Spec, describe, it, pendingWith, shouldBe, shouldSatisfy) + +import qualified GitHub + +import GitHub.Data + (Auth (..), Organization (..), User (..), fromOwner) +import GitHub.Endpoints.Users + (ownerInfoForR, userInfoCurrentR, userInfoForR) +import GitHub.Endpoints.Users.Followers (usersFollowedByR, usersFollowingR) +import GitHub.Request (github) + +fromRightS :: Show a => Either a b -> b +fromRightS (Right b) = b +fromRightS (Left a) = error $ "Expected a Right and got a Left" ++ show a + +fromLeftS :: Show b => Either a b -> a +fromLeftS (Left b) = b +fromLeftS (Right a) = error $ "Expected a Left and got a RIght" ++ show a + +withAuth :: (Auth -> IO ()) -> IO () +withAuth action = do + mtoken <- lookupEnv "GITHUB_TOKEN" + case mtoken of + Nothing -> pendingWith "no GITHUB_TOKEN" + Just token -> action (OAuth $ fromString token) + +spec :: Spec +spec = do + describe "userInfoFor" $ do + it "decodes user json" $ do + let userInfo = eitherDecodeStrict $(embedFile "fixtures/user.json") + userLogin (fromRightS userInfo) `shouldBe` "mike-burns" + + it "decodes user-bot json" $ do + let userInfo = eitherDecodeStrict $(embedFile "fixtures/user-bot.json") + userLogin (fromRightS userInfo) `shouldBe` "mike-burns" + + it "returns information about the user" $ withAuth $ \auth -> do + userInfo <- github auth userInfoForR "mike-burns" + userLogin (fromRightS userInfo) `shouldBe` "mike-burns" + + it "catches http exceptions" $ withAuth $ \auth -> do + userInfo <- github auth userInfoForR "i-hope-this-user-will-never-exist" + userInfo `shouldSatisfy` isLeft + + it "should fail for organization" $ withAuth $ \auth -> do + userInfo <- github auth userInfoForR "haskell" + userInfo `shouldSatisfy` isLeft + + describe "ownerInfoFor" $ do + it "works for users and organizations" $ withAuth $ \auth -> do + 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 "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 <- github auth usersFollowingR "phadej" (GitHub.FetchAtLeast 10) + us `shouldSatisfy` isRight + + describe "usersFollowedBy" $ do + it "works" $ withAuth $ \auth -> do + us <- github auth usersFollowedByR "phadej" (GitHub.FetchAtLeast 10) + us `shouldSatisfy` isRight diff --git a/spec/Spec.hs b/spec/Spec.hs new file mode 100644 index 00000000..a824f8c3 --- /dev/null +++ b/spec/Spec.hs @@ -0,0 +1 @@ +{-# OPTIONS_GHC -F -pgmF hspec-discover #-} diff --git a/src/GitHub.hs b/src/GitHub.hs new file mode 100644 index 00000000..5d323de8 --- /dev/null +++ b/src/GitHub.hs @@ -0,0 +1,546 @@ +-- | +-- This module re-exports all request constructors and data definitions from +-- this package. +-- +-- 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 + repositoryEventsR, + userEventsR, + + -- ** Notifications + -- | See + getNotificationsR, + markNotificationAsReadR, + markAllNotificationsAsReadR, + + -- ** Starring + -- | See + -- + -- Missing endpoints: + -- + -- * Check if you are starring a repository + stargazersForR, + reposStarredByR, + myStarredR, + myStarredAcceptStarR, + starRepoR, + unstarRepoR, + + -- ** Watching + -- | See + -- + -- Missing endpoints: + -- + -- * Query a Repository Subscription + -- * Set a Repository Subscription + watchersForR, + reposWatchedByR, + unwatchRepoR, + + -- * Gists + -- | See + -- + -- Missing endpoints: + -- + -- * Query a specific revision of a gist + -- * Edit a gist + -- * List gist commits + -- * Check if a gist is starred + -- * Fork a gist + -- * List gist forks + gistsR, + gistR, + createGistR, + starGistR, + unstarGistR, + deleteGistR, + + -- ** Comments + -- | See + -- + -- Missing endpoints: + -- * Create a comment + -- * Edit a comment + -- * Delete a comment + commentsOnR, + gistCommentR, + + -- * Git Data + -- | See + + -- ** Blobs + -- | See + blobR, + + -- ** Commits + -- | See + gitCommitR, + + -- ** References + -- | See + referenceR, + referencesR, + createReferenceR, + deleteReferenceR, + namespacedReferencesR, + + -- ** Trees + -- | See + treeR, + nestedTreeR, + + -- * Issues + -- | See + -- + currentUserIssuesR, + organizationIssuesR, + issueR, + issuesForRepoR, + createIssueR, + editIssueR, + + -- ** Comments + -- | See + -- + commentR, + commentsR, + createCommentR, + deleteCommentR, + editCommentR, + + -- ** Events + -- | See + -- + eventsForIssueR, + eventsForRepoR, + eventR, + + -- ** Labels + -- | See + -- + labelsOnRepoR, + labelR, + createLabelR, + updateLabelR, + deleteLabelR, + labelsOnIssueR, + addLabelsToIssueR, + removeLabelFromIssueR, + replaceAllLabelsForIssueR, + removeAllLabelsFromIssueR, + labelsOnMilestoneR, + + -- ** Milestone + -- | See + -- + milestonesR, + milestoneR, + createMilestoneR, + updateMilestoneR, + deleteMilestoneR, + + -- * Organizations + -- | See + -- + -- Missing endpoints: + -- + -- * List your organizations + -- * List all organizations + -- * Edit an organization + publicOrganizationsForR, + publicOrganizationR, + organizationsR, + -- ** Members + -- | See + -- + -- Missing endpoints: All except /Members List/ and /Check Membership/ + membersOfR, + membersOfWithR, + isMemberOfR, + orgInvitationsR, + orgMembershipR, + -- ** Outside Collaborators + -- | See + -- + -- Missing endpoints: All except /Outside Collaborator List/ + outsideCollaboratorsR, + + -- ** Teams + -- | See + -- + -- Missing endpoints: + -- + -- * Query team member (deprecated) + -- * Add team member (deprecated) + -- * Remove team member (deprecated) + -- * Check if a team manages a repository + -- * Add team repository + -- * Remove team repository + teamsOfR, + teamInfoForR, + createTeamForR, + editTeamR, + deleteTeamR, + listTeamMembersR, + listTeamReposR, + teamMembershipInfoForR, + addTeamMembershipForR, + deleteTeamMembershipForR, + listTeamsCurrentR, + + -- * Pull Requests + -- | See + pullRequestsForR, + pullRequestR, + pullRequestPatchR, + pullRequestDiffR, + createPullRequestR, + updatePullRequestR, + pullRequestCommitsR, + pullRequestFilesR, + isPullRequestMergedR, + mergePullRequestR, + + -- ** Review comments + -- | See + -- + -- Missing endpoints: + -- + -- * List comments in a repository + -- * Edit a comment + -- * Delete a comment + pullRequestCommentsR, + pullRequestCommentR, + createPullCommentR, + createPullCommentReplyR, + + -- ** Pull request reviews + -- | See + -- + -- Missing endpoints: + -- + -- * Delete a pending review + -- * Create a pull request review + -- * Submit a pull request review + -- * Dismiss a pull request review + pullRequestReviewsR, + pullRequestReviewR, + pullRequestReviewCommentsR, + + -- * Repositories + -- | See + -- + -- Missing endpoints: + -- + -- * List all public repositories + -- * List Teams + -- * Query Branch + -- * Enabling and disabling branch protection + currentUserReposR, + userReposR, + organizationReposR, + repositoryR, + contributorsR, + languagesForR, + tagsForR, + branchesForR, + + -- ** Collaborators + -- | See + collaboratorsOnR, + collaboratorPermissionOnR, + isCollaboratorOnR, + addCollaboratorR, + + -- ** Comments + -- | See + -- + -- Missing endpoints: + -- + -- * Create a commit comment + -- * Update a commit comment + -- * Delete a commit comment + commentsForR, + commitCommentsForR, + commitCommentForR, + + -- ** Commits + -- | See + commitsForR, + commitsWithOptionsForR, + commitR, + diffR, + + -- ** 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 + -- + -- Missing endpoints: + -- + -- * Create a fork + forksForR, + + -- ** Statuses + -- | See + createStatusR, + statusesForR, + statusForR, + + -- ** Webhooks + -- | See + webhooksForR, + webhookForR, + createRepoWebhookR, + editRepoWebhookR, + testPushRepoWebhookR, + pingRepoWebhookR, + deleteRepoWebhookR, + + -- * Releases + releasesR, + releaseR, + latestReleaseR, + releaseByTagNameR, + + -- ** Invitations + -- | See + -- Missing endpoints: + + -- * Delete a repository invitation + -- * Update a repository invitation + -- * Decline a repository invitation + + listInvitationsOnR, + acceptInvitationFromR, + listInvitationsForR, + + + -- * Search + -- | See + searchReposR, + searchCodeR, + searchIssuesR, + searchUsersR, + + -- * Users + -- | See + -- + -- Missing endpoints: + -- + -- * Update the authenticated user + -- * Query all users + userInfoForR, + ownerInfoForR, + userInfoCurrentR, + + -- ** Emails + -- | See + -- + -- Missing endpoints: + -- + -- * Add email address(es) + -- * Delete email address(es) + -- * Toggle primary email visibility + currentUserEmailsR, + currentUserPublicEmailsR, + + -- ** Followers + -- | See + -- + -- Missing endpoints: + -- + -- * Check if you are following a user + -- * Check if one user follows another + -- * Follow a user + -- * Unfollow a user + usersFollowingR, + usersFollowedByR, + + -- ** 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 + module GitHub.Request, + ) 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 +import GitHub.Endpoints.Gists.Comments +import GitHub.Endpoints.GitData.Blobs +import GitHub.Endpoints.GitData.Commits +import GitHub.Endpoints.GitData.References +import GitHub.Endpoints.GitData.Trees +import GitHub.Endpoints.Issues +import GitHub.Endpoints.Issues.Comments +import GitHub.Endpoints.Issues.Events +import GitHub.Endpoints.Issues.Labels +import GitHub.Endpoints.Issues.Milestones +import GitHub.Endpoints.Organizations +import GitHub.Endpoints.Organizations.Members +import GitHub.Endpoints.Organizations.OutsideCollaborators +import GitHub.Endpoints.Organizations.Teams +import GitHub.Endpoints.PullRequests +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 +import GitHub.Endpoints.Search +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 new file mode 100644 index 00000000..cd53cd2e --- /dev/null +++ b/src/GitHub/Auth.hs @@ -0,0 +1,58 @@ +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.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 -- ^ 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 +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 new file mode 100644 index 00000000..18fb770d --- /dev/null +++ b/src/GitHub/Data.hs @@ -0,0 +1,155 @@ +-- | +-- This module re-exports the @GitHub.Data.@ and "GitHub.Auth" submodules. + +module GitHub.Data ( + -- * Tagged types + -- ** Name + Name, + mkName, + untagName, + mkOwnerName, + mkUserName, + mkTeamName, + mkOrganizationName, + mkRepoName, + mkCommitName, + fromUserName, + fromOrganizationName, + -- ** Id + Id, + mkId, + untagId, + mkOwnerId, + mkUserId, + mkTeamId, + mkOrganizationId, + mkRepoId, + fromUserId, + fromOrganizationId, + -- * IssueNumber + IssueNumber (..), + -- * Module re-exports + module GitHub.Auth, + module GitHub.Data.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, + module GitHub.Data.GitData, + module GitHub.Data.Invitation, + module GitHub.Data.Issues, + module GitHub.Data.Milestone, + module GitHub.Data.Options, + module GitHub.Data.PublicSSHKeys, + module GitHub.Data.PullRequests, + module GitHub.Data.RateLimit, + module GitHub.Data.Releases, + module GitHub.Data.Reactions, + module GitHub.Data.Repos, + module GitHub.Data.Request, + module GitHub.Data.Reviews, + module GitHub.Data.Search, + module GitHub.Data.Statuses, + module GitHub.Data.Teams, + module GitHub.Data.URL, + module GitHub.Data.Webhooks, + 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 +import GitHub.Data.GitData +import GitHub.Data.Id +import GitHub.Data.Invitation +import GitHub.Data.Issues +import GitHub.Data.Milestone +import GitHub.Data.Name +import GitHub.Data.Options +import GitHub.Data.PublicSSHKeys +import GitHub.Data.PullRequests +import GitHub.Data.RateLimit +import GitHub.Data.Releases +import GitHub.Data.Reactions +import GitHub.Data.Repos +import GitHub.Data.Request +import GitHub.Data.Reviews +import GitHub.Data.Search +import GitHub.Data.Statuses +import GitHub.Data.Teams +import GitHub.Data.URL +import GitHub.Data.Webhooks +import GitHub.Data.Webhooks.Validate + +mkOwnerId :: Int -> Id Owner +mkOwnerId = Id + +mkOwnerName :: Text -> Name Owner +mkOwnerName = N + +mkUserId :: Int -> Id User +mkUserId = Id + +mkUserName :: Text -> Name User +mkUserName = N + +mkTeamId :: Int -> Id Team +mkTeamId = Id + +mkTeamName :: Text -> Name Team +mkTeamName = N + +mkOrganizationId :: Int -> Id Organization +mkOrganizationId = Id + +mkOrganizationName :: Text -> Name Organization +mkOrganizationName = N + +mkRepoId :: Int -> Id Repo +mkRepoId = Id + +mkRepoName :: Text -> Name Repo +mkRepoName = N + +mkCommitName :: Text -> Name Commit +mkCommitName = N + +fromOrganizationName :: Name Organization -> Name Owner +fromOrganizationName = N . untagName + +fromUserName :: Name User -> Name Owner +fromUserName = N . untagName + +fromOrganizationId :: Id Organization -> Id Owner +fromOrganizationId = Id . untagId + +fromUserId :: Id User -> Id Owner +fromUserId = Id . untagId diff --git a/src/GitHub/Data/Actions/Artifacts.hs b/src/GitHub/Data/Actions/Artifacts.hs new file mode 100644 index 00000000..9d8ca28e --- /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 index 00000000..363e0ce3 --- /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 index 00000000..76a6130a --- /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 index 00000000..1e2ce31b --- /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 index 00000000..47f11f20 --- /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 index 00000000..07657e84 --- /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 index 00000000..a75fa0ff --- /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 new file mode 100644 index 00000000..b480ef21 --- /dev/null +++ b/src/GitHub/Data/Activities.hs @@ -0,0 +1,114 @@ +module GitHub.Data.Activities where + +import GitHub.Data.Id (Id, mkId) +import GitHub.Data.Repos (Repo, RepoRef) +import GitHub.Data.URL (URL) +import GitHub.Internal.Prelude + +import Prelude () + +import qualified Data.Text as T + +data RepoStarred = RepoStarred + { repoStarredStarredAt :: !UTCTime + , repoStarredRepo :: !Repo + } + deriving (Show, Data, Eq, Ord, Generic) + +instance NFData RepoStarred +instance Binary RepoStarred + +-- JSON Instances +instance FromJSON RepoStarred where + parseJSON = withObject "RepoStarred" $ \o -> RepoStarred + <$> o .: "starred_at" + <*> o .: "repo" + +data Subject = Subject + { subjectTitle :: !Text + , subjectURL :: !(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 new file mode 100644 index 00000000..c5987c77 --- /dev/null +++ b/src/GitHub/Data/Comments.hs @@ -0,0 +1,92 @@ +module GitHub.Data.Comments where + +import GitHub.Data.Definitions +import GitHub.Data.Id (Id) +import GitHub.Data.URL (URL) +import GitHub.Internal.Prelude +import Prelude () + +data Comment = Comment + { commentPosition :: !(Maybe Int) + , commentLine :: !(Maybe Int) + , commentBody :: !Text + , commentCommitId :: !(Maybe Text) + , commentUpdatedAt :: !UTCTime + , commentHtmlUrl :: !(Maybe URL) + , commentUrl :: !URL + , commentCreatedAt :: !(Maybe UTCTime) + , commentPath :: !(Maybe Text) + , commentUser :: !SimpleUser + , commentId :: !(Id Comment) + } + deriving (Show, Data, Eq, Ord, Generic) + +instance NFData Comment +instance Binary Comment + +instance FromJSON Comment where + parseJSON = withObject "Comment" $ \o -> Comment + <$> o .:? "position" + <*> o .:? "line" + <*> o .: "body" + <*> o .:? "commit_id" + <*> o .: "updated_at" + <*> o .:? "html_url" + <*> o .: "url" + <*> o .: "created_at" + <*> o .:? "path" + <*> o .: "user" + <*> o .: "id" + +data NewComment = NewComment + { newCommentBody :: !Text + } + deriving (Show, Data, Eq, Ord, Generic) + +instance NFData NewComment +instance Binary NewComment + +instance ToJSON NewComment where + toJSON (NewComment b) = object [ "body" .= b ] + +data EditComment = EditComment + { editCommentBody :: !Text + } + deriving (Show, Data, Eq, Ord, Generic) + +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 new file mode 100644 index 00000000..5e0c4b92 --- /dev/null +++ b/src/GitHub/Data/Content.hs @@ -0,0 +1,213 @@ +{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE CPP #-} + +module GitHub.Data.Content where + +import GitHub.Data.GitData +import GitHub.Data.URL +import GitHub.Internal.Prelude +import Prelude () + +import Data.Aeson.Types (Pair) +import 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, Eq, Ord, Generic) + +instance NFData Content +instance Binary Content + +data ContentFileData = ContentFileData { + contentFileInfo :: !ContentInfo + ,contentFileEncoding :: !Text + ,contentFileSize :: !Int + ,contentFileContent :: !Text +} deriving (Show, Data, Eq, Ord, Generic) + +instance NFData ContentFileData +instance Binary ContentFileData + +-- | An item in a directory listing. +data ContentItem = ContentItem { + contentItemType :: !ContentItemType + ,contentItemInfo :: !ContentInfo +} deriving (Show, Data, Eq, Ord, Generic) + +instance NFData ContentItem +instance Binary ContentItem + +data ContentItemType = ItemFile | ItemDir + deriving (Show, Data, Eq, Ord, Generic) + +instance NFData ContentItemType +instance Binary ContentItemType + +-- | Information common to both kinds of Content: files and directories. +data ContentInfo = ContentInfo { + contentName :: !Text + ,contentPath :: !Text + ,contentSha :: !Text + ,contentUrl :: !URL + ,contentGitUrl :: !URL + ,contentHtmlUrl :: !URL +} deriving (Show, Data, Eq, Ord, Generic) + +instance NFData ContentInfo +instance Binary ContentInfo + +data ContentResultInfo = ContentResultInfo + { contentResultInfo :: !ContentInfo + , contentResultSize :: !Int + } deriving (Show, Data, Eq, Ord, Generic) + +instance NFData ContentResultInfo +instance Binary ContentResultInfo + +data ContentResult = ContentResult + { contentResultContent :: !ContentResultInfo + , contentResultCommit :: !GitCommit + } deriving (Show, Data, Eq, Ord, Generic) + +instance NFData ContentResult +instance Binary ContentResult + +data Author = Author + { authorName :: !Text + , authorEmail :: !Text + } + deriving (Eq, Ord, Show, Data, Generic) + +instance NFData Author +instance Binary Author + +data CreateFile = CreateFile + { createFilePath :: !Text + , createFileMessage :: !Text + , createFileContent :: !Text + , createFileBranch :: !(Maybe Text) + , createFileAuthor :: !(Maybe Author) + , createFileCommitter :: !(Maybe Author) + } + deriving (Eq, Ord, Show, Data, Generic) + +instance NFData CreateFile +instance Binary CreateFile + +data UpdateFile = UpdateFile + { updateFilePath :: !Text + , updateFileMessage :: !Text + , updateFileContent :: !Text + , updateFileSHA :: !Text + , updateFileBranch :: !(Maybe Text) + , updateFileAuthor :: !(Maybe Author) + , updateFileCommitter :: !(Maybe Author) + } + deriving (Eq, Ord, Show, Data, Generic) + +instance NFData UpdateFile +instance Binary UpdateFile + +data DeleteFile = DeleteFile + { deleteFilePath :: !Text + , deleteFileMessage :: !Text + , deleteFileSHA :: !Text + , deleteFileBranch :: !(Maybe Text) + , deleteFileAuthor :: !(Maybe Author) + , deleteFileCommitter :: !(Maybe Author) + } + deriving (Eq, Ord, Show, Data, Generic) + +instance NFData DeleteFile +instance Binary DeleteFile + +instance FromJSON Content where + parseJSON o@(Object _) = ContentFile <$> parseJSON o + parseJSON (Array os) = ContentDirectory <$> traverse parseJSON os + parseJSON _ = fail "Could not build a Content" + +instance FromJSON ContentFileData where + parseJSON = withObject "ContentFileData" $ \o -> + ContentFileData <$> parseJSON (Object o) + <*> o .: "encoding" + <*> o .: "size" + <*> o .: "content" + +instance FromJSON ContentItem where + parseJSON = withObject "ContentItem" $ \o -> + ContentItem <$> o .: "type" + <*> parseJSON (Object o) + +instance FromJSON ContentItemType where + parseJSON = withText "ContentItemType" $ \t -> case T.toLower t of + "file" -> pure ItemFile + "dir" -> pure ItemDir + _ -> fail $ "Unknown ContentItemType: " <> T.unpack t + +instance FromJSON ContentInfo where + parseJSON = withObject "ContentInfo" $ \o -> + ContentInfo <$> o .: "name" + <*> o .: "path" + <*> o .: "sha" + <*> o .: "url" + <*> o .: "git_url" + <*> o .: "html_url" + +instance FromJSON ContentResultInfo where + parseJSON = withObject "ContentResultInfo" $ \o -> + ContentResultInfo <$> parseJSON (Object o) + <*> o .: "size" + +instance FromJSON ContentResult where + parseJSON = withObject "ContentResult" $ \o -> + ContentResult <$> o .: "content" + <*> o .: "commit" + +instance ToJSON Author where + toJSON Author {..} = object + [ "name" .= authorName + , "email" .= authorEmail + ] + +instance ToJSON CreateFile where + toJSON CreateFile {..} = object $ + [ "path" .= createFilePath + , "message" .= createFileMessage + , "content" .= createFileContent + ] + ++ "branch" .=? createFileBranch + ++ "author" .=? createFileAuthor + ++ "committer" .=? createFileCommitter + +instance ToJSON UpdateFile where + toJSON UpdateFile {..} = object $ + [ "path" .= updateFilePath + , "message" .= updateFileMessage + , "content" .= updateFileContent + , "sha" .= updateFileSHA + ] + ++ "branch" .=? updateFileBranch + ++ "author" .=? updateFileAuthor + ++ "committer" .=? updateFileCommitter + +instance ToJSON DeleteFile where + toJSON DeleteFile {..} = object $ + [ "path" .= deleteFilePath + , "message" .= deleteFileMessage + , "sha" .= deleteFileSHA + ] + ++ "branch" .=? deleteFileBranch + ++ "author" .=? deleteFileAuthor + ++ "committer" .=? deleteFileCommitter + +#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 new file mode 100644 index 00000000..12f392df --- /dev/null +++ b/src/GitHub/Data/Definitions.hs @@ -0,0 +1,388 @@ +module GitHub.Data.Definitions where + +import GitHub.Internal.Prelude +import Prelude () + +import Control.Monad (mfilter) +import Data.Aeson.Types (Parser) +import Network.HTTP.Client (HttpException) + +import qualified Control.Exception as E +import qualified Data.ByteString as BS +import qualified Data.Text as T + +import GitHub.Data.Id (Id) +import GitHub.Data.Name (Name) +import GitHub.Data.URL (URL (..)) + +-- | Errors have been tagged according to their source, so you can more easily +-- dispatch and handle them. +data Error + = HTTPError !HttpException -- ^ A HTTP error occurred. The actual caught error is included. + | ParseError !Text -- ^ An error in the parser itself. + | JsonError !Text -- ^ The JSON is malformed or unexpected. + | UserError !Text -- ^ Incorrect input. + deriving (Show) + +instance E.Exception Error + +-- | Type of the repository owners. +data OwnerType = OwnerUser | OwnerOrganization | OwnerBot + deriving (Eq, Ord, Enum, Bounded, Show, Read, Generic, Data) + +instance NFData OwnerType +instance Binary OwnerType + +data SimpleUser = SimpleUser + { simpleUserId :: !(Id User) + , simpleUserLogin :: !(Name User) + , simpleUserAvatarUrl :: !URL + , simpleUserUrl :: !URL + } + deriving (Show, Data, Eq, Ord, Generic) + +instance NFData SimpleUser +instance Binary SimpleUser + +data SimpleOrganization = SimpleOrganization + { simpleOrganizationId :: !(Id Organization) + , simpleOrganizationLogin :: !(Name Organization) + , simpleOrganizationUrl :: !URL + , simpleOrganizationAvatarUrl :: !URL + } + deriving (Show, Data, Eq, Ord, Generic) + +instance NFData SimpleOrganization +instance Binary SimpleOrganization + +-- | Sometimes we don't know the type of the owner, e.g. in 'Repo' +data SimpleOwner = SimpleOwner + { simpleOwnerId :: !(Id Owner) + , simpleOwnerLogin :: !(Name Owner) + , simpleOwnerUrl :: !URL + , simpleOwnerAvatarUrl :: !URL + , simpleOwnerType :: !OwnerType + } + deriving (Show, Data, Eq, Ord, Generic) + +instance NFData SimpleOwner +instance Binary SimpleOwner + +data User = User + { userId :: !(Id User) + , userLogin :: !(Name User) + , userName :: !(Maybe Text) + , userType :: !OwnerType -- ^ Should always be 'OwnerUser' or 'OwnerBot' + , userCreatedAt :: !UTCTime + , userPublicGists :: !Int + , userAvatarUrl :: !URL + , userFollowers :: !Int + , userFollowing :: !Int + , userHireable :: !(Maybe Bool) + , userBlog :: !(Maybe Text) + , userBio :: !(Maybe Text) + , userPublicRepos :: !Int + , userLocation :: !(Maybe Text) + , userCompany :: !(Maybe Text) + , userEmail :: !(Maybe Text) + , userUrl :: !URL + , userHtmlUrl :: !URL + } + deriving (Show, Data, Eq, Ord, Generic) + +instance NFData User +instance Binary User + +data Organization = Organization + { organizationId :: !(Id Organization) + , organizationLogin :: !(Name Organization) + , organizationName :: !(Maybe Text) + , organizationType :: !OwnerType -- ^ Should always be 'OwnerOrganization' + , organizationBlog :: !(Maybe Text) + , organizationLocation :: !(Maybe Text) + , organizationFollowers :: !Int + , organizationCompany :: !(Maybe Text) + , organizationAvatarUrl :: !URL + , organizationPublicGists :: !Int + , organizationHtmlUrl :: !URL + , organizationEmail :: !(Maybe Text) + , organizationFollowing :: !Int + , organizationPublicRepos :: !Int + , organizationUrl :: !URL + , organizationCreatedAt :: !UTCTime + } + deriving (Show, Data, Eq, Ord, Generic) + +instance NFData Organization +instance Binary Organization + +-- | In practice you can't have concrete values of 'Owner'. +newtype Owner = Owner (Either User Organization) + deriving (Show, Data, Eq, Ord, Generic) + +instance NFData Owner +instance Binary Owner + +fromOwner :: Owner -> Either User Organization +fromOwner (Owner owner) = owner + +-- JSON instances + +instance FromJSON OwnerType where + parseJSON = withText "OwnerType" $ \t -> case T.toLower t of + "user" -> pure $ OwnerUser + "organization" -> pure $ OwnerOrganization + "bot" -> pure $ OwnerBot + _ -> fail $ "Unknown OwnerType: " <> T.unpack t + +instance FromJSON SimpleUser where + parseJSON = withObject "SimpleUser" $ \obj -> do + SimpleUser + <$> obj .: "id" + <*> obj .: "login" + <*> obj .: "avatar_url" + <*> obj .: "url" + +instance FromJSON SimpleOrganization where + parseJSON = withObject "SimpleOrganization" $ \obj -> + SimpleOrganization + <$> obj .: "id" + <*> obj .: "login" + <*> obj .: "url" + <*> obj .: "avatar_url" + +instance FromJSON SimpleOwner where + parseJSON = withObject "SimpleOwner" $ \obj -> do + SimpleOwner + <$> obj .: "id" + <*> obj .: "login" + <*> obj .: "url" + <*> obj .: "avatar_url" + <*> obj .: "type" + +parseUser :: Object -> Parser User +parseUser obj = User + <$> obj .: "id" + <*> obj .: "login" + <*> obj .:? "name" + <*> obj .: "type" + <*> obj .: "created_at" + <*> obj .: "public_gists" + <*> obj .: "avatar_url" + <*> obj .: "followers" + <*> obj .: "following" + <*> obj .:? "hireable" + <*> obj .:? "blog" + <*> obj .:? "bio" + <*> obj .: "public_repos" + <*> obj .:? "location" + <*> obj .:? "company" + <*> obj .:? "email" + <*> obj .: "url" + <*> obj .: "html_url" + +parseOrganization :: Object -> Parser Organization +parseOrganization obj = Organization + <$> obj .: "id" + <*> obj .: "login" + <*> obj .:? "name" + <*> obj .: "type" + <*> obj .:? "blog" + <*> obj .:? "location" + <*> obj .: "followers" + <*> obj .:? "company" + <*> obj .: "avatar_url" + <*> obj .: "public_gists" + <*> obj .: "html_url" + <*> obj .:? "email" + <*> obj .: "following" + <*> obj .: "public_repos" + <*> obj .: "url" + <*> obj .: "created_at" + +instance FromJSON User where + parseJSON = mfilter ((/= OwnerOrganization) . userType) . withObject "User" parseUser + +instance FromJSON Organization where + parseJSON = withObject "Organization" parseOrganization + +instance FromJSON Owner where + parseJSON = withObject "Owner" $ \obj -> do + t <- obj .: "type" + case t of + OwnerUser -> Owner . Left <$> parseUser obj + OwnerBot -> Owner . Left <$> parseUser obj + OwnerOrganization -> Owner . Right <$> parseOrganization obj + +-- | Filter members returned in the list. +data OrgMemberFilter + = OrgMemberFilter2faDisabled -- ^ Members without two-factor authentication enabled. Available for organization owners. + | OrgMemberFilterAll -- ^ All members the authenticated user can see. + deriving (Show, Eq, Ord, Enum, Bounded, 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, Data, Generic) + +-- | Request query string +type QueryString = [(BS.ByteString, Maybe BS.ByteString)] + +-- | 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 +------------------------------------------------------------------------------- + +data IssueLabel = IssueLabel + { labelColor :: !Text + , labelUrl :: !URL + , labelName :: !(Name IssueLabel) + , labelDesc :: !(Maybe Text) + } + deriving (Show, Data, Eq, Ord, Generic) + +instance NFData IssueLabel +instance Binary IssueLabel + +instance FromJSON IssueLabel where + parseJSON = withObject "IssueLabel" $ \o -> IssueLabel + <$> o .: "color" + <*> o .:? "url" .!= URL "" -- in events there aren't URL + <*> o .: "name" + <*> 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 new file mode 100644 index 00000000..af43c6cf --- /dev/null +++ b/src/GitHub/Data/DeployKeys.hs @@ -0,0 +1,52 @@ +----------------------------------------------------------------------------- +-- | +-- License : BSD-3-Clause +-- Maintainer : Todd Mohney +-- +module GitHub.Data.DeployKeys where + +import GitHub.Data.Id (Id) +import GitHub.Data.URL (URL) +import GitHub.Internal.Prelude +import Prelude () + +data RepoDeployKey = RepoDeployKey + { repoDeployKeyId :: !(Id RepoDeployKey) + , repoDeployKeyKey :: !Text + , repoDeployKeyUrl :: !URL + , repoDeployKeyTitle :: !Text + , repoDeployKeyVerified :: !Bool + , repoDeployKeyCreatedAt :: !UTCTime + , repoDeployKeyReadOnly :: !Bool + } + deriving (Show, Data, Eq, Ord, Generic) + +instance FromJSON RepoDeployKey where + parseJSON = withObject "RepoDeployKey" $ \o -> RepoDeployKey + <$> o .: "id" + <*> o .: "key" + <*> o .: "url" + <*> o .: "title" + <*> o .: "verified" + <*> o .: "created_at" + <*> o .: "read_only" + +data NewRepoDeployKey = NewRepoDeployKey + { newRepoDeployKeyKey :: !Text + , newRepoDeployKeyTitle :: !Text + , newRepoDeployKeyReadOnly :: !Bool + } + deriving (Show, Data, Eq, Ord, Generic) + +instance ToJSON NewRepoDeployKey where + toJSON (NewRepoDeployKey key title readOnly) = object + [ "key" .= key + , "title" .= title + , "read_only" .= readOnly + ] + +instance FromJSON NewRepoDeployKey where + parseJSON = withObject "RepoDeployKey" $ \o -> NewRepoDeployKey + <$> o .: "key" + <*> o .: "title" + <*> o .: "read_only" diff --git a/src/GitHub/Data/Deployments.hs b/src/GitHub/Data/Deployments.hs new file mode 100644 index 00000000..043e74be --- /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 new file mode 100644 index 00000000..76efafa0 --- /dev/null +++ b/src/GitHub/Data/Email.hs @@ -0,0 +1,37 @@ +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, Eq, Ord, Generic) + +instance NFData EmailVisibility +instance Binary EmailVisibility + +instance FromJSON EmailVisibility where + parseJSON = withText "EmailVisibility" $ \t -> case T.toLower t of + "private" -> pure EmailVisibilityPrivate + "public" -> pure EmailVisibilityPublic + _ -> fail $ "Unknown EmailVisibility: " <> T.unpack t + +data Email = Email + { emailAddress :: !Text + , emailVerified :: !Bool + , emailPrimary :: !Bool + , emailVisibility :: !(Maybe EmailVisibility) + } deriving (Show, Data, Eq, Ord, Generic) + +instance NFData Email +instance Binary Email + +instance FromJSON Email where + parseJSON = withObject "Email" $ \o -> Email + <$> o .: "email" + <*> o .: "verified" + <*> o .: "primary" + <*> o .:? "visibility" diff --git a/src/GitHub/Data/Enterprise.hs b/src/GitHub/Data/Enterprise.hs new file mode 100644 index 00000000..dd5b9337 --- /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 index 00000000..02c99453 --- /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 new file mode 100644 index 00000000..4025aae7 --- /dev/null +++ b/src/GitHub/Data/Events.hs @@ -0,0 +1,29 @@ +module GitHub.Data.Events where + +import GitHub.Data.Definitions +import GitHub.Internal.Prelude +import Prelude () + +-- | Events. +-- +-- /TODO:/ +-- +-- * missing repo, org, payload, id +-- +data Event = Event + -- { eventId :: !(Id Event) -- id can be encoded as string. + { eventActor :: !SimpleUser + , eventCreatedAt :: !UTCTime + , eventPublic :: !Bool + } + deriving (Show, Data, Eq, Ord, Generic) + +instance NFData Event +instance Binary Event + +instance FromJSON Event where + parseJSON = withObject "Event" $ \obj -> Event + -- <$> obj .: "id" + <$> obj .: "actor" + <*> obj .: "created_at" + <*> obj .: "public" diff --git a/src/GitHub/Data/Gists.hs b/src/GitHub/Data/Gists.hs new file mode 100644 index 00000000..983b7a1d --- /dev/null +++ b/src/GitHub/Data/Gists.hs @@ -0,0 +1,118 @@ +module GitHub.Data.Gists where + +import GitHub.Data.Definitions +import GitHub.Data.Id (Id) +import GitHub.Data.Name (Name) +import GitHub.Data.Repos (Language) +import GitHub.Data.URL (URL) +import GitHub.Internal.Prelude +import Prelude () + +data Gist = Gist + { gistUser :: !SimpleUser + , gistGitPushUrl :: !URL + , gistUrl :: !URL + , gistDescription :: !(Maybe Text) + , gistCreatedAt :: !UTCTime + , gistPublic :: !Bool + , gistComments :: !Int + , gistUpdatedAt :: !UTCTime + , gistHtmlUrl :: !URL + , gistId :: !(Name Gist) + , gistFiles :: !(HashMap Text GistFile) + , gistGitPullUrl :: !URL + } deriving (Show, Data, Eq, Generic) + +instance NFData Gist +instance Binary Gist + +instance FromJSON Gist where + parseJSON = withObject "Gist" $ \o -> Gist + <$> o .: "owner" + <*> o .: "git_push_url" + <*> o .: "url" + <*> o .:? "description" + <*> o .: "created_at" + <*> o .: "public" + <*> o .: "comments" + <*> o .: "updated_at" + <*> o .: "html_url" + <*> o .: "id" + <*> o .: "files" + <*> o .: "git_push_url" + +data GistFile = GistFile + { gistFileType :: !Text + , gistFileRawUrl :: !URL + , gistFileSize :: !Int + , gistFileLanguage :: !(Maybe Language) + , gistFileFilename :: !Text + , gistFileContent :: !(Maybe Text) + } + deriving (Show, Data, Eq, Generic) + +instance NFData GistFile +instance Binary GistFile + +instance FromJSON GistFile where + parseJSON = withObject "GistFile" $ \o -> GistFile + <$> o .: "type" + <*> o .: "raw_url" + <*> o .: "size" + <*> o .:? "language" + <*> o .: "filename" + <*> o .:? "content" + +data GistComment = GistComment + { gistCommentUser :: !SimpleUser + , gistCommentUrl :: !URL + , gistCommentCreatedAt :: !UTCTime + , gistCommentBody :: !Text + , gistCommentUpdatedAt :: !UTCTime + , gistCommentId :: !(Id GistComment) + } + deriving (Show, Data, Eq, Ord, Generic) + +instance NFData GistComment +instance Binary GistComment + +instance FromJSON GistComment where + parseJSON = withObject "GistComment" $ \o -> GistComment + <$> o .: "user" + <*> o .: "url" + <*> o .: "created_at" + <*> o .: "body" + <*> o .: "updated_at" + <*> o .: "id" + +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 new file mode 100644 index 00000000..41158632 --- /dev/null +++ b/src/GitHub/Data/GitData.hs @@ -0,0 +1,312 @@ +module GitHub.Data.GitData where + +import GitHub.Data.Definitions +import GitHub.Data.Name (Name) +import GitHub.Data.URL (URL) +import GitHub.Internal.Prelude +import Prelude () + +import qualified Data.Vector as V + +-- | The options for querying commits. +data CommitQueryOption + = CommitQuerySha !Text + | CommitQueryPath !Text + | CommitQueryAuthor !Text + | CommitQuerySince !UTCTime + | CommitQueryUntil !UTCTime + deriving (Show, Eq, Ord, Generic, Data) + +data Stats = Stats + { statsAdditions :: !Int + , statsTotal :: !Int + , statsDeletions :: !Int + } + deriving (Show, Data, Eq, Ord, Generic) + +instance NFData Stats +instance Binary Stats + +data Commit = Commit + { commitSha :: !(Name Commit) + , commitParents :: !(Vector Tree) + , commitUrl :: !URL + , commitGitCommit :: !GitCommit + , commitCommitter :: !(Maybe SimpleUser) + , commitAuthor :: !(Maybe SimpleUser) + , commitFiles :: !(Vector File) + , commitStats :: !(Maybe Stats) + } + deriving (Show, Data, Eq, Ord, Generic) + +instance NFData Commit +instance Binary Commit + +data Tree = Tree + { treeSha :: !(Name Tree) + , treeUrl :: !URL + , treeGitTrees :: !(Vector GitTree) + } + deriving (Show, Data, Eq, Ord, Generic) + +instance NFData Tree +instance Binary Tree + +data GitTree = GitTree + { gitTreeType :: !Text + , gitTreeSha :: !(Name GitTree) + -- Can be empty for submodule + , gitTreeUrl :: !(Maybe URL) + , gitTreeSize :: !(Maybe Int) + , gitTreePath :: !Text + , gitTreeMode :: !Text + } + deriving (Show, Data, Eq, Ord, Generic) + +instance NFData GitTree +instance Binary GitTree + +data GitCommit = GitCommit + { gitCommitMessage :: !Text + , gitCommitUrl :: !URL + , gitCommitCommitter :: !GitUser + , gitCommitAuthor :: !GitUser + , gitCommitTree :: !Tree + , gitCommitSha :: !(Maybe (Name GitCommit)) + , gitCommitParents :: !(Vector Tree) + } + deriving (Show, Data, Eq, Ord, Generic) + +instance NFData GitCommit +instance Binary GitCommit + +data Blob = Blob + { blobUrl :: !URL + , blobEncoding :: !Text + , blobContent :: !Text + , blobSha :: !(Name Blob) + , blobSize :: !Int + } + deriving (Show, Data, Eq, Ord, Generic) + +instance NFData Blob +instance Binary Blob + +data Tag = Tag + { tagName :: !Text + , tagZipballUrl :: !URL + , tagTarballUrl :: !URL + , tagCommit :: !BranchCommit + } + deriving (Show, Data, Eq, Ord, Generic) + +instance NFData Tag +instance Binary Tag + +data Branch = Branch + { branchName :: !Text + , branchCommit :: !BranchCommit + } + deriving (Show, Data, Eq, Ord, Generic) + +instance NFData Branch + +data BranchCommit = BranchCommit + { branchCommitSha :: !Text + , branchCommitUrl :: !URL + } + deriving (Show, Data, Eq, Ord, Generic) + +instance NFData BranchCommit +instance Binary BranchCommit + +data Diff = Diff + { diffStatus :: !Text + , diffBehindBy :: !Int + , diffPatchUrl :: !URL + , diffUrl :: !URL + , diffBaseCommit :: !Commit + , diffCommits :: !(Vector Commit) + , diffTotalCommits :: !Int + , diffHtmlUrl :: !URL + , diffFiles :: !(Vector File) + , diffAheadBy :: !Int + , diffDiffUrl :: !URL + , diffPermalinkUrl :: !URL + } + deriving (Show, Data, Eq, Ord, Generic) + +instance NFData Diff +instance Binary Diff + +data NewGitReference = NewGitReference + { newGitReferenceRef :: !Text + , newGitReferenceSha :: !Text + } + deriving (Show, Data, Eq, Ord, Generic) + +instance NFData NewGitReference +instance Binary NewGitReference + +data GitReference = GitReference + { gitReferenceObject :: !GitObject + , gitReferenceUrl :: !URL + , gitReferenceRef :: !(Name GitReference) + } + deriving (Show, Data, Eq, Ord, Generic) + +instance NFData GitReference +instance Binary GitReference + +data GitObject = GitObject + { gitObjectType :: !Text + , gitObjectSha :: !Text + , gitObjectUrl :: !URL + } + deriving (Show, Data, Eq, Ord, Generic) + +instance NFData GitObject +instance Binary GitObject + +data GitUser = GitUser + { gitUserName :: !Text + , gitUserEmail :: !Text + , gitUserDate :: !UTCTime + } + deriving (Show, Data, Eq, Ord, Generic) + +instance NFData GitUser +instance Binary GitUser + +data File = File + { fileBlobUrl :: !(Maybe URL) + , fileStatus :: !Text + , fileRawUrl :: !(Maybe URL) + , fileAdditions :: !Int + , fileSha :: !(Maybe Text) + , fileChanges :: !Int + , filePatch :: !(Maybe Text) + , fileFilename :: !Text + , fileDeletions :: !Int + } + deriving (Show, Data, Eq, Ord, Generic) + +instance NFData File +instance Binary File + +-- JSON instances + +instance FromJSON Stats where + parseJSON = withObject "Stats" $ \o -> Stats + <$> o .: "additions" + <*> o .: "total" + <*> o .: "deletions" + +instance FromJSON Commit where + parseJSON = withObject "Commit" $ \o -> Commit + <$> o .: "sha" + <*> o .: "parents" + <*> o .: "url" + <*> o .: "commit" + <*> o .:? "committer" + <*> o .:? "author" + <*> o .:? "files" .!= V.empty + <*> o .:? "stats" + +instance FromJSON Tree where + parseJSON = withObject "Tree" $ \o -> Tree + <$> o .: "sha" + <*> o .: "url" + <*> o .:? "tree" .!= V.empty + +instance FromJSON GitTree where + parseJSON = withObject "GitTree" $ \o -> GitTree + <$> o .: "type" + <*> o .: "sha" + <*> o .:? "url" + <*> o .:? "size" + <*> o .: "path" + <*> o .: "mode" + +instance FromJSON GitCommit where + parseJSON = withObject "GitCommit" $ \o -> GitCommit + <$> o .: "message" + <*> o .: "url" + <*> o .: "committer" + <*> o .: "author" + <*> o .: "tree" + <*> o .:? "sha" + <*> o .:? "parents" .!= V.empty + +instance FromJSON GitUser where + parseJSON = withObject "GitUser" $ \o -> GitUser + <$> o .: "name" + <*> o .: "email" + <*> o .: "date" + +instance FromJSON File where + parseJSON = withObject "File" $ \o -> File + <$> o .:? "blob_url" + <*> o .: "status" + <*> o .:? "raw_url" + <*> o .: "additions" + <*> o .:? "sha" + <*> o .: "changes" + <*> o .:? "patch" + <*> o .: "filename" + <*> o .: "deletions" + +instance ToJSON NewGitReference where + toJSON (NewGitReference r s) = object [ "ref" .= r, "sha" .= s ] + +instance FromJSON GitReference where + parseJSON = withObject "GitReference" $ \o -> GitReference + <$> o .: "object" + <*> o .: "url" + <*> o .: "ref" + +instance FromJSON GitObject where + parseJSON = withObject "GitObject" $ \o -> GitObject + <$> o .: "type" + <*> o .: "sha" + <*> o .: "url" + +instance FromJSON Diff where + parseJSON = withObject "Diff" $ \o -> Diff + <$> o .: "status" + <*> o .: "behind_by" + <*> o .: "patch_url" + <*> o .: "url" + <*> o .: "base_commit" + <*> o .:? "commits" .!= V.empty + <*> o .: "total_commits" + <*> o .: "html_url" + <*> o .:? "files" .!= V.empty + <*> o .: "ahead_by" + <*> o .: "diff_url" + <*> o .: "permalink_url" + +instance FromJSON Blob where + parseJSON = withObject "Blob" $ \o -> Blob + <$> o .: "url" + <*> o .: "encoding" + <*> o .: "content" + <*> o .: "sha" + <*> o .: "size" + +instance FromJSON Tag where + parseJSON = withObject "Tag" $ \o -> Tag + <$> o .: "name" + <*> o .: "zipball_url" + <*> o .: "tarball_url" + <*> o .: "commit" + +instance FromJSON Branch where + parseJSON = withObject "Branch" $ \o -> Branch + <$> o .: "name" + <*> o .: "commit" + +instance FromJSON BranchCommit where + parseJSON = withObject "BranchCommit" $ \o -> BranchCommit + <$> o .: "sha" + <*> o .: "url" diff --git a/src/GitHub/Data/Id.hs b/src/GitHub/Data/Id.hs new file mode 100644 index 00000000..6c18c2e2 --- /dev/null +++ b/src/GitHub/Data/Id.hs @@ -0,0 +1,31 @@ +module GitHub.Data.Id ( + Id(..), + mkId, + untagId, + ) where + +import GitHub.Internal.Prelude +import Prelude () + +-- | Numeric identifier. +newtype Id entity = Id Int + deriving (Eq, Ord, Show, Generic, Data) + +-- | Smart constructor for 'Id'. +mkId :: proxy entity -> Int -> Id entity +mkId _ = Id + +untagId :: Id entity -> Int +untagId (Id name) = name + +instance Hashable (Id entity) +instance Binary (Id entity) + +instance NFData (Id entity) where + rnf (Id s) = rnf s + +instance FromJSON (Id entity) where + parseJSON = fmap Id . parseJSON + +instance ToJSON (Id entity) where + toJSON = toJSON . untagId diff --git a/src/GitHub/Data/Invitation.hs b/src/GitHub/Data/Invitation.hs new file mode 100644 index 00000000..5818a296 --- /dev/null +++ b/src/GitHub/Data/Invitation.hs @@ -0,0 +1,82 @@ +module GitHub.Data.Invitation where + +import GitHub.Data.Definitions +import GitHub.Data.Id (Id) +import GitHub.Data.Name (Name) +import GitHub.Data.Repos (Repo) +import GitHub.Data.URL (URL) +import GitHub.Internal.Prelude +import Prelude () + +import qualified Data.Text as T + +data Invitation = Invitation + { invitationId :: !(Id Invitation) + -- TODO: technically either one should be, maybe both. use `these` ? + , invitationLogin :: !(Maybe (Name User)) + , invitationEmail :: !(Maybe Text) + , invitationRole :: !InvitationRole + , invitationCreatedAt :: !UTCTime + , inviter :: !SimpleUser + } + deriving (Show, Data, Eq, Ord, Generic) + +instance NFData Invitation +instance Binary Invitation + +instance FromJSON Invitation where + parseJSON = withObject "Invitation" $ \o -> Invitation + <$> o .: "id" + <*> o .:? "login" + <*> o .:? "email" + <*> o .: "role" + <*> o .: "created_at" + <*> o .: "inviter" + + +data InvitationRole + = InvitationRoleDirectMember + | InvitationRoleAdmin + | InvitationRoleBillingManager + | InvitationRoleHiringManager + | InvitationRoleReinstate + deriving + (Eq, Ord, Show, Enum, Bounded, Generic, Data) + +instance NFData InvitationRole +instance Binary InvitationRole + +instance FromJSON InvitationRole where + parseJSON = withText "InvitationRole" $ \t -> case T.toLower t of + "direct_member" -> pure InvitationRoleDirectMember + "admin" -> pure InvitationRoleAdmin + "billing_manager" -> pure InvitationRoleBillingManager + "hiring_manager" -> pure InvitationRoleHiringManager + "reinstate" -> pure InvitationRoleReinstate + _ -> fail $ "Unknown InvitationRole: " <> T.unpack t + +data RepoInvitation = RepoInvitation + { repoInvitationId :: !(Id RepoInvitation) + , repoInvitationInvitee :: !SimpleUser + , repoInvitationInviter :: !SimpleUser + , repoInvitationRepo :: !Repo + , repoInvitationUrl :: !URL + , repoInvitationCreatedAt :: !UTCTime + , repoInvitationPermission :: !Text + , repoInvitationHtmlUrl :: !URL + } + deriving (Show, Data, 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 new file mode 100644 index 00000000..2f815c0d --- /dev/null +++ b/src/GitHub/Data/Issues.hs @@ -0,0 +1,227 @@ +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, IssueStateReason) +import GitHub.Data.PullRequests +import GitHub.Data.URL (URL) +import GitHub.Internal.Prelude +import Prelude () + +import qualified Data.Text as T + +data Issue = Issue + { issueClosedAt :: !(Maybe UTCTime) + , issueUpdatedAt :: !UTCTime + , issueEventsUrl :: !URL + , issueHtmlUrl :: !(Maybe URL) + , issueClosedBy :: !(Maybe SimpleUser) + , issueLabels :: !(Vector IssueLabel) + , issueNumber :: !IssueNumber + , issueAssignees :: !(Vector SimpleUser) + , issueUser :: !SimpleUser + , issueTitle :: !Text + , issuePullRequest :: !(Maybe PullRequestReference) + , issueUrl :: !URL + , issueCreatedAt :: !UTCTime + , issueBody :: !(Maybe Text) + , issueState :: !IssueState + , issueId :: !(Id Issue) + , issueComments :: !Int + , issueMilestone :: !(Maybe Milestone) + , issueStateReason :: !(Maybe IssueStateReason) + } + deriving (Show, Data, Eq, Ord, Generic) + +instance NFData Issue +instance Binary Issue + +data NewIssue = NewIssue + { newIssueTitle :: !Text + , newIssueBody :: !(Maybe Text) + , newIssueAssignees :: !(Vector (Name User)) + , newIssueMilestone :: !(Maybe (Id Milestone)) + , newIssueLabels :: !(Maybe (Vector (Name IssueLabel))) + } + deriving (Show, Data, Eq, Ord, Generic) + +instance NFData NewIssue +instance Binary NewIssue + +data EditIssue = EditIssue + { editIssueTitle :: !(Maybe Text) + , editIssueBody :: !(Maybe Text) + , editIssueAssignees :: !(Maybe (Vector (Name User))) + , editIssueState :: !(Maybe IssueState) + , editIssueMilestone :: !(Maybe (Id Milestone)) + , editIssueLabels :: !(Maybe (Vector (Name IssueLabel))) + } + deriving (Show, Data, Eq, Ord, Generic) + +instance NFData EditIssue +instance Binary EditIssue + +data IssueComment = IssueComment + { issueCommentUpdatedAt :: !UTCTime + , issueCommentUser :: !SimpleUser + , issueCommentUrl :: !URL + , issueCommentHtmlUrl :: !URL + , issueCommentCreatedAt :: !UTCTime + , issueCommentBody :: !Text + , issueCommentId :: !Int + } + deriving (Show, Data, Eq, Ord, Generic) + +instance NFData IssueComment +instance Binary IssueComment + +-- | See +data EventType + = Mentioned -- ^ The actor was @mentioned in an issue body. + | Subscribed -- ^ The actor subscribed to receive notifications for an issue. + | Unsubscribed -- ^ The issue was unsubscribed from by the actor. + | Referenced -- ^ The issue was referenced from a commit message. The commit_id attribute is the commit SHA1 of where that happened. + | Merged -- ^ The issue was merged by the actor. The commit_id attribute is the SHA1 of the HEAD commit that was merged. + | Assigned -- ^ The issue was assigned to the actor. + | Closed -- ^ The issue was closed by the actor. When the commit_id is present, it identifies the commit that closed the issue using “closes / fixes #NN” syntax. + | Reopened -- ^ The issue was reopened by the actor. + | ActorUnassigned -- ^ The issue was unassigned to the actor + | Labeled -- ^ A label was added to the issue. + | Unlabeled -- ^ A label was removed from the issue. + | Milestoned -- ^ The issue was added to a milestone. + | Demilestoned -- ^ The issue was removed from a milestone. + | Renamed -- ^ The issue title was changed. + | Locked -- ^ The issue was locked by the actor. + | Unlocked -- ^ The issue was unlocked by the actor. + | HeadRefDeleted -- ^ The pull request’s branch was deleted. + | HeadRefRestored -- ^ The pull request’s branch was restored. + | ReviewRequested -- ^ The actor requested review from the subject on this pull request. + | ReviewDismissed -- ^ The actor dismissed a review from the pull request. + | ReviewRequestRemoved -- ^ The actor removed the review request for the subject on this pull request. + | MarkedAsDuplicate -- ^ A user with write permissions marked an issue as a duplicate of another issue or a pull request as a duplicate of another pull request. + | UnmarkedAsDuplicate -- ^ An issue that a user had previously marked as a duplicate of another issue is no longer considered a duplicate, or a pull request that a user had previously marked as a duplicate of another pull request is no longer considered a duplicate. + | AddedToProject -- ^ The issue was added to a project board. + | MovedColumnsInProject -- ^ The issue was moved between columns in a project board. + | RemovedFromProject -- ^ The issue was removed from a project board. + | ConvertedNoteToIssue -- ^ The issue was created by converting a note in a project board to an issue. + deriving (Show, Data, Enum, Bounded, Eq, Ord, Generic) + +instance NFData EventType +instance Binary EventType + +-- | Issue event +data IssueEvent = IssueEvent + { issueEventActor :: !SimpleUser + , issueEventType :: !EventType + , issueEventCommitId :: !(Maybe Text) + , issueEventUrl :: !URL + , issueEventCreatedAt :: !UTCTime + , issueEventId :: !Int + , issueEventIssue :: !(Maybe Issue) + , issueEventLabel :: !(Maybe IssueLabel) + } + deriving (Show, Data, Eq, Ord, Generic) + +instance NFData IssueEvent +instance Binary IssueEvent + +instance FromJSON IssueEvent where + parseJSON = withObject "Event" $ \o -> IssueEvent + <$> o .: "actor" + <*> o .: "event" + <*> o .:? "commit_id" + <*> o .: "url" + <*> o .: "created_at" + <*> o .: "id" + <*> o .:? "issue" + <*> o .:? "label" + +instance FromJSON EventType where + parseJSON = withText "EventType" $ \t -> case T.toLower t of + "closed" -> pure Closed + "reopened" -> pure Reopened + "subscribed" -> pure Subscribed + "merged" -> pure Merged + "referenced" -> pure Referenced + "mentioned" -> pure Mentioned + "assigned" -> pure Assigned + "unassigned" -> pure ActorUnassigned + "labeled" -> pure Labeled + "unlabeled" -> pure Unlabeled + "milestoned" -> pure Milestoned + "demilestoned" -> pure Demilestoned + "renamed" -> pure Renamed + "locked" -> pure Locked + "unlocked" -> pure Unlocked + "head_ref_deleted" -> pure HeadRefDeleted + "head_ref_restored" -> pure HeadRefRestored + "review_requested" -> pure ReviewRequested + "review_dismissed" -> pure ReviewDismissed + "review_request_removed" -> pure ReviewRequestRemoved + "marked_as_duplicate" -> pure MarkedAsDuplicate + "unmarked_as_duplicate" -> pure UnmarkedAsDuplicate + "added_to_project" -> pure AddedToProject + "moved_columns_in_project" -> pure MovedColumnsInProject + "removed_from_project" -> pure RemovedFromProject + "converted_note_to_issue" -> pure ConvertedNoteToIssue + "unsubscribed" -> pure Unsubscribed -- not in api docs list + _ -> fail $ "Unknown EventType: " <> T.unpack t + +instance FromJSON IssueComment where + parseJSON = withObject "IssueComment" $ \o -> IssueComment + <$> o .: "updated_at" + <*> o .: "user" + <*> o .: "url" + <*> o .: "html_url" + <*> o .: "created_at" + <*> o .: "body" + <*> o .: "id" + +instance FromJSON Issue where + parseJSON = withObject "Issue" $ \o -> Issue + <$> o .:? "closed_at" + <*> o .: "updated_at" + <*> o .: "events_url" + <*> o .: "html_url" + <*> o .:? "closed_by" + <*> o .: "labels" + <*> o .: "number" + <*> o .: "assignees" + <*> o .: "user" + <*> o .: "title" + <*> o .:? "pull_request" + <*> o .: "url" + <*> o .: "created_at" + <*> o .: "body" + <*> o .: "state" + <*> o .: "id" + <*> o .: "comments" + <*> o .:? "milestone" + <*> o .:? "state_reason" + +instance ToJSON NewIssue where + toJSON (NewIssue t b a m ls) = object $ filter notNull + [ "title" .= t + , "body" .= b + , "assignees" .= a + , "milestone" .= m + , "labels" .= ls + ] + where + notNull (_, Null) = False + notNull (_, _) = True + +instance ToJSON EditIssue where + toJSON (EditIssue t b a s m ls) = object $ filter notNull + [ "title" .= t + , "body" .= b + , "assignees" .= a + , "state" .= s + , "milestone" .= m + , "labels" .= ls + ] + where + notNull (_, Null) = False + notNull (_, _) = True diff --git a/src/GitHub/Data/Milestone.hs b/src/GitHub/Data/Milestone.hs new file mode 100644 index 00000000..789b2324 --- /dev/null +++ b/src/GitHub/Data/Milestone.hs @@ -0,0 +1,83 @@ +module GitHub.Data.Milestone where + +import GitHub.Data.Definitions +import GitHub.Data.Id (Id) +import GitHub.Data.URL (URL) +import GitHub.Internal.Prelude +import Prelude () + +data Milestone = Milestone + { milestoneCreator :: !SimpleUser + , milestoneDueOn :: !(Maybe UTCTime) + , milestoneOpenIssues :: !Int + , milestoneNumber :: !(Id Milestone) + , milestoneClosedIssues :: !Int + , milestoneDescription :: !(Maybe Text) + , milestoneTitle :: !Text + , milestoneUrl :: !URL + , milestoneCreatedAt :: !UTCTime + , milestoneState :: !Text + } + deriving (Show, Data, Eq, Ord, Generic) + +instance NFData Milestone +instance Binary Milestone + +instance FromJSON Milestone where + parseJSON = withObject "Milestone" $ \o -> Milestone + <$> o .: "creator" + <*> o .: "due_on" + <*> o .: "open_issues" + <*> o .: "number" + <*> o .: "closed_issues" + <*> o .: "description" + <*> o .: "title" + <*> o .: "url" + <*> o .: "created_at" + <*> o .: "state" + +data NewMilestone = NewMilestone + { newMilestoneTitle :: !Text + , newMilestoneState :: !Text + , newMilestoneDescription :: !(Maybe Text) + , newMilestoneDueOn :: !(Maybe UTCTime) + } + deriving (Show, Data, 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 new file mode 100644 index 00000000..a9ecf8e5 --- /dev/null +++ b/src/GitHub/Data/Name.hs @@ -0,0 +1,44 @@ +module GitHub.Data.Name ( + Name(..), + mkName, + untagName, + ) where + +import Prelude () +import GitHub.Internal.Prelude + +import Data.Aeson.Types + (FromJSONKey (..), ToJSONKey (..), fromJSONKeyCoerce, toJSONKeyText) + +newtype Name entity = N Text + deriving (Eq, Ord, Show, Generic, Data) + +-- | Smart constructor for 'Name' +mkName :: proxy entity -> Text -> Name entity +mkName _ = N + +untagName :: Name entity -> Text +untagName (N name) = name + +instance Hashable (Name entity) +instance Binary (Name entity) + +instance NFData (Name entity) where + rnf (N s) = rnf s + +instance FromJSON (Name entity) where + parseJSON = fmap N . parseJSON + +instance ToJSON (Name entity) where + toJSON = toJSON . untagName + +instance IsString (Name entity) where + fromString = N . fromString + +-- | @since 0.15.0.0 +instance ToJSONKey (Name entity) where + toJSONKey = toJSONKeyText untagName + +-- | @since 0.15.0.0 +instance FromJSONKey (Name entity) where + fromJSONKey = fromJSONKeyCoerce diff --git a/src/GitHub/Data/Options.hs b/src/GitHub/Data/Options.hs new file mode 100644 index 00000000..da137f0f --- /dev/null +++ b/src/GitHub/Data/Options.hs @@ -0,0 +1,939 @@ +{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE LambdaCase #-} + +-- | +-- Module with modifiers for pull requests' and issues' listings. + +module GitHub.Data.Options ( + -- * Common modifiers + stateOpen, + stateClosed, + stateAll, + sortAscending, + sortDescending, + sortByCreated, + sortByUpdated, + -- * Pull Requests + PullRequestMod, + prModToQueryString, + optionsBase, + optionsNoBase, + optionsHead, + optionsNoHead, + sortByPopularity, + sortByLongRunning, + -- * Issues + IssueMod, + issueModToQueryString, + sortByComments, + optionsLabels, + optionsSince, + optionsSinceAll, + optionsAssignedIssues, + optionsCreatedIssues, + optionsMentionedIssues, + optionsSubscribedIssues, + optionsAllIssues, + -- * Repo issues + IssueRepoMod, + issueRepoModToQueryString, + 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, + HasDirection, + HasCreatedUpdated, + HasComments, + HasLabels, + HasSince, + ) where + +import GitHub.Data.Definitions +import GitHub.Data.Id (Id, untagId) +import GitHub.Data.Milestone (Milestone) +import GitHub.Data.Name (Name, untagName) +import GitHub.Internal.Prelude +import Prelude () + +import qualified Data.Text as T +import qualified Data.Text.Encoding as TE + +------------------------------------------------------------------------------- +-- Data +------------------------------------------------------------------------------- + +-- | 'GitHub.Data.Issues.Issue' or 'GitHub.Data.PullRequests.PullRequest' state +data IssueState + = StateOpen + | StateClosed + deriving + (Eq, Ord, Show, Enum, Bounded, Generic, Data) + +instance ToJSON IssueState where + toJSON StateOpen = String "open" + toJSON StateClosed = String "closed" + +instance FromJSON IssueState where + parseJSON = withText "IssueState" $ \t -> case T.toLower t of + "open" -> pure StateOpen + "closed" -> pure StateClosed + _ -> fail $ "Unknown IssueState: " <> T.unpack t + +instance NFData IssueState +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 + | StateClean + | StateDirty + | StateUnstable + | StateBlocked + | StateBehind + | StateDraft + deriving + (Eq, Ord, Show, Enum, Bounded, Generic, Data) + +instance ToJSON MergeableState where + toJSON StateUnknown = String "unknown" + toJSON StateClean = String "clean" + toJSON StateDirty = String "dirty" + toJSON StateUnstable = String "unstable" + toJSON StateBlocked = String "blocked" + toJSON StateBehind = String "behind" + toJSON StateDraft = String "draft" + +instance FromJSON MergeableState where + parseJSON = withText "MergeableState" $ \t -> case T.toLower t of + "unknown" -> pure StateUnknown + "clean" -> pure StateClean + "dirty" -> pure StateDirty + "unstable" -> pure StateUnstable + "blocked" -> pure StateBlocked + "behind" -> pure StateBehind + "draft" -> pure StateDraft + _ -> fail $ "Unknown MergeableState: " <> T.unpack t + +instance NFData MergeableState +instance Binary MergeableState + +data SortDirection + = SortAscending + | SortDescending + deriving + (Eq, Ord, Show, Enum, Bounded, Generic, Data) + +instance NFData SortDirection +instance Binary SortDirection + +-- PR + +data SortPR + = SortPRCreated + | SortPRUpdated + | SortPRPopularity + | SortPRLongRunning + deriving + (Eq, Ord, Show, Enum, Bounded, Generic, Data) + +instance NFData SortPR +instance Binary SortPR + +-- Issue +data IssueFilter + = IssueFilterAssigned + | IssueFilterCreated + | IssueFilterMentioned + | IssueFilterSubscribed + | IssueFilterAll + deriving + (Eq, Ord, Show, Enum, Bounded, Generic, Data) + +instance NFData IssueFilter +instance Binary IssueFilter + +data SortIssue + = SortIssueCreated + | SortIssueUpdated + | SortIssueComments + deriving + (Eq, Ord, Show, Enum, Bounded, Generic, Data) + +instance NFData SortIssue +instance Binary SortIssue + +data FilterBy a + = FilterAny + | FilterNone + | FilterBy a + | FilterNotSpecified + -- ^ e.g. for milestones "any" means "any milestone". + -- I.e. won't show issues without mileston specified + deriving + (Eq, Ord, Show, Generic, Data) + +-- Actions cache + +data SortCache + = SortCacheCreatedAt + | SortCacheLastAccessedAt + | SortCacheSizeInBytes + deriving + (Eq, Ord, Show, Enum, Bounded, Generic, Data) + +instance NFData SortCache +instance Binary SortCache + +------------------------------------------------------------------------------- +-- Classes +------------------------------------------------------------------------------- + +class HasState mod where + state :: Maybe IssueState -> mod + +stateOpen :: HasState mod => mod +stateOpen = state (Just StateOpen) + +stateClosed :: HasState mod => mod +stateClosed = state (Just StateClosed) + +stateAll :: HasState mod => mod +stateAll = state Nothing + +instance HasState PullRequestMod where + state s = PRMod $ \opts -> + opts { pullRequestOptionsState = s } + +instance HasState IssueMod where + state s = IssueMod $ \opts -> + opts { issueOptionsState = s } + +instance HasState IssueRepoMod where + state s = IssueRepoMod $ \opts -> + opts { issueRepoOptionsState = s } + + +class HasDirection mod where + sortDir :: SortDirection -> mod + +sortAscending :: HasDirection mod => mod +sortAscending = sortDir SortAscending + +sortDescending :: HasDirection mod => mod +sortDescending = sortDir SortDescending + +instance HasDirection PullRequestMod where + sortDir x = PRMod $ \opts -> + opts { pullRequestOptionsDirection = x } + +instance HasDirection IssueMod where + sortDir x = IssueMod $ \opts -> + opts { issueOptionsDirection = x } + +instance HasDirection IssueRepoMod where + sortDir x = IssueRepoMod $ \opts -> + opts { issueRepoOptionsDirection = x } + + +class HasCreatedUpdated mod where + sortByCreated :: mod + sortByUpdated :: mod + +instance HasCreatedUpdated PullRequestMod where + sortByCreated = PRMod $ \opts -> + opts { pullRequestOptionsSort = SortPRCreated } + sortByUpdated = PRMod $ \opts -> + opts { pullRequestOptionsSort = SortPRUpdated } + +instance HasCreatedUpdated IssueMod where + sortByCreated = IssueMod $ \opts -> + opts { issueOptionsSort = SortIssueCreated } + sortByUpdated = IssueMod $ \opts -> + opts { issueOptionsSort = SortIssueUpdated } + +instance HasCreatedUpdated IssueRepoMod where + sortByCreated = IssueRepoMod $ \opts -> + opts { issueRepoOptionsSort = SortIssueCreated } + sortByUpdated = IssueRepoMod $ \opts -> + opts { issueRepoOptionsSort = SortIssueUpdated } + +------------------------------------------------------------------------------- +-- Pull Request +------------------------------------------------------------------------------- + +-- | See . +data PullRequestOptions = PullRequestOptions + { pullRequestOptionsState :: !(Maybe IssueState) + , pullRequestOptionsHead :: !(Maybe Text) + , pullRequestOptionsBase :: !(Maybe Text) + , pullRequestOptionsSort :: !SortPR + , pullRequestOptionsDirection :: !SortDirection + } + deriving + (Eq, Ord, Show, Generic, Data) + +defaultPullRequestOptions :: PullRequestOptions +defaultPullRequestOptions = PullRequestOptions + { pullRequestOptionsState = Just StateOpen + , pullRequestOptionsHead = Nothing + , pullRequestOptionsBase = Nothing + , pullRequestOptionsSort = SortPRCreated + , pullRequestOptionsDirection = SortDescending + } + +-- | See . +newtype PullRequestMod = PRMod (PullRequestOptions -> PullRequestOptions) + +instance Semigroup PullRequestMod where + PRMod f <> PRMod g = PRMod (g . f) + +instance Monoid PullRequestMod where + mempty = PRMod id + mappend = (<>) + +toPullRequestOptions :: PullRequestMod -> PullRequestOptions +toPullRequestOptions (PRMod f) = f defaultPullRequestOptions + +prModToQueryString :: PullRequestMod -> QueryString +prModToQueryString = pullRequestOptionsToQueryString . toPullRequestOptions + +pullRequestOptionsToQueryString :: PullRequestOptions -> QueryString +pullRequestOptionsToQueryString (PullRequestOptions st head_ base sort dir) = + [ mk "state" state' + , mk "sort" sort' + , mk "direction" direction' + ] ++ catMaybes + [ mk "head" <$> head' + , mk "base" <$> base' + ] + where + mk k v = (k, Just v) + state' = case st of + Nothing -> "all" + Just StateOpen -> "open" + Just StateClosed -> "closed" + sort' = case sort of + SortPRCreated -> "created" + SortPRUpdated -> "updated" + SortPRPopularity -> "popularity" + SortPRLongRunning -> "long-running" + direction' = case dir of + SortDescending -> "desc" + SortAscending -> "asc" + head' = fmap TE.encodeUtf8 head_ + base' = fmap TE.encodeUtf8 base + +------------------------------------------------------------------------------- +-- Pull request modifiers +------------------------------------------------------------------------------- + +optionsBase :: Text -> PullRequestMod +optionsBase x = PRMod $ \opts -> + opts { pullRequestOptionsBase = Just x } + +optionsNoBase :: PullRequestMod +optionsNoBase = PRMod $ \opts -> + opts { pullRequestOptionsBase = Nothing } + +optionsHead :: Text -> PullRequestMod +optionsHead x = PRMod $ \opts -> + opts { pullRequestOptionsHead = Just x } + +optionsNoHead :: PullRequestMod +optionsNoHead = PRMod $ \opts -> + opts { pullRequestOptionsHead = Nothing } + +sortByPopularity :: PullRequestMod +sortByPopularity = PRMod $ \opts -> + opts { pullRequestOptionsSort = SortPRPopularity } + +sortByLongRunning :: PullRequestMod +sortByLongRunning = PRMod $ \opts -> + opts { pullRequestOptionsSort = SortPRLongRunning } + +------------------------------------------------------------------------------- +-- Issues +------------------------------------------------------------------------------- + +-- | See . +data IssueOptions = IssueOptions + { issueOptionsFilter :: !IssueFilter + , issueOptionsState :: !(Maybe IssueState) + , issueOptionsLabels :: ![Name IssueLabel] -- TODO: change to newtype + , issueOptionsSort :: !SortIssue + , issueOptionsDirection :: !SortDirection + , issueOptionsSince :: !(Maybe UTCTime) + } + deriving + (Eq, Ord, Show, Generic, Data) + +defaultIssueOptions :: IssueOptions +defaultIssueOptions = IssueOptions + { issueOptionsFilter = IssueFilterAssigned + , issueOptionsState = Just StateOpen + , issueOptionsLabels = [] + , issueOptionsSort = SortIssueCreated + , issueOptionsDirection = SortDescending + , issueOptionsSince = Nothing + } + +-- | See . +newtype IssueMod = IssueMod (IssueOptions -> IssueOptions) + +instance Semigroup IssueMod where + IssueMod f <> IssueMod g = IssueMod (g . f) + +instance Monoid IssueMod where + mempty = IssueMod id + mappend = (<>) + +toIssueOptions :: IssueMod -> IssueOptions +toIssueOptions (IssueMod f) = f defaultIssueOptions + +issueModToQueryString :: IssueMod -> QueryString +issueModToQueryString = issueOptionsToQueryString . toIssueOptions + +issueOptionsToQueryString :: IssueOptions -> QueryString +issueOptionsToQueryString (IssueOptions filt st labels sort dir since) = + [ mk "state" state' + , mk "sort" sort' + , mk "direction" direction' + , mk "filter" filt' + ] ++ catMaybes + [ mk "labels" <$> labels' + , mk "since" <$> since' + ] + where + mk k v = (k, Just v) + filt' = case filt of + IssueFilterAssigned -> "assigned" + IssueFilterCreated -> "created" + IssueFilterMentioned -> "mentioned" + IssueFilterSubscribed -> "subscribed" + IssueFilterAll -> "all" + state' = case st of + Nothing -> "all" + Just StateOpen -> "open" + Just StateClosed -> "closed" + sort' = case sort of + SortIssueCreated -> "created" + SortIssueUpdated -> "updated" + SortIssueComments -> "comments" + direction' = case dir of + SortDescending -> "desc" + SortAscending -> "asc" + + since' = fmap (TE.encodeUtf8 . T.pack . show) since + labels' = TE.encodeUtf8 . T.intercalate "," . fmap untagName <$> nullToNothing labels + +nullToNothing :: Foldable f => f a -> Maybe (f a) +nullToNothing xs + | null xs = Nothing + | otherwise = Just xs + +------------------------------------------------------------------------------- +-- Issues modifiers +------------------------------------------------------------------------------- + +class HasComments mod where + sortByComments :: mod + +instance HasComments IssueMod where + sortByComments = IssueMod $ \opts -> + opts { issueOptionsSort = SortIssueComments } + +instance HasComments IssueRepoMod where + sortByComments = IssueRepoMod $ \opts -> + opts { issueRepoOptionsSort = SortIssueComments } + + +class HasLabels mod where + optionsLabels :: Foldable f => f (Name IssueLabel) -> mod + +instance HasLabels IssueMod where + optionsLabels lbls = IssueMod $ \opts -> + opts { issueOptionsLabels = toList lbls } + +instance HasLabels IssueRepoMod where + optionsLabels lbls = IssueRepoMod $ \opts -> + opts { issueRepoOptionsLabels = toList lbls } + + +class HasSince mod where + optionsSince :: UTCTime -> mod + optionsSinceAll :: mod + +instance HasSince IssueMod where + optionsSince since = IssueMod $ \opts -> + opts { issueOptionsSince = Just since } + optionsSinceAll = IssueMod $ \opts -> + opts { issueOptionsSince = Nothing } + +instance HasSince IssueRepoMod where + optionsSince since = IssueRepoMod $ \opts -> + opts { issueRepoOptionsSince = Just since } + optionsSinceAll = IssueRepoMod $ \opts -> + opts { issueRepoOptionsSince = Nothing } + +------------------------------------------------------------------------------- +-- Only issues modifiers +------------------------------------------------------------------------------- + +optionsAssignedIssues, optionsCreatedIssues, optionsMentionedIssues, + optionsSubscribedIssues, optionsAllIssues :: IssueMod +optionsAssignedIssues = issueFilter IssueFilterAssigned +optionsCreatedIssues = issueFilter IssueFilterCreated +optionsMentionedIssues = issueFilter IssueFilterMentioned +optionsSubscribedIssues = issueFilter IssueFilterSubscribed +optionsAllIssues = issueFilter IssueFilterAll + +issueFilter :: IssueFilter -> IssueMod +issueFilter f = IssueMod $ \opts -> + opts { issueOptionsFilter = f } + +------------------------------------------------------------------------------- +-- Issues repo +------------------------------------------------------------------------------- + +-- | Parameters of "list repository issues" (@get /repos/{owner}/{repo}/issues@). +-- +-- See . +-- +data IssueRepoOptions = IssueRepoOptions + { 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, Data) + +defaultIssueRepoOptions :: IssueRepoOptions +defaultIssueRepoOptions = IssueRepoOptions + { issueRepoOptionsMilestone = FilterNotSpecified + , issueRepoOptionsState = (Just StateOpen) + , issueRepoOptionsAssignee = FilterNotSpecified + , issueRepoOptionsCreator = Nothing + , issueRepoOptionsMentioned = Nothing + , issueRepoOptionsLabels = [] + , issueRepoOptionsSort = SortIssueCreated + , issueRepoOptionsDirection = SortDescending + , issueRepoOptionsSince = Nothing + } + +-- | See . +newtype IssueRepoMod = IssueRepoMod (IssueRepoOptions -> IssueRepoOptions) + +instance Semigroup IssueRepoMod where + IssueRepoMod f <> IssueRepoMod g = IssueRepoMod (g . f) + +instance Monoid IssueRepoMod where + mempty = IssueRepoMod id + mappend = (<>) + +toIssueRepoOptions :: IssueRepoMod -> IssueRepoOptions +toIssueRepoOptions (IssueRepoMod f) = f defaultIssueRepoOptions + +issueRepoModToQueryString :: IssueRepoMod -> QueryString +issueRepoModToQueryString = issueRepoOptionsToQueryString . toIssueRepoOptions + +issueRepoOptionsToQueryString :: IssueRepoOptions -> QueryString +issueRepoOptionsToQueryString IssueRepoOptions {..} = + [ mk "state" state' + , mk "sort" sort' + , mk "direction" direction' + ] ++ catMaybes + [ mk "milestone" <$> milestone' + , mk "assignee" <$> assignee' + , mk "labels" <$> labels' + , mk "since" <$> since' + , mk "creator" <$> creator' + , mk "mentioned" <$> mentioned' + ] + where + mk k v = (k, Just v) + filt f x = case x of + FilterAny -> Just "*" + FilterNone -> Just "none" + FilterBy x' -> Just $ TE.encodeUtf8 $ f x' + FilterNotSpecified -> Nothing + + milestone' = filt (T.pack . show . untagId) issueRepoOptionsMilestone + assignee' = filt untagName issueRepoOptionsAssignee + + state' = case issueRepoOptionsState of + Nothing -> "all" + Just StateOpen -> "open" + Just StateClosed -> "closed" + sort' = case issueRepoOptionsSort of + SortIssueCreated -> "created" + SortIssueUpdated -> "updated" + SortIssueComments -> "comments" + direction' = case issueRepoOptionsDirection of + SortDescending -> "desc" + SortAscending -> "asc" + + since' = TE.encodeUtf8 . T.pack . show <$> issueRepoOptionsSince + labels' = TE.encodeUtf8 . T.intercalate "," . fmap untagName <$> nullToNothing issueRepoOptionsLabels + creator' = TE.encodeUtf8 . untagName <$> issueRepoOptionsCreator + mentioned' = TE.encodeUtf8 . untagName <$> issueRepoOptionsMentioned + +------------------------------------------------------------------------------- +-- Issues repo modifiers +------------------------------------------------------------------------------- + +-- | 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. +-- +-- See +optionsIrrelevantMilestone :: IssueRepoMod +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 index 00000000..a7bf18f9 --- /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 new file mode 100644 index 00000000..74370960 --- /dev/null +++ b/src/GitHub/Data/PullRequests.hs @@ -0,0 +1,319 @@ +module GitHub.Data.PullRequests ( + SimplePullRequest(..), + PullRequest(..), + EditPullRequest(..), + CreatePullRequest(..), + PullRequestLinks(..), + PullRequestCommit(..), + PullRequestEvent(..), + PullRequestEventType(..), + PullRequestReference(..), + MergeResult(..), + ) where + +import GitHub.Data.Definitions +import GitHub.Data.Id (Id) +import GitHub.Data.Options (IssueState (..), MergeableState (..)) +import GitHub.Data.Repos (Repo) +import GitHub.Data.URL (URL) +import GitHub.Data.Teams (SimpleTeam) +import GitHub.Internal.Prelude +import Prelude () + +import qualified Data.Text as T + +data SimplePullRequest = SimplePullRequest + { simplePullRequestClosedAt :: !(Maybe UTCTime) + , simplePullRequestCreatedAt :: !UTCTime + , simplePullRequestUser :: !SimpleUser + , simplePullRequestPatchUrl :: !URL + , simplePullRequestState :: !IssueState + , simplePullRequestNumber :: !IssueNumber + , simplePullRequestHtmlUrl :: !URL + , simplePullRequestUpdatedAt :: !UTCTime + , simplePullRequestBody :: !(Maybe Text) + , simplePullRequestAssignees :: (Vector SimpleUser) + , simplePullRequestRequestedReviewers :: (Vector SimpleUser) + , simplePullRequestRequestedTeamReviewers:: (Vector SimpleTeam) + , simplePullRequestIssueUrl :: !URL + , simplePullRequestDiffUrl :: !URL + , simplePullRequestUrl :: !URL + , simplePullRequestLinks :: !PullRequestLinks + , simplePullRequestMergedAt :: !(Maybe UTCTime) + , simplePullRequestTitle :: !Text + , simplePullRequestId :: !(Id PullRequest) + } + deriving (Show, Data, Eq, Ord, Generic) + +instance NFData SimplePullRequest +instance Binary SimplePullRequest + +data PullRequest = PullRequest + { pullRequestClosedAt :: !(Maybe UTCTime) + , pullRequestCreatedAt :: !UTCTime + , pullRequestUser :: !SimpleUser + , pullRequestPatchUrl :: !URL + , pullRequestState :: !IssueState + , pullRequestNumber :: !IssueNumber + , pullRequestHtmlUrl :: !URL + , pullRequestUpdatedAt :: !UTCTime + , pullRequestBody :: !(Maybe Text) + , pullRequestAssignees :: (Vector SimpleUser) + , pullRequestRequestedReviewers :: (Vector SimpleUser) + , pullRequestRequestedTeamReviewers :: (Vector SimpleTeam) + , pullRequestIssueUrl :: !URL + , pullRequestDiffUrl :: !URL + , pullRequestUrl :: !URL + , pullRequestLinks :: !PullRequestLinks + , pullRequestMergedAt :: !(Maybe UTCTime) + , pullRequestTitle :: !Text + , pullRequestId :: !(Id PullRequest) + , pullRequestMergedBy :: !(Maybe SimpleUser) + , pullRequestChangedFiles :: !Int + , pullRequestHead :: !PullRequestCommit + , pullRequestComments :: !Count + , pullRequestDeletions :: !Count + , pullRequestAdditions :: !Count + , pullRequestReviewComments :: !Count + , pullRequestBase :: !PullRequestCommit + , pullRequestCommits :: !Count + , pullRequestMerged :: !Bool + , pullRequestMergeable :: !(Maybe Bool) + , pullRequestMergeableState :: !MergeableState + } + deriving (Show, Data, Eq, Ord, Generic) + +instance NFData PullRequest +instance Binary PullRequest + +data EditPullRequest = EditPullRequest + { editPullRequestTitle :: !(Maybe Text) + , editPullRequestBody :: !(Maybe Text) + , editPullRequestState :: !(Maybe IssueState) + , editPullRequestBase :: !(Maybe Text) + , editPullRequestMaintainerCanModify + :: !(Maybe Bool) + } + deriving (Show, Generic) + +instance NFData EditPullRequest +instance Binary EditPullRequest + +data CreatePullRequest + = CreatePullRequest + { createPullRequestTitle :: !Text + , createPullRequestBody :: !Text + , createPullRequestHead :: !Text + , createPullRequestBase :: !Text + } + | CreatePullRequestIssue + { createPullRequestIssueNum :: !Int + , createPullRequestHead :: !Text + , createPullRequestBase :: !Text + } + deriving (Show, Generic) + +instance NFData CreatePullRequest +instance Binary CreatePullRequest + +data PullRequestLinks = PullRequestLinks + { pullRequestLinksReviewComments :: !URL + , pullRequestLinksComments :: !URL + , pullRequestLinksHtml :: !URL + , pullRequestLinksSelf :: !URL + } + deriving (Show, Data, Eq, Ord, Generic) + +instance NFData PullRequestLinks +instance Binary PullRequestLinks + +data PullRequestCommit = PullRequestCommit + { pullRequestCommitLabel :: !Text + , pullRequestCommitRef :: !Text + , pullRequestCommitSha :: !Text + , pullRequestCommitUser :: !SimpleUser + , pullRequestCommitRepo :: !(Maybe Repo) + } + deriving (Show, Data, Eq, Ord, Generic) + +instance NFData PullRequestCommit +instance Binary PullRequestCommit + +data PullRequestEvent = PullRequestEvent + { pullRequestEventAction :: !PullRequestEventType + , pullRequestEventNumber :: !Int + , pullRequestEventPullRequest :: !PullRequest + , pullRequestRepository :: !Repo + , pullRequestSender :: !SimpleUser + } + deriving (Show, Data, Eq, Ord, Generic) + +instance NFData PullRequestEvent +instance Binary PullRequestEvent + +data PullRequestEventType + = PullRequestOpened + | PullRequestClosed + | PullRequestSynchronized + | PullRequestReopened + | PullRequestAssigned + | PullRequestUnassigned + | PullRequestLabeled + | PullRequestUnlabeled + | PullRequestReviewRequested + | PullRequestReviewRequestRemoved + | PullRequestEdited + deriving (Show, Data, Eq, Ord, Generic) + +instance NFData PullRequestEventType +instance Binary PullRequestEventType + +data PullRequestReference = PullRequestReference + { pullRequestReferenceHtmlUrl :: !(Maybe URL) + , pullRequestReferencePatchUrl :: !(Maybe URL) + , pullRequestReferenceDiffUrl :: !(Maybe URL) + } + deriving (Eq, Ord, Show, Generic, Data) + +instance NFData PullRequestReference +instance Binary PullRequestReference + + +------------------------------------------------------------------------------- +-- JSON instances +------------------------------------------------------------------------------- + +instance FromJSON SimplePullRequest where + parseJSON = withObject "SimplePullRequest" $ \o -> SimplePullRequest + <$> o .:? "closed_at" + <*> o .: "created_at" + <*> o .: "user" + <*> o .: "patch_url" + <*> o .: "state" + <*> o .: "number" + <*> o .: "html_url" + <*> o .: "updated_at" + <*> o .:? "body" + <*> o .: "assignees" + <*> o .:? "requested_reviewers" .!= mempty + <*> o .:? "requested_teams" .!= mempty + <*> o .: "issue_url" + <*> o .: "diff_url" + <*> o .: "url" + <*> o .: "_links" + <*> o .:? "merged_at" + <*> o .: "title" + <*> o .: "id" + +instance ToJSON EditPullRequest where + toJSON (EditPullRequest t b s base mcm) = + object $ filter notNull + [ "title" .= t + , "body" .= b + , "state" .= s + , "base" .= base + , "maintainer_can_modify" + .= mcm + ] + where + notNull (_, Null) = False + notNull (_, _) = True + +instance ToJSON CreatePullRequest where + toJSON (CreatePullRequest t b headPR basePR) = + object [ "title" .= t, "body" .= b, "head" .= headPR, "base" .= basePR ] + toJSON (CreatePullRequestIssue issueNum headPR basePR) = + object [ "issue" .= issueNum, "head" .= headPR, "base" .= basePR] + +instance FromJSON PullRequest where + parseJSON = withObject "PullRequest" $ \o -> PullRequest + <$> o .:? "closed_at" + <*> o .: "created_at" + <*> o .: "user" + <*> o .: "patch_url" + <*> o .: "state" + <*> o .: "number" + <*> o .: "html_url" + <*> o .: "updated_at" + <*> o .:? "body" + <*> o .: "assignees" + <*> o .:? "requested_reviewers" .!= mempty + <*> o .:? "requested_teams" .!= mempty + <*> o .: "issue_url" + <*> o .: "diff_url" + <*> o .: "url" + <*> o .: "_links" + <*> o .:? "merged_at" + <*> o .: "title" + <*> o .: "id" + <*> o .:? "merged_by" + <*> o .: "changed_files" + <*> o .: "head" + <*> o .: "comments" + <*> o .: "deletions" + <*> o .: "additions" + <*> o .: "review_comments" + <*> o .: "base" + <*> o .: "commits" + <*> o .: "merged" + <*> o .:? "mergeable" + <*> o .: "mergeable_state" + +instance FromJSON PullRequestLinks where + parseJSON = withObject "PullRequestLinks" $ \o -> PullRequestLinks + <$> fmap getHref (o .: "review_comments") + <*> fmap getHref (o .: "comments") + <*> fmap getHref (o .: "html") + <*> fmap getHref (o .: "self") + +instance FromJSON PullRequestCommit where + parseJSON = withObject "PullRequestCommit" $ \o -> PullRequestCommit + <$> o .: "label" + <*> o .: "ref" + <*> o .: "sha" + <*> o .: "user" + <*> o .: "repo" + +instance FromJSON PullRequestEvent where + parseJSON = withObject "PullRequestEvent" $ \o -> PullRequestEvent + <$> o .: "action" + <*> o .: "number" + <*> o .: "pull_request" + <*> o .: "repository" + <*> o .: "sender" + +instance FromJSON PullRequestEventType where + parseJSON = withText "PullRequestEventType" $ \t -> case T.toLower t of + "opened" -> pure PullRequestOpened + "closed" -> pure PullRequestClosed + "synchronize" -> pure PullRequestSynchronized + "reopened" -> pure PullRequestReopened + "assigned" -> pure PullRequestAssigned + "unassigned" -> pure PullRequestUnassigned + "labeled" -> pure PullRequestLabeled + "unlabeled" -> pure PullRequestUnlabeled + "review_requested" -> pure PullRequestReviewRequested + "review_request_removed" -> pure PullRequestReviewRequestRemoved + "edited" -> pure PullRequestEdited + _ -> fail $ "Unknown PullRequestEventType: " <> T.unpack t + +instance FromJSON PullRequestReference where + parseJSON = withObject "PullRequestReference" $ \o -> PullRequestReference + <$> o .:? "html_url" + <*> o .:? "patch_url" + <*> o .:? "diff_url" + +-- Helpers + +newtype Href a = Href { getHref :: a } + +instance FromJSON a => FromJSON (Href a) where + parseJSON = withObject "href object" $ + \obj -> Href <$> obj .: "href" + +-- | Pull request merge results +data MergeResult + = MergeSuccessful + | MergeCannotPerform + | MergeConflict + deriving (Eq, Ord, Read, Show, Enum, Bounded, Generic) diff --git a/src/GitHub/Data/RateLimit.hs b/src/GitHub/Data/RateLimit.hs new file mode 100644 index 00000000..743a096e --- /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 index 00000000..574fda00 --- /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 new file mode 100644 index 00000000..7f87b825 --- /dev/null +++ b/src/GitHub/Data/Releases.hs @@ -0,0 +1,85 @@ +module GitHub.Data.Releases where + +import GitHub.Data.Definitions +import GitHub.Data.Id (Id) +import GitHub.Data.URL (URL) +import GitHub.Internal.Prelude +import Prelude () + +data Release = Release + { releaseUrl :: !URL + , releaseHtmlUrl :: !URL + , releaseAssetsurl :: !URL + , releaseUploadUrl :: !URL + , releaseTarballUrl :: !URL + , releaseZipballUrl :: !URL + , releaseId :: !(Id Release) + , releaseTagName :: !Text + , releaseTargetCommitish :: !Text + , releaseName :: !Text + , releaseBody :: !Text + , releaseDraft :: !Bool + , releasePrerelease :: !Bool + , releaseCreatedAt :: !UTCTime + , releasePublishedAt :: !(Maybe UTCTime) + , releaseAuthor :: !SimpleUser + , releaseAssets :: !(Vector ReleaseAsset) + } + deriving (Show, Data, Eq, Ord, Generic) + +instance FromJSON Release where + parseJSON = withObject "Event" $ \o -> Release + <$> o .: "url" + <*> o .: "html_url" + <*> o .: "assets_url" + <*> o .: "upload_url" + <*> o .: "tarball_url" + <*> o .: "zipball_url" + <*> o .: "id" + <*> o .: "tag_name" + <*> o .: "target_commitish" + <*> o .: "name" + <*> o .: "body" + <*> o .: "draft" + <*> o .: "prerelease" + <*> o .: "created_at" + <*> o .:? "published_at" + <*> o .: "author" + <*> o .: "assets" + +instance NFData Release +instance Binary Release + +data ReleaseAsset = ReleaseAsset + { releaseAssetUrl :: !URL + , releaseAssetBrowserDownloadUrl :: !Text + , releaseAssetId :: !(Id ReleaseAsset) + , releaseAssetName :: !Text + , releaseAssetLabel :: !(Maybe Text) + , releaseAssetState :: !Text + , releaseAssetContentType :: !Text + , releaseAssetSize :: !Int + , releaseAssetDownloadCount :: !Int + , releaseAssetCreatedAt :: !UTCTime + , releaseAssetUpdatedAt :: !UTCTime + , releaseAssetUploader :: !SimpleUser + } + deriving (Show, Data, Eq, Ord, Generic) + +instance FromJSON ReleaseAsset where + parseJSON = withObject "Event" $ \o -> ReleaseAsset + <$> o .: "url" + <*> o .: "browser_download_url" + <*> o .: "id" + <*> o .: "name" + <*> o .:? "label" + <*> o .: "state" + <*> o .: "content_type" + <*> o .: "size" + <*> o .: "download_count" + <*> o .: "created_at" + <*> o .: "updated_at" + <*> o .: "uploader" + +instance NFData ReleaseAsset +instance Binary ReleaseAsset diff --git a/src/GitHub/Data/Repos.hs b/src/GitHub/Data/Repos.hs new file mode 100644 index 00000000..6dce3919 --- /dev/null +++ b/src/GitHub/Data/Repos.hs @@ -0,0 +1,408 @@ +{-# LANGUAGE FlexibleInstances #-} + +-- | +-- This module also exports +-- @'FromJSON' a => 'FromJSON' ('HM.HashMap' 'Language' a)@ +-- orphan-ish instance for @aeson < 1@ + +module GitHub.Data.Repos where + +import GitHub.Data.Definitions +import GitHub.Data.Id (Id) +import GitHub.Data.Name (Name) +import GitHub.Data.Request (IsPathPart (..)) +import GitHub.Data.URL (URL) +import GitHub.Internal.Prelude +import Prelude () + +import qualified Data.HashMap.Strict as HM +import qualified Data.Text as T +import Data.Aeson.Types (FromJSONKey (..), fromJSONKeyCoerce) + +data Repo = Repo + { repoId :: !(Id Repo) + , repoName :: !(Name Repo) + , repoOwner :: !SimpleOwner + , repoPrivate :: !Bool + , repoHtmlUrl :: !URL + , repoDescription :: !(Maybe Text) + , repoFork :: !(Maybe Bool) + , repoUrl :: !URL + , repoGitUrl :: !(Maybe URL) + , repoSshUrl :: !(Maybe URL) + , repoCloneUrl :: !(Maybe URL) + , repoHooksUrl :: !URL + , repoSvnUrl :: !(Maybe URL) + , repoHomepage :: !(Maybe Text) + , repoLanguage :: !(Maybe Language) + , repoForksCount :: !Int + , repoStargazersCount :: !Int + , repoWatchersCount :: !Int + , repoSize :: !(Maybe Int) + , repoDefaultBranch :: !(Maybe Text) + , repoOpenIssuesCount :: !Int + , repoHasIssues :: !(Maybe Bool) + , repoHasProjects :: !(Maybe Bool) + , repoHasWiki :: !(Maybe Bool) + , repoHasPages :: !(Maybe Bool) + , repoHasDownloads :: !(Maybe Bool) + , 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, Eq, Ord, Generic) + +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, Eq, Ord, Generic) + +instance NFData RepoRef +instance Binary RepoRef + +data NewRepo = NewRepo + { 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 +instance Binary NewRepo + +newRepo :: Name Repo -> NewRepo +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) + , 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, Generic) + +instance NFData EditRepo +instance Binary EditRepo + +-- | Filter the list of the user's repos using any of these constructors. +data RepoPublicity + = RepoPublicityAll -- ^ All repos accessible to the user. + | RepoPublicityOwner -- ^ Only repos owned by the user. + | RepoPublicityPublic -- ^ Only public repos. + | RepoPublicityPrivate -- ^ Only private repos. + | RepoPublicityMember -- ^ Only repos to which the user is a member but not an owner. + deriving (Show, Eq, Ord, Enum, Bounded, 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, Eq, Ord, Generic) + +getLanguage :: Language -> Text +getLanguage (Language l) = l + +instance NFData Language +instance Binary Language +instance Hashable Language where + hashWithSalt salt (Language l) = hashWithSalt salt l +instance IsString Language where + fromString = Language . fromString + +data Contributor + -- | An existing Github user, with their number of contributions, avatar + -- URL, login, URL, ID, and Gravatar ID. + = KnownContributor !Int !URL !(Name User) !URL !(Id User) !Text + -- | An unknown Github user with their number of contributions and recorded name. + | AnonymousContributor !Int !Text + deriving (Show, Data, Eq, Ord, Generic) + +instance NFData Contributor +instance Binary Contributor + +contributorToSimpleUser :: Contributor -> Maybe SimpleUser +contributorToSimpleUser (AnonymousContributor _ _) = Nothing +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 .: "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 .: "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 .:? "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 .:? "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 .:? "permissions" + +instance ToJSON NewRepo where + 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 + , 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 + , "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" + <*> o .: "name" + +instance FromJSON Contributor where + parseJSON = withObject "Contributor" $ \o -> do + t <- o .: "type" + case (t :: Text) of + "Anonymous" -> AnonymousContributor + <$> o .: "contributions" + <*> o .: "name" + _ -> KnownContributor + <$> o .: "contributions" + <*> o .: "avatar_url" + <*> o .: "login" + <*> o .: "url" + <*> o .: "id" + <*> o .: "gravatar_id" + +instance FromJSON Language where + parseJSON = withText "Language" (pure . Language) + +instance ToJSON Language where + toJSON = toJSON . getLanguage + +instance FromJSONKey Language where + fromJSONKey = fromJSONKeyCoerce + +data ArchiveFormat + = ArchiveFormatTarball -- ^ ".tar.gz" format + | ArchiveFormatZipball -- ^ ".zip" format + 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 new file mode 100644 index 00000000..07ac89dd --- /dev/null +++ b/src/GitHub/Data/Request.hs @@ -0,0 +1,238 @@ +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE KindSignatures #-} +{-# LANGUAGE StandaloneDeriving #-} + +module GitHub.Data.Request ( + -- * Request + Request, + GenRequest (..), + -- * Smart constructors + query, pagedQuery, command, + -- * Auxiliary types + RW(..), + CommandMethod(..), + toMethod, + FetchCount(..), + PageParams(..), + PageLinks(..), + MediaType (..), + Paths, + IsPathPart(..), + QueryString, + Count, + ) where + +import GitHub.Data.Definitions (Count, IssueNumber, QueryString, unIssueNumber) +import GitHub.Data.Id (Id, untagId) +import GitHub.Data.Name (Name, untagName) +import GitHub.Internal.Prelude + +import qualified Data.ByteString.Lazy as LBS +import qualified Data.Text as T +import qualified Network.HTTP.Types.Method as Method +import Network.URI (URI) + +------------------------------------------------------------------------------ +-- Path parts +------------------------------------------------------------------------------ + +type Paths = [Text] + +class IsPathPart a where + toPathPart :: a -> Text + +instance IsPathPart (Name a) where + toPathPart = untagName + +instance IsPathPart (Id a) where + toPathPart = T.pack . show . untagId + +instance IsPathPart IssueNumber where + toPathPart = T.pack . show . unIssueNumber + +------------------------------------------------------------------------------- +-- Command Method +------------------------------------------------------------------------------- + +-- | Http method of requests with body. +data CommandMethod + = Post + | Patch + | Put + | Delete + deriving (Eq, Ord, Read, Show, Enum, Bounded, Data, Generic) + +instance Hashable CommandMethod + +toMethod :: CommandMethod -> Method.Method +toMethod Post = Method.methodPost +toMethod Patch = Method.methodPatch +toMethod Put = Method.methodPut +toMethod Delete = Method.methodDelete + +------------------------------------------------------------------------------- +-- Fetch count +------------------------------------------------------------------------------- + +-- | 'PagedQuery' returns just some results, using this data we can specify how +-- many pages we want to fetch. +data FetchCount = + FetchAtLeast !Word + | FetchAll + | FetchPage PageParams + deriving (Eq, Ord, Read, Show, Generic) + + +-- | This instance is there mostly for 'fromInteger'. +instance Num FetchCount where + fromInteger = FetchAtLeast . fromInteger + + FetchAtLeast a + FetchAtLeast b = FetchAtLeast (a * b) + _ + _ = FetchAll + + FetchAtLeast a * FetchAtLeast b = FetchAtLeast (a * b) + _ * _ = FetchAll + + abs = error "abs @FetchCount: not implemented" + signum = error "signum @FetchCount: not implemented" + negate = error "negate @FetchCount: not implemented" + +instance Hashable FetchCount +instance Binary FetchCount +instance NFData FetchCount + +------------------------------------------------------------------------------- +-- 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) + +------------------------------------------------------------------------------ +-- RW +------------------------------------------------------------------------------ + +-- | Type used as with @DataKinds@ to tag whether requests need authentication +-- or aren't read-only. +data RW + = RO -- ^ /Read-only/, doesn't necessarily requires authentication + | RA -- ^ /Read authenticated/ + | RW -- ^ /Read-write/, requires authentication + deriving (Eq, Ord, Read, Show, Enum, Bounded, Data, Generic) + +{- +data SRO (rw :: RW) where + ROO :: SRO 'RO + ROA :: SRO 'RA + +-- | This class is used to describe read-only (but pontentially +class IReadOnly (rw :: RW) where iro :: SRO rw +instance IReadOnly 'RO where iro = ROO +instance IReadOnly 'RA where iro = ROA +-} + +------------------------------------------------------------------------------- +-- GitHub Request +------------------------------------------------------------------------------- + +-- | Github request data type. +-- +-- * @rw@ describes whether authentication is required. It's required for non-@GET@ requests. +-- * @mt@ describes the media type, i.e. how the response should be interpreted. +-- * @a@ is the result type +-- +-- /Note:/ 'Request' is not 'Functor' on purpose. +data GenRequest (mt :: MediaType *) (rw :: RW) a where + Query :: Paths -> QueryString -> GenRequest mt rw a + PagedQuery :: (a ~ t b, Foldable t, Semigroup a) => Paths -> QueryString -> FetchCount -> GenRequest mt rw a + + -- | Command + Command + :: CommandMethod -- ^ command + -> Paths -- ^ path + -> LBS.ByteString -- ^ body + -> GenRequest mt 'RW a + +-- | Most requests ask for @JSON@. +type Request = GenRequest 'MtJSON + +------------------------------------------------------------------------------- +-- Smart constructors +------------------------------------------------------------------------------- + +query :: Paths -> QueryString -> Request mt a +query ps qs = Query ps qs + +pagedQuery :: FromJSON a => Paths -> QueryString -> FetchCount -> Request mt (Vector a) +pagedQuery ps qs fc = PagedQuery ps qs fc + +command :: CommandMethod -> Paths -> LBS.ByteString -> Request 'RW a +command m ps body = Command m ps body + +------------------------------------------------------------------------------- +-- Instances +------------------------------------------------------------------------------- + +deriving instance Eq (GenRequest rw mt a) +deriving instance Ord (GenRequest rw mt a) +deriving instance Show (GenRequest rw mt a) + +instance Hashable (GenRequest rw mt a) where + hashWithSalt salt (Query ps qs) = + salt `hashWithSalt` (0 :: Int) + `hashWithSalt` ps + `hashWithSalt` qs + hashWithSalt salt (PagedQuery ps qs l) = + salt `hashWithSalt` (1 :: Int) + `hashWithSalt` ps + `hashWithSalt` qs + `hashWithSalt` l + hashWithSalt salt (Command m ps body) = + salt `hashWithSalt` (2 :: Int) + `hashWithSalt` m + `hashWithSalt` ps + `hashWithSalt` body + +-- TODO: Binary diff --git a/src/GitHub/Data/Reviews.hs b/src/GitHub/Data/Reviews.hs new file mode 100644 index 00000000..c8761e0a --- /dev/null +++ b/src/GitHub/Data/Reviews.hs @@ -0,0 +1,93 @@ +module GitHub.Data.Reviews where + +import GitHub.Data.Definitions (SimpleUser) +import GitHub.Data.Id (Id) +import GitHub.Data.URL (URL) +import GitHub.Internal.Prelude +import Prelude () + +import qualified Data.Text as T + +data ReviewState + = ReviewStatePending + | ReviewStateApproved + | ReviewStateDismissed + | ReviewStateCommented + | ReviewStateChangesRequested + deriving (Show, Enum, Bounded, Eq, Ord, Generic) + +instance NFData ReviewState +instance Binary ReviewState + +instance FromJSON ReviewState where + parseJSON = withText "ReviewState" $ \t -> case T.toLower t of + "approved" -> pure ReviewStateApproved + "pending" -> pure ReviewStatePending + "dismissed" -> pure ReviewStateDismissed + "commented" -> pure ReviewStateCommented + "changes_requested" -> pure ReviewStateChangesRequested + _ -> fail $ "Unknown ReviewState: " <> T.unpack t + +data Review = Review + { reviewBody :: !Text + , reviewCommitId :: !Text + , reviewState :: ReviewState + , reviewSubmittedAt :: !(Maybe UTCTime) + , reviewPullRequestUrl :: !URL + , reviewHtmlUrl :: !Text + , reviewUser :: !SimpleUser + , reviewId :: !(Id Review) + } deriving (Show, Generic) + +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" + +data ReviewComment = ReviewComment + { reviewCommentId :: !(Id ReviewComment) + , reviewCommentUser :: !SimpleUser + , reviewCommentBody :: !Text + , reviewCommentUrl :: !URL + , reviewCommentPullRequestReviewId :: !(Id Review) + , reviewCommentDiffHunk :: !Text + , reviewCommentPath :: !Text + , reviewCommentPosition :: !Int + , reviewCommentOriginalPosition :: !Int + , reviewCommentCommitId :: !Text + , reviewCommentOriginalCommitId :: !Text + , reviewCommentCreatedAt :: !UTCTime + , reviewCommentUpdatedAt :: !UTCTime + , reviewCommentHtmlUrl :: !URL + , reviewCommentPullRequestUrl :: !URL + } deriving (Show, Generic) + +instance NFData ReviewComment +instance Binary ReviewComment + +instance FromJSON ReviewComment where + parseJSON = + withObject "ReviewComment" $ \o -> ReviewComment + <$> o .: "id" + <*> o .: "user" + <*> o .: "body" + <*> o .: "url" + <*> o .: "pull_request_review_id" + <*> o .: "diff_hunk" + <*> o .: "path" + <*> o .: "position" + <*> o .: "original_position" + <*> o .: "commit_id" + <*> o .: "original_commit_id" + <*> o .: "created_at" + <*> o .: "updated_at" + <*> o .: "html_url" + <*> o .: "pull_request_url" diff --git a/src/GitHub/Data/Search.hs b/src/GitHub/Data/Search.hs new file mode 100644 index 00000000..a84710d2 --- /dev/null +++ b/src/GitHub/Data/Search.hs @@ -0,0 +1,54 @@ +module GitHub.Data.Search where + +import GitHub.Data.Repos (CodeSearchRepo) +import GitHub.Data.URL (URL) +import GitHub.Internal.Prelude +import Prelude () + +import qualified Data.Vector as V + +data SearchResult' entities = SearchResult + { searchResultTotalCount :: !Int + , searchResultResults :: !entities + } + deriving (Show, Data, Eq, Ord, Generic) + +type SearchResult entity = SearchResult' (V.Vector entity) + +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" .!= 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 + , codeSha :: !Text + , codeUrl :: !URL + , codeGitUrl :: !URL + , codeHtmlUrl :: !URL + , codeRepo :: !CodeSearchRepo + } + deriving (Show, Data, Eq, Ord, Generic) + +instance NFData Code +instance Binary Code + +instance FromJSON Code where + parseJSON = withObject "Code" $ \o -> Code + <$> o .: "name" + <*> o .: "path" + <*> o .: "sha" + <*> o .: "url" + <*> o .: "git_url" + <*> o .: "html_url" + <*> o .: "repository" diff --git a/src/GitHub/Data/Statuses.hs b/src/GitHub/Data/Statuses.hs new file mode 100644 index 00000000..a2e19219 --- /dev/null +++ b/src/GitHub/Data/Statuses.hs @@ -0,0 +1,110 @@ +{-# LANGUAGE NoImplicitPrelude #-} + +module GitHub.Data.Statuses where + +import GitHub.Data.Definitions +import GitHub.Data.Name (Name) +import GitHub.Data.Id (Id) +import GitHub.Data.URL (URL) +import GitHub.Internal.Prelude +import Prelude () + +import GitHub.Data.GitData (Commit) +import GitHub.Data.Repos (RepoRef) + +import qualified Data.Text as T + +data StatusState + = StatusPending + | StatusSuccess + | StatusError + | StatusFailure + deriving (Show, Data, Enum, Bounded, Eq, Ord, Generic) + +instance NFData StatusState +instance Binary StatusState + +instance FromJSON StatusState where + parseJSON = withText "StatusState" $ \t -> case T.toLower t of + "pending" -> pure StatusPending + "success" -> pure StatusSuccess + "error" -> pure StatusError + "failure" -> pure StatusFailure + _ -> fail $ "Unknown StatusState: " <> T.unpack t + +instance ToJSON StatusState where + toJSON StatusPending = String "pending" + toJSON StatusSuccess = String "success" + toJSON StatusError = String "error" + toJSON StatusFailure = String "failure" + + +data Status = Status + { statusCreatedAt :: !UTCTime + , statusUpdatedAt :: !UTCTime + , statusState :: !StatusState + , statusTargetUrl :: !(Maybe URL) + , statusDescription :: !(Maybe Text) + , statusId :: !(Id Status) + , statusUrl :: !URL + , statusContext :: !(Maybe Text) + , statusCreator :: !(Maybe SimpleUser) + } + deriving (Show, Data, Eq, Ord, Generic) + +instance FromJSON Status where + parseJSON = withObject "Status" $ \o -> Status + <$> o .: "created_at" + <*> o .: "updated_at" + <*> o .: "state" + <*> o .:? "target_url" + <*> o .:? "description" + <*> o .: "id" + <*> o .: "url" + <*> o .:? "context" + <*> o .:? "creator" + + +data NewStatus = NewStatus + { newStatusState :: !StatusState + , newStatusTargetUrl :: !(Maybe URL) + , newStatusDescription :: !(Maybe Text) + , newStatusContext :: !(Maybe Text) + } + deriving (Show, Data, Eq, Ord, Generic) + +instance NFData NewStatus +instance Binary NewStatus + +instance ToJSON NewStatus where + toJSON (NewStatus s t d c) = object $ filter notNull $ + [ "state" .= s + , "target_url" .= t + , "description" .= d + , "context" .= c + ] + where + notNull (_, Null) = False + notNull (_, _) = True + + +data CombinedStatus = CombinedStatus + { combinedStatusState :: !StatusState + , combinedStatusSha :: !(Name Commit) + , combinedStatusTotalCount :: !Int + , combinedStatusStatuses :: !(Vector Status) + , combinedStatusRepository :: !RepoRef + , combinedStatusCommitUrl :: !URL + , combinedStatusUrl :: !URL + } + deriving (Show, Data, Eq, Ord, Generic) + +instance FromJSON CombinedStatus where + parseJSON = withObject "CombinedStatus" $ \o -> CombinedStatus + <$> o .: "state" + <*> o .: "sha" + <*> o .: "total_count" + <*> o .: "statuses" + <*> o .: "repository" + <*> o .: "commit_url" + <*> o .: "url" diff --git a/src/GitHub/Data/Teams.hs b/src/GitHub/Data/Teams.hs new file mode 100644 index 00000000..01b1429c --- /dev/null +++ b/src/GitHub/Data/Teams.hs @@ -0,0 +1,254 @@ +{-# LANGUAGE NoImplicitPrelude #-} + +module GitHub.Data.Teams where + +import GitHub.Data.Definitions +import GitHub.Data.Id (Id) +import GitHub.Data.Name (Name) +import GitHub.Data.Repos (Repo) +import GitHub.Data.URL (URL) +import GitHub.Internal.Prelude +import Prelude () + +import qualified Data.Text as T + +data Privacy + = PrivacyClosed + | PrivacySecret + deriving (Show, Data, Enum, Bounded, Eq, Ord, Generic) + +instance NFData Privacy +instance Binary Privacy + +data Permission + = PermissionPull + | PermissionPush + | PermissionAdmin + deriving (Show, Data, Enum, Bounded, Eq, Ord, Generic) + +instance NFData Permission +instance Binary Permission + +data AddTeamRepoPermission = AddTeamRepoPermission + { addTeamRepoPermission :: !Permission + } + deriving (Show, Data, Eq, Ord, Generic) + +instance NFData AddTeamRepoPermission +instance Binary AddTeamRepoPermission + +data SimpleTeam = SimpleTeam + { simpleTeamId :: !(Id Team) + , simpleTeamUrl :: !URL + , simpleTeamName :: !Text -- TODO (0.15.0): unify this and 'simpleTeamSlug' as in 'Team'. + , simpleTeamSlug :: !(Name Team) + , simpleTeamDescription :: !(Maybe Text) + , simpleTeamPrivacy :: !Privacy + , simpleTeamPermission :: !Permission + , simpleTeamMembersUrl :: !URL + , simpleTeamRepositoriesUrl :: !URL + } + deriving (Show, Data, Eq, Ord, Generic) + +instance NFData SimpleTeam +instance Binary SimpleTeam + +data Team = Team + { teamId :: !(Id Team) + , teamUrl :: !URL + , teamName :: !Text + , teamSlug :: !(Name Team) + , teamDescription :: !(Maybe Text) + , teamPrivacy :: !Privacy + , teamPermission :: !Permission + , teamMembersUrl :: !URL + , teamRepositoriesUrl :: !URL + , teamMembersCount :: !Int + , teamReposCount :: !Int + , teamOrganization :: !SimpleOrganization + } + deriving (Show, Data, Eq, Ord, Generic) + +instance NFData Team +instance Binary Team + +data CreateTeam = CreateTeam + { createTeamName :: !(Name Team) + , createTeamDescription :: !(Maybe Text) + , createTeamRepoNames :: !(Vector (Name Repo)) + , createTeamPrivacy :: !Privacy + , createTeamPermission :: !Permission + } + deriving (Show, Data, Eq, Ord, Generic) + +instance NFData CreateTeam +instance Binary CreateTeam + +data EditTeam = EditTeam + { editTeamName :: !(Name Team) + , editTeamDescription :: !(Maybe Text) + , editTeamPrivacy :: !(Maybe Privacy) + , editTeamPermission :: !(Maybe Permission) + } + deriving (Show, Data, Eq, Ord, Generic) + +instance NFData EditTeam +instance Binary EditTeam + +data Role + = RoleMaintainer + | RoleMember + deriving (Show, Data, Eq, Ord, Generic) + +instance NFData Role +instance Binary Role + +data ReqState + = StatePending + | StateActive + deriving (Show, Data, Eq, Ord, Generic) + +instance NFData ReqState +instance Binary ReqState + +data TeamMembership = TeamMembership + { teamMembershipUrl :: !URL + , teamMembershipRole :: !Role + , teamMembershipReqState :: !ReqState + } + deriving (Show, Data, Eq, Ord, Generic) + +instance NFData TeamMembership +instance Binary TeamMembership + +data CreateTeamMembership = CreateTeamMembership { + createTeamMembershipRole :: !Role +} deriving (Show, Data, Eq, Ord, Generic) + +instance NFData CreateTeamMembership +instance Binary CreateTeamMembership + +-- JSON Instances + +instance FromJSON SimpleTeam where + parseJSON = withObject "SimpleTeam" $ \o -> SimpleTeam + <$> o .: "id" + <*> o .: "url" + <*> o .: "name" + <*> o .: "slug" + <*> o .:?"description" .!= Nothing + <*> o .: "privacy" + <*> o .: "permission" + <*> o .: "members_url" + <*> o .: "repositories_url" + +instance FromJSON Team where + parseJSON = withObject "Team" $ \o -> Team + <$> o .: "id" + <*> o .: "url" + <*> o .: "name" + <*> o .: "slug" + <*> o .:?"description" .!= Nothing + <*> o .: "privacy" + <*> o .: "permission" + <*> o .: "members_url" + <*> o .: "repositories_url" + <*> o .: "members_count" + <*> o .: "repos_count" + <*> o .: "organization" + +instance ToJSON CreateTeam where + toJSON (CreateTeam name desc repo_names privacy 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 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 + <$> o .: "url" + <*> o .: "role" + <*> o .: "state" + +instance FromJSON CreateTeamMembership where + parseJSON = withObject "CreateTeamMembership" $ \o -> CreateTeamMembership + <$> o .: "role" + +instance ToJSON CreateTeamMembership where + toJSON (CreateTeamMembership { createTeamMembershipRole = role }) = + object [ "role" .= role ] + +instance FromJSON AddTeamRepoPermission where + parseJSON = withObject "AddTeamRepoPermission" $ \o -> AddTeamRepoPermission + <$> o .: "permission" + +instance ToJSON AddTeamRepoPermission where + toJSON (AddTeamRepoPermission { addTeamRepoPermission = permission}) = + object [ "permission" .= permission ] + +instance FromJSON Role where + parseJSON = withText "Role" $ \t -> case T.toLower t of + "maintainer" -> pure RoleMaintainer + "member" -> pure RoleMember + _ -> fail $ "Unknown Role: " <> T.unpack t + +instance ToJSON Role where + toJSON RoleMaintainer = String "maintainer" + toJSON RoleMember = String "member" + +instance FromJSON Permission where + parseJSON = withText "Permission" $ \t -> case T.toLower t of + "pull" -> pure PermissionPull + "push" -> pure PermissionPush + "admin" -> pure PermissionAdmin + _ -> fail $ "Unknown Permission: " <> T.unpack t + +instance ToJSON Permission where + toJSON PermissionPull = "pull" + toJSON PermissionPush = "push" + toJSON PermissionAdmin = "admin" + +instance FromJSON Privacy where + parseJSON = withText "Privacy" $ \t -> case T.toLower t of + "secret" -> pure PrivacySecret + "closed" -> pure PrivacyClosed + _ -> fail $ "Unknown Privacy: " <> T.unpack t + +instance ToJSON Privacy where + toJSON PrivacySecret = String "secret" + toJSON PrivacyClosed = String "closed" + +instance FromJSON ReqState where + parseJSON = withText "ReqState" $ \t -> case T.toLower t of + "active" -> pure StateActive + "pending" -> pure StatePending + _ -> fail $ "Unknown ReqState: " <> T.unpack t + +instance ToJSON ReqState where + toJSON StateActive = String "active" + toJSON StatePending = String "pending" + +-- | Filters members returned by their role in the team. +data TeamMemberRole + = TeamMemberRoleAll -- ^ all members of the team. + | TeamMemberRoleMaintainer -- ^ team maintainers + | TeamMemberRoleMember -- ^ normal members of the team. + deriving (Show, Eq, Ord, Enum, Bounded, Data, Generic) diff --git a/src/GitHub/Data/URL.hs b/src/GitHub/Data/URL.hs new file mode 100644 index 00000000..69ddde70 --- /dev/null +++ b/src/GitHub/Data/URL.hs @@ -0,0 +1,25 @@ +module GitHub.Data.URL ( + URL(..), + getUrl, + ) where + +import GitHub.Internal.Prelude +import Prelude () + +-- | Data representing URLs in responses. +-- +-- /N.B./ syntactical validity is not verified. +newtype URL = URL Text + deriving (Eq, Ord, Show, Generic, Data) + +getUrl :: URL -> Text +getUrl (URL url) = url + +instance NFData URL +instance Binary URL + +instance ToJSON URL where + toJSON (URL url) = toJSON url + +instance FromJSON URL where + parseJSON = withText "URL" (pure . URL) diff --git a/src/GitHub/Data/Webhooks.hs b/src/GitHub/Data/Webhooks.hs new file mode 100644 index 00000000..7d2bac40 --- /dev/null +++ b/src/GitHub/Data/Webhooks.hs @@ -0,0 +1,310 @@ +module GitHub.Data.Webhooks where + +import GitHub.Data.Id (Id) +import GitHub.Data.URL (URL) +import GitHub.Internal.Prelude +import Prelude () + +import qualified Data.Map as M +import qualified Data.Text as T + +data RepoWebhook = RepoWebhook + { repoWebhookUrl :: !URL + , repoWebhookTestUrl :: !URL + , repoWebhookId :: !(Id RepoWebhook) + , repoWebhookName :: !Text + , repoWebhookActive :: !Bool + , repoWebhookEvents :: !(Vector RepoWebhookEvent) + , repoWebhookConfig :: !(M.Map Text Text) + , repoWebhookLastResponse :: !RepoWebhookResponse + , repoWebhookUpdatedAt :: !UTCTime + , repoWebhookCreatedAt :: !UTCTime + } + deriving (Show, Data, Eq, Ord, Generic) + +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 + | WebhookPullRequestEvent + | WebhookPullRequestReviewCommentEvent + | WebhookPullRequestReviewEvent + | WebhookPushEvent + | WebhookRegistryPackageEvent + | WebhookReleaseEvent + | WebhookRepositoryDispatch + | WebhookRepositoryEvent + | WebhookRepositoryImportEvent + | WebhookRepositoryVulnerabilityAlertEvent + | WebhookSecretScanningAlert + | WebhookSecurityAdvisoryEvent + | WebhookSponsorship + | WebhookStarEvent + | WebhookStatusEvent + | WebhookTeamAddEvent + | WebhookTeamEvent + | WebhookWatchEvent + | WebhookWorkflowDispatch + | WebhookWorkflowRun + deriving (Show, Data, Eq, Ord, Generic) + +instance NFData RepoWebhookEvent +instance Binary RepoWebhookEvent + +data RepoWebhookResponse = RepoWebhookResponse + { repoWebhookResponseCode :: !(Maybe Int) + , repoWebhookResponseStatus :: !(Maybe Text) + , repoWebhookResponseMessage :: !(Maybe Text) + } + deriving (Show, Data, Eq, Ord, Generic) + +instance NFData RepoWebhookResponse +instance Binary RepoWebhookResponse + +data PingEvent = PingEvent + { pingEventZen :: !Text + , pingEventHook :: !RepoWebhook + , pingEventHookId :: !(Id RepoWebhook) + } + deriving (Show, Data, Eq, Ord, Generic) + +instance NFData PingEvent +instance Binary PingEvent + +data NewRepoWebhook = NewRepoWebhook + { newRepoWebhookName :: !Text + , newRepoWebhookConfig :: !(M.Map Text Text) + , newRepoWebhookEvents :: !(Maybe (Vector RepoWebhookEvent)) + , newRepoWebhookActive :: !(Maybe Bool) + } + deriving (Eq, Ord, Show, Data, Generic) + +instance NFData NewRepoWebhook +instance Binary NewRepoWebhook + +data EditRepoWebhook = EditRepoWebhook + { editRepoWebhookConfig :: !(Maybe (M.Map Text Text)) + , editRepoWebhookEvents :: !(Maybe (Vector RepoWebhookEvent)) + , editRepoWebhookAddEvents :: !(Maybe (Vector RepoWebhookEvent)) + , editRepoWebhookRemoveEvents :: !(Maybe (Vector RepoWebhookEvent)) + , editRepoWebhookActive :: !(Maybe Bool) + } + deriving (Eq, Ord, Show, Data, Generic) + +instance NFData EditRepoWebhook +instance Binary EditRepoWebhook + +-- JSON instances + +instance FromJSON RepoWebhookEvent where + parseJSON = withText "RepoWebhookEvent" $ \t -> case T.toLower t of + "*" -> pure WebhookWildcardEvent + "check_run" -> pure WebhookCheckRunEvent + "check_suite" -> pure WebhookCheckSuiteEvent + "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 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 + <$> o .: "url" + <*> o .: "test_url" + <*> o .: "id" + <*> o .: "name" + <*> o .: "active" + <*> o .: "events" + <*> o .: "config" + <*> o .: "last_response" + <*> o .: "updated_at" + <*> o .: "created_at" + +instance FromJSON RepoWebhookResponse where + parseJSON = withObject "RepoWebhookResponse" $ \o -> RepoWebhookResponse + <$> o .: "code" + <*> o .:? "status" + <*> o .:? "message" + +instance ToJSON NewRepoWebhook where + toJSON (NewRepoWebhook { newRepoWebhookName = name + , newRepoWebhookConfig = config + , newRepoWebhookEvents = events + , newRepoWebhookActive = active + + }) = object + [ "name" .= name + , "config" .= config + , "events" .= events + , "active" .= active + ] + +instance ToJSON EditRepoWebhook where + toJSON (EditRepoWebhook { editRepoWebhookConfig = config + , editRepoWebhookEvents = events + , editRepoWebhookAddEvents = addEvents + , editRepoWebhookRemoveEvents = removeEvents + , editRepoWebhookActive = active + }) = object + [ "config" .= config + , "events" .= events + , "add_events" .= addEvents + , "remove_events" .= removeEvents + , "active" .= active + ] + +instance FromJSON PingEvent where + parseJSON = withObject "PingEvent" $ \o -> PingEvent + <$> o .: "zen" + <*> o .: "hook" + <*> o .: "hook_id" diff --git a/src/GitHub/Data/Webhooks/Validate.hs b/src/GitHub/Data/Webhooks/Validate.hs new file mode 100644 index 00000000..1ea7590b --- /dev/null +++ b/src/GitHub/Data/Webhooks/Validate.hs @@ -0,0 +1,34 @@ +-- | +-- Verification of incomming webhook payloads, as described at +-- + +module GitHub.Data.Webhooks.Validate ( + isValidPayload +) where + +import GitHub.Internal.Prelude +import Prelude () + +import Crypto.Hash.SHA1 (hmac) +import Data.ByteString (ByteString) + +import qualified Data.ByteString.Base16 as Hex +import qualified Data.Text.Encoding as TE + +-- | Validates a given payload against a given HMAC hexdigest using a given +-- secret. +-- Returns 'True' iff the given hash is non-empty and it's a valid signature of +-- the payload. +isValidPayload + :: Text -- ^ the secret + -> Maybe Text -- ^ the hash provided by the remote party + -- in @X-Hub-Signature@ (if any), + -- including the 'sha1=...' prefix + -> ByteString -- ^ the body + -> Bool +isValidPayload secret shaOpt payload = maybe False (sign ==) shaOptBS + where + shaOptBS = TE.encodeUtf8 <$> shaOpt + hexDigest = Hex.encode + hm = hmac (TE.encodeUtf8 secret) payload + sign = "sha1=" <> hexDigest hm diff --git a/src/GitHub/Endpoints/Actions/Artifacts.hs b/src/GitHub/Endpoints/Actions/Artifacts.hs new file mode 100644 index 00000000..ac55dd61 --- /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 index 00000000..fe085420 --- /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 index 00000000..c6b0d6b8 --- /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 index 00000000..881803b4 --- /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 index 00000000..3039323d --- /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 index 00000000..998a88b4 --- /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 new file mode 100644 index 00000000..1b0676e9 --- /dev/null +++ b/src/GitHub/Endpoints/Activity/Events.hs @@ -0,0 +1,25 @@ +-- | +-- The events API as described on . + +module GitHub.Endpoints.Activity.Events ( + -- * Events + repositoryEventsR, + userEventsR, + module GitHub.Data, + ) where + +import GitHub.Data +import GitHub.Internal.Prelude +import Prelude () + +-- | List repository events. +-- See +repositoryEventsR :: Name Owner -> Name Repo -> FetchCount -> Request 'RO (Vector Event) +repositoryEventsR user repo = + pagedQuery ["repos", toPathPart user, toPathPart repo, "events"] [] + +-- | List user public events. +-- See +userEventsR :: Name User -> FetchCount -> Request 'RO (Vector Event) +userEventsR user = + pagedQuery ["users", toPathPart user, "events", "public"] [] diff --git a/src/GitHub/Endpoints/Activity/Notifications.hs b/src/GitHub/Endpoints/Activity/Notifications.hs new file mode 100644 index 00000000..7a900aa7 --- /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 new file mode 100644 index 00000000..7d77057b --- /dev/null +++ b/src/GitHub/Endpoints/Activity/Starring.hs @@ -0,0 +1,54 @@ +-- | +-- The repo starring API as described on +-- . + +module GitHub.Endpoints.Activity.Starring ( + stargazersForR, + reposStarredByR, + myStarredR, + myStarredAcceptStarR, + starRepoR, + unstarRepoR, + module GitHub.Data, + ) where + +import GitHub.Auth +import GitHub.Data +import GitHub.Internal.Prelude +import Prelude () + +-- | List Stargazers. +-- See +stargazersForR :: Name Owner -> Name Repo -> FetchCount -> Request k (Vector SimpleUser) +stargazersForR user repo = + pagedQuery ["repos", toPathPart user, toPathPart repo, "stargazers"] [] + +-- | List repositories being starred. +-- See +reposStarredByR :: Name Owner -> FetchCount -> Request k (Vector Repo) +reposStarredByR user = + pagedQuery ["users", toPathPart user, "starred"] [] + +-- | All the repos starred by the authenticated user. +-- See +myStarredR :: FetchCount -> Request 'RA (Vector Repo) +myStarredR = pagedQuery ["user", "starred"] [] + +-- | All the repos starred by the authenticated user. +-- See +myStarredAcceptStarR :: FetchCount -> GenRequest 'MtStar 'RA (Vector RepoStarred) +myStarredAcceptStarR = PagedQuery ["user", "starred"] [] + +-- | Star a repo by the authenticated user. +-- See +starRepoR :: Name Owner -> Name Repo -> GenRequest 'MtUnit 'RW () +starRepoR user repo = Command Put paths mempty + where + paths = ["user", "starred", toPathPart user, toPathPart repo] + +-- | Unstar a repo by the authenticated user. +-- See +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 new file mode 100644 index 00000000..3ad5954b --- /dev/null +++ b/src/GitHub/Endpoints/Activity/Watching.hs @@ -0,0 +1,33 @@ +-- | +-- The repo watching API as described on +-- . + +module GitHub.Endpoints.Activity.Watching ( + watchersForR, + reposWatchedByR, + unwatchRepoR, + module GitHub.Data, +) where + +import GitHub.Auth +import GitHub.Data +import GitHub.Internal.Prelude +import Prelude () + +-- | 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 + +-- | 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 index 00000000..1e71334f --- /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 new file mode 100644 index 00000000..da1fc194 --- /dev/null +++ b/src/GitHub/Endpoints/Gists.hs @@ -0,0 +1,47 @@ +-- | +-- The gists API as described at . + +module GitHub.Endpoints.Gists ( + gistsR, + gistR, + createGistR, + starGistR, + unstarGistR, + deleteGistR, + module GitHub.Data, + ) where + +import GitHub.Data +import GitHub.Internal.Prelude +import Prelude () + +-- | List gists. +-- See +gistsR :: Name Owner -> FetchCount -> Request k (Vector Gist) +gistsR user = pagedQuery ["users", toPathPart user, "gists"] [] + +-- | Query a single gist. +-- See +gistR :: Name Gist -> Request k Gist +gistR gid = + query ["gists", toPathPart 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 -> GenRequest 'MtUnit 'RW () +starGistR gid = Command Put ["gists", toPathPart gid, "star"] mempty + +-- | Unstar a gist by the authenticated user. +-- See +unstarGistR :: Name Gist -> GenRequest 'MtUnit 'RW () +unstarGistR gid = Command Delete ["gists", toPathPart gid, "star"] mempty + +-- | Delete a gist by the authenticated user. +-- See +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 new file mode 100644 index 00000000..5234a63c --- /dev/null +++ b/src/GitHub/Endpoints/Gists/Comments.hs @@ -0,0 +1,25 @@ +-- | +-- The loving comments people have left on Gists, described on +-- . + +module GitHub.Endpoints.Gists.Comments ( + commentsOnR, + gistCommentR, + module GitHub.Data, + ) where + +import GitHub.Data +import GitHub.Internal.Prelude +import Prelude () + +-- | List comments on a gist. +-- See +commentsOnR :: Name Gist -> FetchCount -> Request k (Vector GistComment) +commentsOnR gid = + pagedQuery ["gists", toPathPart gid, "comments"] [] + +-- | Query a single comment. +-- See +gistCommentR :: Id GistComment -> Request k GistComment +gistCommentR cid = + query ["gists", "comments", toPathPart cid] [] diff --git a/src/GitHub/Endpoints/GitData/Blobs.hs b/src/GitHub/Endpoints/GitData/Blobs.hs new file mode 100644 index 00000000..c7b39aea --- /dev/null +++ b/src/GitHub/Endpoints/GitData/Blobs.hs @@ -0,0 +1,17 @@ +-- | +-- The API for dealing with git blobs from Github repos, as described in +-- . + +module GitHub.Endpoints.GitData.Blobs ( + blobR, + module GitHub.Data, + ) where + +import GitHub.Data +import Prelude () + +-- | Query a blob. +-- See +blobR :: Name Owner -> Name Repo -> Name Blob -> Request k Blob +blobR user repo sha = + query ["repos", toPathPart user, toPathPart repo, "git", "blobs", toPathPart sha] [] diff --git a/src/GitHub/Endpoints/GitData/Commits.hs b/src/GitHub/Endpoints/GitData/Commits.hs new file mode 100644 index 00000000..82a18bf3 --- /dev/null +++ b/src/GitHub/Endpoints/GitData/Commits.hs @@ -0,0 +1,17 @@ +-- | +-- The API for underlying git commits of a Github repo, as described on +-- . + +module GitHub.Endpoints.GitData.Commits ( + gitCommitR, + module GitHub.Data, +) where + +import GitHub.Data +import Prelude () + +-- | Query a commit. +-- See +gitCommitR :: Name Owner -> Name Repo -> Name GitCommit -> Request k GitCommit +gitCommitR user repo sha = + query ["repos", toPathPart user, toPathPart repo, "git", "commits", toPathPart sha] [] diff --git a/src/GitHub/Endpoints/GitData/References.hs b/src/GitHub/Endpoints/GitData/References.hs new file mode 100644 index 00000000..a1f10814 --- /dev/null +++ b/src/GitHub/Endpoints/GitData/References.hs @@ -0,0 +1,47 @@ +-- | +-- 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 ( + referenceR, + referencesR, + createReferenceR, + deleteReferenceR, + namespacedReferencesR, + module GitHub.Data, + ) where + +import GitHub.Data +import GitHub.Internal.Prelude +import Prelude () + +-- | 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] [] + +-- | Query all References. +-- See +referencesR :: Name Owner -> Name Repo -> FetchCount -> Request k (Vector GitReference) +referencesR user repo = + pagedQuery ["repos", toPathPart user, toPathPart repo, "git", "refs"] [] + +-- | Create a reference. +-- 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) + +-- | 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 +namespacedReferencesR :: Name Owner -> Name Repo -> Text -> Request k [GitReference] +namespacedReferencesR user repo namespace = + query ["repos", toPathPart user, toPathPart repo, "git", "refs", namespace] [] diff --git a/src/GitHub/Endpoints/GitData/Trees.hs b/src/GitHub/Endpoints/GitData/Trees.hs new file mode 100644 index 00000000..4bdf389b --- /dev/null +++ b/src/GitHub/Endpoints/GitData/Trees.hs @@ -0,0 +1,25 @@ +-- | +-- The underlying tree of SHA1s and files that make up a git repo. The API is +-- described on . + +module GitHub.Endpoints.GitData.Trees ( + treeR, + nestedTreeR, + module GitHub.Data, + ) where + +import GitHub.Data +import GitHub.Internal.Prelude +import Prelude () + +-- | 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] [] + +-- | Query a Tree Recursively. +-- See +nestedTreeR :: Name Owner -> Name Repo -> Name Tree -> Request k Tree +nestedTreeR user repo sha = + query ["repos", toPathPart user, toPathPart repo, "git", "trees", toPathPart sha] [("recursive", Just "1")] diff --git a/src/GitHub/Endpoints/Issues.hs b/src/GitHub/Endpoints/Issues.hs new file mode 100644 index 00000000..47888dc5 --- /dev/null +++ b/src/GitHub/Endpoints/Issues.hs @@ -0,0 +1,64 @@ +-- | +-- The issues API as described on . + +module GitHub.Endpoints.Issues ( + currentUserIssuesR, + organizationIssuesR, + issueR, + issuesForRepoR, + createIssueR, + newIssue, + editIssueR, + editOfIssue, + module GitHub.Data, + ) where + +import GitHub.Data +import GitHub.Internal.Prelude +import Prelude () + +-- | See . +currentUserIssuesR :: IssueMod -> FetchCount -> Request 'RA (Vector Issue) +currentUserIssuesR opts = + pagedQuery ["user", "issues"] (issueModToQueryString opts) + +-- | See . +organizationIssuesR :: Name Organization -> IssueMod -> FetchCount -> Request k (Vector Issue) +organizationIssuesR org opts = + pagedQuery ["orgs", toPathPart org, "issues"] (issueModToQueryString opts) + +-- | Query a single issue. +-- See +issueR :: Name Owner -> Name Repo -> IssueNumber -> Request k Issue +issueR user reqRepoName reqIssueNumber = + query ["repos", toPathPart user, toPathPart reqRepoName, "issues", toPathPart reqIssueNumber] [] + +-- | List issues for a repository. +-- See +issuesForRepoR :: Name Owner -> Name Repo -> IssueRepoMod -> FetchCount -> Request k (Vector Issue) +issuesForRepoR user reqRepoName opts = + pagedQuery ["repos", toPathPart user, toPathPart reqRepoName, "issues"] qs + where + qs = issueRepoModToQueryString opts + +-- Creating new issues. + +newIssue :: Text -> NewIssue +newIssue title = NewIssue title Nothing mempty Nothing Nothing + +-- | Create an issue. +-- See +createIssueR :: Name Owner -> Name Repo -> NewIssue -> Request 'RW Issue +createIssueR user repo = + command Post ["repos", toPathPart user, toPathPart repo, "issues"] . encode + +-- Editing issues. + +editOfIssue :: EditIssue +editOfIssue = EditIssue Nothing Nothing Nothing Nothing Nothing Nothing + +-- | Edit an issue. +-- See +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 new file mode 100644 index 00000000..0c307d3f --- /dev/null +++ b/src/GitHub/Endpoints/Issues/Comments.hs @@ -0,0 +1,52 @@ +-- | +-- The Github issue comments API from +-- . + +module GitHub.Endpoints.Issues.Comments ( + commentR, + commentsR, + createCommentR, + deleteCommentR, + editCommentR, + module GitHub.Data, + ) where + +import GitHub.Data +import GitHub.Internal.Prelude +import Prelude () + +-- | 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] [] + +-- | List comments on an issue. +-- See +commentsR :: Name Owner -> Name Repo -> IssueNumber -> FetchCount -> Request k (Vector IssueComment) +commentsR user repo iid = + pagedQuery ["repos", toPathPart user, toPathPart repo, "issues", toPathPart iid, "comments"] [] + +-- | Create a comment. +-- See +createCommentR :: Name Owner -> Name Repo -> IssueNumber -> Text -> Request 'RW Comment +createCommentR user repo iss body = + command Post parts (encode $ NewComment body) + where + parts = ["repos", toPathPart user, toPathPart repo, "issues", toPathPart iss, "comments"] + +-- | Edit a comment. +-- See +editCommentR :: Name Owner -> Name Repo -> Id Comment -> Text -> Request 'RW Comment +editCommentR user repo commid body = + command Patch parts (encode $ EditComment body) + where + parts = ["repos", toPathPart user, toPathPart repo, "issues", "comments", toPathPart commid] + +-- | Delete a comment. +-- See +deleteCommentR :: Name Owner -> Name Repo -> Id Comment -> GenRequest 'MtUnit 'RW () +deleteCommentR user repo commid = + Command Delete parts mempty + where + parts = ["repos", toPathPart user, toPathPart repo, "issues", "comments", toPathPart commid] diff --git a/src/GitHub/Endpoints/Issues/Events.hs b/src/GitHub/Endpoints/Issues/Events.hs new file mode 100644 index 00000000..0639026c --- /dev/null +++ b/src/GitHub/Endpoints/Issues/Events.hs @@ -0,0 +1,32 @@ +-- | +-- The Github issue events API, which is described on +-- + +module GitHub.Endpoints.Issues.Events ( + eventsForIssueR, + eventsForRepoR, + eventR, + module GitHub.Data, + ) where + +import GitHub.Data +import GitHub.Internal.Prelude +import Prelude () + +-- | 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"] [] + +-- | 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"] [] + +-- | Query a single event. +-- See +eventR :: Name Owner -> Name Repo -> Id IssueEvent -> Request k IssueEvent +eventR user repo eid = + query ["repos", toPathPart user, toPathPart repo, "issues", "events", toPathPart eid] [] diff --git a/src/GitHub/Endpoints/Issues/Labels.hs b/src/GitHub/Endpoints/Issues/Labels.hs new file mode 100644 index 00000000..bdf2319d --- /dev/null +++ b/src/GitHub/Endpoints/Issues/Labels.hs @@ -0,0 +1,108 @@ +-- | +-- The API for dealing with labels on Github issues as described on +-- . + +module GitHub.Endpoints.Issues.Labels ( + labelsOnRepoR, + labelR, + createLabelR, + updateLabelR, + deleteLabelR, + labelsOnIssueR, + addLabelsToIssueR, + removeLabelFromIssueR, + replaceAllLabelsForIssueR, + removeAllLabelsFromIssueR, + labelsOnMilestoneR, + module GitHub.Data, + ) where + +import GitHub.Data +import GitHub.Internal.Prelude +import Prelude () + +-- | 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"] [] + +-- | 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. +-- See +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 + -> UpdateIssueLabel -- ^ new label + -> Request 'RW IssueLabel +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 -> GenRequest 'MtUnit 'RW () +deleteLabelR user repo lbl = + Command Delete ["repos", toPathPart user, toPathPart repo, "labels", toPathPart lbl] mempty + +-- | List labels on an issue. +-- See +labelsOnIssueR :: Name Owner -> Name Repo -> Id Issue -> FetchCount -> Request k (Vector IssueLabel) +labelsOnIssueR user repo iid = + pagedQuery ["repos", toPathPart user, toPathPart repo, "issues", toPathPart iid, "labels"] [] + +-- | Add lables to an issue. +-- See +addLabelsToIssueR :: Foldable f + => Name Owner + -> Name Repo + -> Id Issue + -> f (Name IssueLabel) + -> Request 'RW (Vector IssueLabel) +addLabelsToIssueR user repo iid lbls = + command Post paths (encode $ toList lbls) + where + paths = ["repos", toPathPart user, toPathPart repo, "issues", toPathPart iid, "labels"] + +-- | Remove a label from an issue. +-- See +removeLabelFromIssueR :: Name Owner -> Name Repo -> Id Issue -> Name IssueLabel -> GenRequest 'MtUnit 'RW () +removeLabelFromIssueR user repo iid lbl = + Command Delete ["repos", toPathPart user, toPathPart repo, "issues", toPathPart iid, "labels", toPathPart lbl] mempty + +-- | Replace all labels on an issue. +-- See +-- +-- Sending an empty list will remove all labels from the issue. +replaceAllLabelsForIssueR :: Foldable f + => Name Owner + -> Name Repo + -> Id Issue + -> f (Name IssueLabel) + -> Request 'RW (Vector IssueLabel) +replaceAllLabelsForIssueR user repo iid lbls = + command Put paths (encode $ toList lbls) + where + paths = ["repos", toPathPart user, toPathPart repo, "issues", toPathPart iid, "labels"] + +-- | Remove all labels from an issue. +-- See +removeAllLabelsFromIssueR :: Name Owner -> Name Repo -> Id Issue -> GenRequest 'MtUnit 'RW () +removeAllLabelsFromIssueR user repo iid = + Command Delete ["repos", toPathPart user, toPathPart repo, "issues", toPathPart iid, "labels"] mempty + +-- | Query labels for every issue in a milestone. +-- See +labelsOnMilestoneR :: Name Owner -> Name Repo -> Id Milestone -> FetchCount -> Request k (Vector IssueLabel) +labelsOnMilestoneR user repo mid = + pagedQuery ["repos", toPathPart user, toPathPart repo, "milestones", toPathPart mid, "labels"] [] diff --git a/src/GitHub/Endpoints/Issues/Milestones.hs b/src/GitHub/Endpoints/Issues/Milestones.hs new file mode 100644 index 00000000..18d5d9d4 --- /dev/null +++ b/src/GitHub/Endpoints/Issues/Milestones.hs @@ -0,0 +1,47 @@ +-- | +-- The milestones API as described on +-- . + +module GitHub.Endpoints.Issues.Milestones ( + milestonesR, + milestoneR, + createMilestoneR, + updateMilestoneR, + deleteMilestoneR, + module GitHub.Data, + ) where + +import GitHub.Data +import GitHub.Internal.Prelude +import Prelude () + +-- | 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"] [] + +-- | 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 new file mode 100644 index 00000000..0cb3da47 --- /dev/null +++ b/src/GitHub/Endpoints/Organizations.hs @@ -0,0 +1,28 @@ +-- | +-- The orgs API as described on . + +module GitHub.Endpoints.Organizations ( + publicOrganizationsForR, + publicOrganizationR, + organizationsR, + module GitHub.Data, + ) where + +import GitHub.Data +import GitHub.Internal.Prelude +import Prelude () + +-- | List all user organizations. +-- See +organizationsR :: FetchCount -> Request k (Vector SimpleOrganization) +organizationsR = pagedQuery ["user", "orgs"] [] + +-- | List public user organizations. +-- See +publicOrganizationsForR :: Name User -> FetchCount -> Request k (Vector SimpleOrganization) +publicOrganizationsForR user = pagedQuery ["users", toPathPart user, "orgs"] [] + +-- | Query an organization. +-- See +publicOrganizationR :: Name Organization -> Request k Organization +publicOrganizationR reqOrganizationName = query ["orgs", toPathPart reqOrganizationName] [] diff --git a/src/GitHub/Endpoints/Organizations/Members.hs b/src/GitHub/Endpoints/Organizations/Members.hs new file mode 100644 index 00000000..8de82b77 --- /dev/null +++ b/src/GitHub/Endpoints/Organizations/Members.hs @@ -0,0 +1,58 @@ +-- | +-- The organization members API as described on +-- . + +module GitHub.Endpoints.Organizations.Members ( + membersOfR, + membersOfWithR, + isMemberOfR, + orgInvitationsR, + orgMembershipR, + module GitHub.Data, + ) where + +import GitHub.Data +import GitHub.Internal.Prelude +import Prelude () + +-- | All the users who are members of the specified organization. +-- +-- See +membersOfR :: Name Organization -> FetchCount -> Request k (Vector SimpleUser) +membersOfR organization = + pagedQuery ["orgs", toPathPart organization, "members"] [] + +-- | 'membersOfR' with filters. +-- +-- See +membersOfWithR :: Name Organization -> OrgMemberFilter -> OrgMemberRole -> FetchCount -> Request k (Vector SimpleUser) +membersOfWithR org f r = + pagedQuery ["orgs", toPathPart org, "members"] [("filter", Just f'), ("role", Just r')] + where + f' = case f of + OrgMemberFilter2faDisabled -> "2fa_disabled" + OrgMemberFilterAll -> "all" + r' = case r of + OrgMemberRoleAll -> "all" + OrgMemberRoleAdmin -> "admin" + OrgMemberRoleMember -> "member" + +-- | Check if a user is a member of an organization. +-- +-- See +isMemberOfR :: Name User -> Name Organization -> GenRequest 'MtStatus rw Bool +isMemberOfR user org = + Query [ "orgs", toPathPart org, "members", toPathPart user ] [] + +-- | List pending organization invitations +-- +-- See +orgInvitationsR :: Name Organization -> FetchCount -> Request 'RA (Vector Invitation) +orgInvitationsR org = pagedQuery ["orgs", toPathPart org, "invitations"] [] + +-- | 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 ] [] \ No newline at end of file diff --git a/src/GitHub/Endpoints/Organizations/OutsideCollaborators.hs b/src/GitHub/Endpoints/Organizations/OutsideCollaborators.hs new file mode 100644 index 00000000..dee42fcf --- /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 new file mode 100644 index 00000000..af8c8b36 --- /dev/null +++ b/src/GitHub/Endpoints/Organizations/Teams.hs @@ -0,0 +1,101 @@ +-- | +-- The Owner teams API as described on +-- . + +module GitHub.Endpoints.Organizations.Teams ( + teamsOfR, + teamInfoForR, + createTeamForR, + editTeamR, + deleteTeamR, + listTeamMembersR, + listTeamReposR, + addOrUpdateTeamRepoR, + teamMembershipInfoForR, + addTeamMembershipForR, + deleteTeamMembershipForR, + listTeamsCurrentR, + module GitHub.Data, + ) where + +import GitHub.Data +import GitHub.Internal.Prelude +import Prelude () + +-- | List teams. +-- See +teamsOfR :: Name Organization -> FetchCount -> Request k (Vector SimpleTeam) +teamsOfR org = + pagedQuery ["orgs", toPathPart org, "teams"] [] + +-- | Query team. +-- See +teamInfoForR :: Id Team -> Request k Team +teamInfoForR tid = + query ["teams", toPathPart tid] [] + +-- | Create team. +-- See +createTeamForR :: Name Organization -> CreateTeam -> Request 'RW Team +createTeamForR org cteam = + command Post ["orgs", toPathPart org, "teams"] (encode cteam) + +-- | Edit team. +-- See +editTeamR :: Id Team -> EditTeam -> Request 'RW Team +editTeamR tid eteam = + command Patch ["teams", toPathPart tid] (encode eteam) + +-- +-- See +deleteTeamR :: Id Team -> GenRequest 'MtUnit 'RW () +deleteTeamR tid = + Command Delete ["teams", toPathPart tid] mempty + +-- | List team members. +-- +-- See +listTeamMembersR :: Id Team -> TeamMemberRole -> FetchCount -> Request 'RA (Vector SimpleUser) +listTeamMembersR tid r = + pagedQuery ["teams", toPathPart tid, "members"] [("role", Just r')] + where + r' = case r of + TeamMemberRoleAll -> "all" + TeamMemberRoleMaintainer -> "maintainer" + TeamMemberRoleMember -> "member" + +-- | Query team repositories. +-- See +listTeamReposR :: Id Team -> FetchCount -> Request k (Vector Repo) +listTeamReposR tid = + pagedQuery ["teams", toPathPart tid, "repos"] [] + +-- | Add or update a team repository. +-- See +addOrUpdateTeamRepoR :: Id Team -> Name Organization -> Name Repo -> Permission -> GenRequest 'MtUnit 'RW () +addOrUpdateTeamRepoR tid org repo permission = + Command Put ["teams", toPathPart tid, "repos", toPathPart org, toPathPart repo] (encode $ AddTeamRepoPermission permission) + +-- | Query team membership. +-- See Name Owner -> Request k TeamMembership +teamMembershipInfoForR tid user = + query ["teams", toPathPart tid, "memberships", toPathPart user] [] + +-- | 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) + +-- | Remove team membership. +-- See +deleteTeamMembershipForR :: Id Team -> Name Owner -> GenRequest 'MtUnit 'RW () +deleteTeamMembershipForR tid user = + Command Delete ["teams", toPathPart tid, "memberships", toPathPart user] mempty + +-- | List user teams. +-- See +listTeamsCurrentR :: FetchCount -> Request 'RA (Vector Team) +listTeamsCurrentR = + pagedQuery ["user", "teams"] [] diff --git a/src/GitHub/Endpoints/PullRequests.hs b/src/GitHub/Endpoints/PullRequests.hs new file mode 100644 index 00000000..5e5d6aac --- /dev/null +++ b/src/GitHub/Endpoints/PullRequests.hs @@ -0,0 +1,101 @@ +-- | +-- The pull requests API as documented at +-- . + +module GitHub.Endpoints.PullRequests ( + pullRequestsForR, + pullRequestR, + pullRequestDiffR, + pullRequestPatchR, + createPullRequestR, + updatePullRequestR, + pullRequestCommitsR, + pullRequestFilesR, + isPullRequestMergedR, + mergePullRequestR, + module GitHub.Data + ) where + +import GitHub.Data +import GitHub.Internal.Prelude +import Prelude () +import Data.ByteString.Lazy (ByteString) + +-- | List pull requests. +-- See +pullRequestsForR + :: Name Owner + -> Name Repo + -> PullRequestMod + -> FetchCount + -> Request k (Vector SimplePullRequest) +pullRequestsForR user repo opts = pagedQuery + ["repos", toPathPart user, toPathPart repo, "pulls"] + (prModToQueryString opts) + +-- | 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] [] + +-- | 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 -> IssueNumber -> Request k PullRequest +pullRequestR user repo prid = + query ["repos", toPathPart user, toPathPart repo, "pulls", toPathPart prid] [] + +-- | Create a pull request. +-- See +createPullRequestR :: Name Owner + -> Name Repo + -> CreatePullRequest + -> Request 'RW PullRequest +createPullRequestR user repo cpr = + command Post ["repos", toPathPart user, toPathPart repo, "pulls"] (encode cpr) + +-- | Update a pull request. +-- See +updatePullRequestR :: Name Owner + -> Name Repo + -> IssueNumber + -> EditPullRequest + -> Request 'RW PullRequest +updatePullRequestR user repo prid epr = + command Patch ["repos", toPathPart user, toPathPart repo, "pulls", toPathPart prid] (encode epr) + +-- | List commits on a pull request. +-- See +pullRequestCommitsR :: Name Owner -> Name Repo -> IssueNumber -> FetchCount -> Request k (Vector Commit) +pullRequestCommitsR user repo prid = + pagedQuery ["repos", toPathPart user, toPathPart repo, "pulls", toPathPart prid, "commits"] [] + +-- | List pull requests files. +-- See +pullRequestFilesR :: Name Owner -> Name Repo -> IssueNumber -> FetchCount -> Request k (Vector File) +pullRequestFilesR user repo prid = + pagedQuery ["repos", toPathPart user, toPathPart repo, "pulls", toPathPart prid, "files"] [] + +-- | Query if a pull request has been merged. +-- See +isPullRequestMergedR :: Name Owner -> Name Repo -> IssueNumber -> GenRequest 'MtStatus rw Bool +isPullRequestMergedR user repo prid = + Query ["repos", toPathPart user, toPathPart repo, "pulls", toPathPart prid, "merge"] [] + +-- | Merge a pull request (Merge Button). +-- https://developer.github.com/v3/pulls/#merge-a-pull-request-merge-button +mergePullRequestR :: Name Owner -> Name Repo -> IssueNumber -> Maybe Text -> GenRequest 'MtStatus 'RW MergeResult +mergePullRequestR user repo prid commitMessage = + Command Put paths (encode $ buildCommitMessageMap commitMessage) + where + paths = ["repos", toPathPart user, toPathPart repo, "pulls", toPathPart prid, "merge"] + + buildCommitMessageMap :: Maybe Text -> Value + buildCommitMessageMap (Just msg) = object ["commit_message" .= msg ] + buildCommitMessageMap Nothing = object [] diff --git a/src/GitHub/Endpoints/PullRequests/Comments.hs b/src/GitHub/Endpoints/PullRequests/Comments.hs new file mode 100644 index 00000000..e1117921 --- /dev/null +++ b/src/GitHub/Endpoints/PullRequests/Comments.hs @@ -0,0 +1,46 @@ +-- | +-- The pull request review comments API as described at +-- . + +module GitHub.Endpoints.PullRequests.Comments ( + pullRequestCommentsR, + pullRequestCommentR, + createPullCommentR, + createPullCommentReplyR, + module GitHub.Data, + ) where + +import GitHub.Data +import GitHub.Internal.Prelude +import Prelude () + +-- | List comments on a pull request. +-- See +pullRequestCommentsR :: Name Owner -> Name Repo -> IssueNumber -> FetchCount -> Request k (Vector Comment) +pullRequestCommentsR user repo prid = + pagedQuery ["repos", toPathPart user, toPathPart repo, "pulls", toPathPart prid, "comments"] [] + +-- | 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 new file mode 100644 index 00000000..e746e570 --- /dev/null +++ b/src/GitHub/Endpoints/PullRequests/Reviews.hs @@ -0,0 +1,73 @@ +-- | +-- The reviews API as described on . + +module GitHub.Endpoints.PullRequests.Reviews + ( pullRequestReviewsR + , pullRequestReviewR + , pullRequestReviewCommentsR + , module GitHub.Data + ) where + +import GitHub.Data +import GitHub.Internal.Prelude +import Prelude () + +-- | List reviews for a pull request. +-- See +pullRequestReviewsR + :: Name Owner + -> Name Repo + -> IssueNumber + -> FetchCount + -> Request k (Vector Review) +pullRequestReviewsR owner repo prid = + pagedQuery + [ "repos" + , toPathPart owner + , toPathPart repo + , "pulls" + , toPathPart prid + , "reviews" + ] + [] + +-- | Query a single pull request review. +-- see +pullRequestReviewR + :: Name Owner + -> Name Repo + -> IssueNumber + -> Id Review + -> Request k Review +pullRequestReviewR owner repo prid rid = + query + [ "repos" + , toPathPart owner + , toPathPart repo + , "pulls" + , toPathPart prid + , "reviews" + , toPathPart rid + ] + [] + +-- | Query the comments for a single pull request review. +-- see +pullRequestReviewCommentsR + :: Name Owner + -> Name Repo + -> IssueNumber + -> Id Review + -> Request k [ReviewComment] +pullRequestReviewCommentsR owner repo prid rid = + query + [ "repos" + , toPathPart owner + , toPathPart repo + , "pulls" + , toPathPart prid + , "reviews" + , toPathPart rid + , "comments" + ] + [] diff --git a/src/GitHub/Endpoints/RateLimit.hs b/src/GitHub/Endpoints/RateLimit.hs new file mode 100644 index 00000000..8d559613 --- /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 index 00000000..a4ec31f7 --- /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 new file mode 100644 index 00000000..85c8b639 --- /dev/null +++ b/src/GitHub/Endpoints/Repos.hs @@ -0,0 +1,140 @@ +-- | +-- The Github Repos API, as documented at +-- + +module GitHub.Endpoints.Repos ( + -- * Querying repositories + currentUserReposR, + userReposR, + organizationReposR, + repositoryR, + contributorsR, + languagesForR, + tagsForR, + branchesForR, + + -- ** Create + createRepoR, + createOrganizationRepoR, + forkExistingRepoR, + + -- ** Edit + editRepoR, + + -- ** Delete + deleteRepoR, + + -- * Data + module GitHub.Data, + ) where + +import GitHub.Data +import GitHub.Internal.Prelude +import Prelude () + +repoPublicityQueryString :: RepoPublicity -> QueryString +repoPublicityQueryString RepoPublicityAll = [("type", Just "all")] +repoPublicityQueryString RepoPublicityOwner = [("type", Just "owner")] +repoPublicityQueryString RepoPublicityMember = [("type", Just "member")] +repoPublicityQueryString RepoPublicityPublic = [("type", Just "public")] +repoPublicityQueryString RepoPublicityPrivate = [("type", Just "private")] + +-- | List your repositories. +-- See +currentUserReposR :: RepoPublicity -> FetchCount -> Request k (Vector Repo) +currentUserReposR publicity = + pagedQuery ["user", "repos"] qs + where + qs = repoPublicityQueryString publicity + +-- | List user repositories. +-- See +userReposR :: Name Owner -> RepoPublicity -> FetchCount -> Request k(Vector Repo) +userReposR user publicity = + pagedQuery ["users", toPathPart user, "repos"] qs + where + qs = repoPublicityQueryString publicity + +-- | List organization repositories. +-- See +organizationReposR + :: Name Organization + -> RepoPublicity + -> FetchCount + -> Request k (Vector Repo) +organizationReposR org publicity = + pagedQuery ["orgs", toPathPart org, "repos"] qs + where + qs = repoPublicityQueryString publicity + +-- | Query single repository. +-- See +repositoryR :: Name Owner -> Name Repo -> Request k Repo +repositoryR user repo = + query ["repos", toPathPart user, toPathPart repo] [] + +-- | Create a new repository. +-- See +createRepoR :: NewRepo -> Request 'RW Repo +createRepoR nrepo = + command Post ["user", "repos"] (encode nrepo) + +-- | Fork an existing repository. +-- See +-- TODO: The third paramater (an optional Organisation) is not used yet. +forkExistingRepoR :: Name Owner -> Name Repo -> Maybe (Name Owner) -> Request 'RW Repo +forkExistingRepoR owner repo _morg = + command Post ["repos", toPathPart owner, toPathPart repo, "forks" ] mempty + +-- | Create a new repository for an organization. +-- See +createOrganizationRepoR :: Name Organization -> NewRepo -> Request 'RW Repo +createOrganizationRepoR org nrepo = + command Post ["orgs", toPathPart org, "repos"] (encode nrepo) + +-- | Edit an existing repository. +-- See +editRepoR :: Name Owner -> Name Repo -> EditRepo -> Request 'RW Repo +editRepoR user repo body = + command Patch ["repos", toPathPart user, toPathPart repo] (encode b) + where + -- if no name is given, use curent name + b = body {editName = editName body <|> Just repo} + +-- | List contributors. +-- See +contributorsR + :: Name Owner + -> Name Repo + -> Bool -- ^ Include anonymous + -> FetchCount + -> Request k (Vector Contributor) +contributorsR user repo anon = + pagedQuery ["repos", toPathPart user, toPathPart repo, "contributors"] qs + where + qs | anon = [("anon", Just "true")] + | otherwise = [] + +-- | List languages. +-- See +languagesForR :: Name Owner -> Name Repo -> Request k Languages +languagesForR user repo = + query ["repos", toPathPart user, toPathPart repo, "languages"] [] + +-- | List tags. +-- See +tagsForR :: Name Owner -> Name Repo -> FetchCount -> Request k (Vector Tag) +tagsForR user repo = + pagedQuery ["repos", toPathPart user, toPathPart repo, "tags"] [] + +-- | List branches. +-- See +branchesForR :: Name Owner -> Name Repo -> FetchCount -> Request k (Vector Branch) +branchesForR user repo = + pagedQuery ["repos", toPathPart user, toPathPart repo, "branches"] [] + +-- | Delete a repository,. +-- See +deleteRepoR :: Name Owner -> Name Repo -> GenRequest 'MtUnit 'RW () +deleteRepoR user repo = + Command Delete ["repos", toPathPart user, toPathPart repo] mempty diff --git a/src/GitHub/Endpoints/Repos/Collaborators.hs b/src/GitHub/Endpoints/Repos/Collaborators.hs new file mode 100644 index 00000000..f587636d --- /dev/null +++ b/src/GitHub/Endpoints/Repos/Collaborators.hs @@ -0,0 +1,51 @@ +-- | +-- The repo collaborators API as described on +-- . + +module GitHub.Endpoints.Repos.Collaborators ( + collaboratorsOnR, + collaboratorPermissionOnR, + isCollaboratorOnR, + addCollaboratorR, + module GitHub.Data, + ) where + +import GitHub.Data +import GitHub.Internal.Prelude +import Prelude () + +-- | List collaborators. +-- See +collaboratorsOnR :: Name Owner -> Name Repo -> FetchCount -> Request k (Vector SimpleUser) +collaboratorsOnR user repo = + pagedQuery ["repos", toPathPart user, toPathPart repo, "collaborators"] [] + +-- | Review a user's permission level. +-- +collaboratorPermissionOnR + :: Name Owner -- ^ Repository owner + -> Name Repo -- ^ Repository name + -> 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 +isCollaboratorOnR + :: Name Owner -- ^ Repository owner + -> Name Repo -- ^ Repository name + -> Name User -- ^ Collaborator? + -> GenRequest 'MtStatus rw Bool +isCollaboratorOnR user repo coll = + Query ["repos", toPathPart user, toPathPart repo, "collaborators", toPathPart coll] [] + +-- | 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 new file mode 100644 index 00000000..bd554492 --- /dev/null +++ b/src/GitHub/Endpoints/Repos/Comments.hs @@ -0,0 +1,32 @@ +-- | +-- The repo commits API as described on +-- . + +module GitHub.Endpoints.Repos.Comments ( + commentsForR, + commitCommentsForR, + commitCommentForR, + module GitHub.Data, + ) where + +import GitHub.Data +import GitHub.Internal.Prelude +import Prelude () + +-- | 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"] [] + +-- | 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"] [] + +-- | Query a single commit comment. +-- See +commitCommentForR :: Name Owner -> Name Repo -> Id Comment -> Request k Comment +commitCommentForR user repo cid = + query ["repos", toPathPart user, toPathPart repo, "comments", toPathPart cid] [] diff --git a/src/GitHub/Endpoints/Repos/Commits.hs b/src/GitHub/Endpoints/Repos/Commits.hs new file mode 100644 index 00000000..1c50c651 --- /dev/null +++ b/src/GitHub/Endpoints/Repos/Commits.hs @@ -0,0 +1,52 @@ +-- | +-- The repo commits API as described on +-- . + +module GitHub.Endpoints.Repos.Commits ( + CommitQueryOption(..), + commitsForR, + commitsWithOptionsForR, + commitR, + diffR, + module GitHub.Data, + ) where + +import GitHub.Data +import GitHub.Internal.Prelude +import Prelude () + +import qualified Data.ByteString as BS +import qualified Data.Text as T +import qualified Data.Text.Encoding as TE + +renderCommitQueryOption :: CommitQueryOption -> (BS.ByteString, Maybe BS.ByteString) +renderCommitQueryOption (CommitQuerySha sha) = ("sha", Just $ TE.encodeUtf8 sha) +renderCommitQueryOption (CommitQueryPath path) = ("path", Just $ TE.encodeUtf8 path) +renderCommitQueryOption (CommitQueryAuthor author) = ("author", Just $ TE.encodeUtf8 author) +renderCommitQueryOption (CommitQuerySince date) = ("since", Just $ TE.encodeUtf8 . T.pack $ formatISO8601 date) +renderCommitQueryOption (CommitQueryUntil date) = ("until", Just $ TE.encodeUtf8 . T.pack $ formatISO8601 date) + +-- | List commits on a repository. +-- See +commitsForR :: Name Owner -> Name Repo -> FetchCount -> Request k (Vector Commit) +commitsForR user repo limit = commitsWithOptionsForR user repo limit [] + +-- | List commits on a repository. +-- See +commitsWithOptionsForR :: Name Owner -> Name Repo -> FetchCount -> [CommitQueryOption] -> Request k (Vector Commit) +commitsWithOptionsForR user repo limit opts = + pagedQuery ["repos", toPathPart user, toPathPart repo, "commits"] qs limit + where + qs = map renderCommitQueryOption opts + +-- | 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] [] + +-- | Compare two commits. +-- See +diffR :: Name Owner -> Name Repo -> Name Commit -> Name Commit -> Request k Diff +diffR user repo base headref = + query ["repos", toPathPart user, toPathPart repo, "compare", toPathPart base <> "..." <> toPathPart headref] [] diff --git a/src/GitHub/Endpoints/Repos/Contents.hs b/src/GitHub/Endpoints/Repos/Contents.hs new file mode 100644 index 00000000..00d2c632 --- /dev/null +++ b/src/GitHub/Endpoints/Repos/Contents.hs @@ -0,0 +1,86 @@ +-- | +-- The Github Repo Contents API, as documented at +-- + +module GitHub.Endpoints.Repos.Contents ( + -- * Querying contents + contentsForR, + readmeForR, + archiveForR, + + -- ** Create + createFileR, + + -- ** Update + updateFileR, + + -- ** Delete + deleteFileR, + + module GitHub.Data + ) where + +import GitHub.Data +import GitHub.Internal.Prelude +import Prelude () + +import Data.Maybe (maybeToList) +import qualified Data.Text.Encoding as TE +import Network.URI (URI) + +contentsForR + :: Name Owner + -> Name Repo + -> Text -- ^ file or directory + -> Maybe Text -- ^ Git commit + -> Request k Content +contentsForR user repo path ref = + query ["repos", toPathPart user, toPathPart repo, "contents", path] qs + where + qs = maybe [] (\r -> [("ref", Just . TE.encodeUtf8 $ r)]) ref + +readmeForR :: Name Owner -> Name Repo -> Request k Content +readmeForR user repo = + query ["repos", toPathPart user, toPathPart repo, "readme"] [] + +-- | Get archive link. +-- See +archiveForR + :: Name Owner + -> Name Repo + -> ArchiveFormat -- ^ The type of archive to retrieve + -> Maybe Text -- ^ Git commit + -> GenRequest 'MtRedirect rw URI +archiveForR user repo format ref = Query path [] + where + path = ["repos", toPathPart user, toPathPart repo, toPathPart format] <> maybeToList ref + +-- | Create a file. +-- See +createFileR + :: Name Owner + -> Name Repo + -> CreateFile + -> Request 'RW ContentResult +createFileR user repo body = + command Put ["repos", toPathPart user, toPathPart repo, "contents", createFilePath body] (encode body) + +-- | Update a file. +-- See +updateFileR + :: Name Owner + -> Name Repo + -> UpdateFile + -> Request 'RW ContentResult +updateFileR user repo body = + command Put ["repos", toPathPart user, toPathPart repo, "contents", updateFilePath body] (encode body) + +-- | Delete a file. +-- See +deleteFileR + :: Name Owner + -> Name Repo + -> DeleteFile + -> GenRequest 'MtUnit 'RW () +deleteFileR user repo body = + Command Delete ["repos", toPathPart user, toPathPart repo, "contents", deleteFilePath body] (encode body) diff --git a/src/GitHub/Endpoints/Repos/DeployKeys.hs b/src/GitHub/Endpoints/Repos/DeployKeys.hs new file mode 100644 index 00000000..cddbf823 --- /dev/null +++ b/src/GitHub/Endpoints/Repos/DeployKeys.hs @@ -0,0 +1,46 @@ +----------------------------------------------------------------------------- +-- | +-- License : BSD-3-Clause +-- Maintainer : Todd Mohney +-- +-- The deploy keys API, as described at +-- +module GitHub.Endpoints.Repos.DeployKeys ( + -- * Querying deploy keys + deployKeysForR, + deployKeyForR, + + -- ** Create + createRepoDeployKeyR, + + -- ** Delete + deleteRepoDeployKeyR, +) where + +import GitHub.Data +import GitHub.Internal.Prelude +import Prelude () + +-- | 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. +-- 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. +-- See . +createRepoDeployKeyR :: Name Owner -> Name Repo -> NewRepoDeployKey -> Request 'RW RepoDeployKey +createRepoDeployKeyR user repo key = + command Post ["repos", toPathPart user, toPathPart repo, "keys"] (encode key) + +-- | Delete a deploy key. +-- See +deleteRepoDeployKeyR :: Name Owner -> Name Repo -> Id RepoDeployKey -> GenRequest 'MtUnit 'RW () +deleteRepoDeployKeyR user repo keyId = + Command Delete ["repos", toPathPart user, toPathPart repo, "keys", toPathPart keyId] mempty diff --git a/src/GitHub/Endpoints/Repos/Deployments.hs b/src/GitHub/Endpoints/Repos/Deployments.hs new file mode 100644 index 00000000..39724771 --- /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 new file mode 100644 index 00000000..c9b56e30 --- /dev/null +++ b/src/GitHub/Endpoints/Repos/Forks.hs @@ -0,0 +1,18 @@ +-- | +-- Hot forking action, as described at +-- . + +module GitHub.Endpoints.Repos.Forks ( + forksForR, + module GitHub.Data, + ) where + +import GitHub.Data +import GitHub.Internal.Prelude +import Prelude () + +-- | List forks. +-- See +forksForR :: Name Owner -> Name Repo -> FetchCount -> Request k (Vector Repo) +forksForR user repo = + pagedQuery ["repos", toPathPart user, toPathPart repo, "forks"] [] diff --git a/src/GitHub/Endpoints/Repos/Invitations.hs b/src/GitHub/Endpoints/Repos/Invitations.hs new file mode 100644 index 00000000..066c7abc --- /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 new file mode 100644 index 00000000..6c96bee1 --- /dev/null +++ b/src/GitHub/Endpoints/Repos/Releases.hs @@ -0,0 +1,49 @@ +-- The Release API, as described at +-- . +module GitHub.Endpoints.Repos.Releases ( + releasesR, + releaseR, + latestReleaseR, + releaseByTagNameR, + module GitHub.Data, + ) where + +import GitHub.Data +import GitHub.Internal.Prelude +import Prelude () + +-- | 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"] [] + +-- | 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 ] [] + +-- | Get the latest release. +-- See +latestReleaseR :: Name Owner -> Name Repo -> Request k Release +latestReleaseR user repo = + query ["repos", toPathPart user, toPathPart repo, "releases", "latest" ] [] + +-- | Get a release by tag name +-- See +releaseByTagNameR :: Name Owner -> Name Repo -> Text -> Request k Release +releaseByTagNameR user repo reqTagName = + query ["repos", toPathPart user, toPathPart repo, "releases", "tags" , reqTagName ] [] + +{- +-- TODO: implement the following: + https://developer.github.com/v3/repos/releases/#create-a-release + https://developer.github.com/v3/repos/releases/#edit-a-release + https://developer.github.com/v3/repos/releases/#delete-a-release + https://developer.github.com/v3/repos/releases/#list-assets-for-a-release + https://developer.github.com/v3/repos/releases/#upload-a-release-asset + https://developer.github.com/v3/repos/releases/#get-a-single-release-asset + https://developer.github.com/v3/repos/releases/#edit-a-release-asset + https://developer.github.com/v3/repos/releases/#delete-a-release-asset +-} diff --git a/src/GitHub/Endpoints/Repos/Statuses.hs b/src/GitHub/Endpoints/Repos/Statuses.hs new file mode 100644 index 00000000..93c4682f --- /dev/null +++ b/src/GitHub/Endpoints/Repos/Statuses.hs @@ -0,0 +1,34 @@ +-- | +-- The repo statuses API as described on +-- . + +module GitHub.Endpoints.Repos.Statuses ( + createStatusR, + statusesForR, + statusForR, + module GitHub.Data + ) where + +import GitHub.Data +import GitHub.Internal.Prelude +import Prelude () + +-- | Create a new status +-- See +createStatusR :: Name Owner -> Name Repo -> Name Commit -> NewStatus -> Request 'RW Status +createStatusR owner repo sha = + command Post parts . encode + where + parts = ["repos", toPathPart owner, toPathPart repo, "statuses", toPathPart sha] + +-- | All statuses for a commit +-- 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 +-- See +statusForR :: Name Owner -> Name Repo -> Name Commit -> Request 'RW CombinedStatus +statusForR user repo sha = + query ["repos", toPathPart user, toPathPart repo, "commits", toPathPart sha, "status"] [] diff --git a/src/GitHub/Endpoints/Repos/Webhooks.hs b/src/GitHub/Endpoints/Repos/Webhooks.hs new file mode 100644 index 00000000..402fb4af --- /dev/null +++ b/src/GitHub/Endpoints/Repos/Webhooks.hs @@ -0,0 +1,75 @@ +-- | +-- The webhooks API, as described at +-- +-- + +module GitHub.Endpoints.Repos.Webhooks ( + -- * Querying repositories + webhooksForR, + webhookForR, + + -- ** Create + createRepoWebhookR, + + -- ** Edit + editRepoWebhookR, + + -- ** Test + testPushRepoWebhookR, + pingRepoWebhookR, + + -- ** Delete + deleteRepoWebhookR, +) where + +import GitHub.Data +import GitHub.Internal.Prelude +import Prelude () + +-- | List hooks. +-- See +webhooksForR :: Name Owner -> Name Repo -> FetchCount -> Request k (Vector RepoWebhook) +webhooksForR user repo = + pagedQuery ["repos", toPathPart user, toPathPart repo, "hooks"] [] +-- See +webhookForR :: Name Owner -> Name Repo -> Id RepoWebhook -> Request k RepoWebhook +webhookForR user repo hookId = + query ["repos", toPathPart user, toPathPart repo, "hooks", toPathPart hookId] [] + +-- | 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) + +-- | 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) + +-- | Test a push hook. +-- See +testPushRepoWebhookR :: Name Owner -> Name Repo -> Id RepoWebhook -> GenRequest 'MtStatus 'RW Bool +testPushRepoWebhookR user repo hookId = + Command Post (createWebhookOpPath user repo hookId $ Just "tests") (encode ()) + +-- | Ping a hook. +-- See +pingRepoWebhookR :: Name Owner -> Name Repo -> Id RepoWebhook -> GenRequest 'MtStatus 'RW Bool +pingRepoWebhookR user repo hookId = + Command Post (createWebhookOpPath user repo hookId $ Just "pings") (encode ()) + +-- | Delete a hook. +-- See +deleteRepoWebhookR :: Name Owner -> Name Repo -> Id RepoWebhook -> GenRequest 'MtUnit 'RW () +deleteRepoWebhookR user repo hookId = + Command Delete (createWebhookOpPath user repo hookId Nothing) mempty + +createBaseWebhookPath :: Name Owner -> Name Repo -> Id RepoWebhook -> Paths +createBaseWebhookPath user repo hookId = + ["repos", toPathPart user, toPathPart repo, "hooks", toPathPart hookId] + +createWebhookOpPath :: Name Owner -> Name Repo -> Id RepoWebhook -> Maybe Text -> Paths +createWebhookOpPath owner reqName webhookId Nothing = createBaseWebhookPath owner reqName webhookId +createWebhookOpPath owner reqName webhookId (Just operation) = createBaseWebhookPath owner reqName webhookId ++ [operation] diff --git a/src/GitHub/Endpoints/Search.hs b/src/GitHub/Endpoints/Search.hs new file mode 100644 index 00000000..06ddd373 --- /dev/null +++ b/src/GitHub/Endpoints/Search.hs @@ -0,0 +1,41 @@ +-- | +-- The Github Search API, as described at +-- . + +module GitHub.Endpoints.Search( + searchReposR, + searchCodeR, + searchIssuesR, + searchUsersR, + module GitHub.Data, + ) where + +import GitHub.Data +import GitHub.Internal.Prelude +import Prelude () + +import qualified Data.Text.Encoding as TE + +-- | Search repositories. +-- See +searchReposR :: Text -> FetchCount -> Request k (SearchResult Repo) +searchReposR searchString = + PagedQuery ["search", "repositories"] [("q", Just $ TE.encodeUtf8 searchString)] + +-- | Search code. +-- See +searchCodeR :: Text -> FetchCount -> Request k (SearchResult Code) +searchCodeR searchString = + PagedQuery ["search", "code"] [("q", Just $ TE.encodeUtf8 searchString)] + +-- | Search issues. +-- See +searchIssuesR :: Text -> FetchCount -> Request k (SearchResult Issue) +searchIssuesR 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 new file mode 100644 index 00000000..85f5e68e --- /dev/null +++ b/src/GitHub/Endpoints/Users.hs @@ -0,0 +1,35 @@ +-- | +-- The Github Users API, as described at +-- . + +module GitHub.Endpoints.Users ( + userInfoForR, + ownerInfoForR, + userInfoCurrentR, + module GitHub.Data, + ) where + +import GitHub.Data +import Prelude () + +-- | 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] [] + +-- | Query a single user or an organization. +-- See +ownerInfoForR :: Name Owner -> Request k Owner +ownerInfoForR owner = query ["users", toPathPart owner] [] + +-- | Query the authenticated user. +-- See +userInfoCurrentR :: Request 'RA User +userInfoCurrentR = query ["user"] [] diff --git a/src/GitHub/Endpoints/Users/Emails.hs b/src/GitHub/Endpoints/Users/Emails.hs new file mode 100644 index 00000000..c9e42520 --- /dev/null +++ b/src/GitHub/Endpoints/Users/Emails.hs @@ -0,0 +1,25 @@ +-- | +-- The user emails API as described on +-- . + +module GitHub.Endpoints.Users.Emails ( + currentUserEmailsR, + currentUserPublicEmailsR, + module GitHub.Data, + ) where + +import GitHub.Data +import GitHub.Internal.Prelude +import Prelude () + +-- | List email addresses. +-- See +currentUserEmailsR :: FetchCount -> Request 'RA (Vector Email) +currentUserEmailsR = + pagedQuery ["user", "emails"] [] + +-- | List public email addresses. +-- See +currentUserPublicEmailsR :: FetchCount -> Request 'RA (Vector Email) +currentUserPublicEmailsR = + pagedQuery ["user", "public_emails"] [] diff --git a/src/GitHub/Endpoints/Users/Followers.hs b/src/GitHub/Endpoints/Users/Followers.hs new file mode 100644 index 00000000..13f8b494 --- /dev/null +++ b/src/GitHub/Endpoints/Users/Followers.hs @@ -0,0 +1,25 @@ +-- | +-- The user followers API as described on +-- . + +module GitHub.Endpoints.Users.Followers ( + usersFollowingR, + usersFollowedByR, + module GitHub.Data, + ) where + +import GitHub.Data +import GitHub.Internal.Prelude +import Prelude () + +-- | List followers of a user. +-- See +usersFollowingR :: Name User -> FetchCount -> Request k (Vector SimpleUser) +usersFollowingR user = + pagedQuery ["users", toPathPart user, "followers"] [] + +-- | List users followed by another user. +-- See +usersFollowedByR :: Name User -> FetchCount -> Request k (Vector SimpleUser) +usersFollowedByR user = + pagedQuery ["users", toPathPart user, "following"] [] diff --git a/src/GitHub/Endpoints/Users/PublicSSHKeys.hs b/src/GitHub/Endpoints/Users/PublicSSHKeys.hs new file mode 100644 index 00000000..663e2641 --- /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 index 00000000..d9474cd6 --- /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 new file mode 100644 index 00000000..a001da65 --- /dev/null +++ b/src/GitHub/Internal/Prelude.hs @@ -0,0 +1,30 @@ +{-# LANGUAGE NoImplicitPrelude #-} + +-- | +-- This module may change between minor releases. Do not rely on its contents. + +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 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 new file mode 100644 index 00000000..39deb0a6 --- /dev/null +++ b/src/GitHub/Request.hs @@ -0,0 +1,588 @@ +{-# LANGUAGE CPP #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE FunctionalDependencies #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE KindSignatures #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE UndecidableInstances #-} + +-- | +-- This module provides data types and helper methods, which makes possible +-- to build alternative API request intepreters in addition to provided +-- 'IO' functions. +-- +-- Simple example using @operational@ package. See @samples\/Operational\/Operational.hs@ +-- +-- > type GithubMonad a = Program (GH.Request 'False) a +-- > +-- > -- | Intepret GithubMonad value into IO +-- > runMonad :: Manager -> GH.Auth -> GithubMonad a -> ExceptT GH.Error IO a +-- > runMonad mgr auth m = case view m of +-- > Return a -> return a +-- > req :>>= k -> do +-- > b <- ExceptT $ GH.executeRequestWithMgr mgr auth req +-- > runMonad mgr auth (k b) +-- > +-- > -- | Lift request into Monad +-- > githubRequest :: GH.Request 'False a -> GithubMonad a +-- > githubRequest = singleton + +module GitHub.Request ( + -- * A convenient execution of requests + github, + github', + GitHubRW, + GitHubRO, + -- * Types + Request, + GenRequest (..), + CommandMethod(..), + toMethod, + Paths, + QueryString, + -- * Request execution in IO + executeRequest, + executeRequestWithMgr, + executeRequestWithMgrAndRes, + executeRequest', + executeRequestWithMgr', + executeRequestMaybe, + unsafeDropAuthRequirements, + -- * Helpers + Accept (..), + ParseResponse (..), + makeHttpRequest, + 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 () + +import Control.Monad.Error.Class (MonadError (..)) + +import Control.Monad (when) +import Control.Monad.Catch (MonadCatch (..), MonadThrow) +import Control.Monad.Trans.Class (lift) +import Control.Monad.Trans.Except (ExceptT (..), runExceptT) +import Data.Aeson (eitherDecode) +import Data.List (find) +import Data.Maybe (fromMaybe) +import Data.Tagged (Tagged (..)) +import Data.Version (showVersion) + +import Network.HTTP.Client + (HttpException (..), Manager, RequestBody (..), Response (..), getUri, + httpLbs, method, newManager, redirectCount, requestBody, requestHeaders, + setQueryString, setRequestIgnoreStatus) +import Network.HTTP.Link.Parser (parseLinkHeaderBS) +import Network.HTTP.Link.Types (Link(..), LinkParam (..), href, linkParams) +import Network.HTTP.Types (Method, RequestHeaders, Status (..)) +import Network.URI + (URI, escapeURIString, isUnescapedInURIComponent, parseURIReference, + relativeTo) + +import qualified Data.ByteString as BS +import 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 Network.HTTP.Client as HTTP +import qualified Network.HTTP.Client.Internal as HTTP + +#ifdef MIN_VERSION_http_client_tls +import Network.HTTP.Client.TLS (tlsManagerSettings) +#else +import Network.HTTP.Client.OpenSSL (opensslManagerSettings, withOpenSSL) + +import qualified OpenSSL.Session as SSL +import qualified OpenSSL.X509.SystemStore as SSL +#endif + +import GitHub.Auth (AuthMethod, endpoint, setAuthRequest) +import GitHub.Data (Error (..)) +import GitHub.Data.PullRequests (MergeResult (..)) +import GitHub.Data.Request + +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 + +-- | 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 + :: (AuthMethod am, ParseResponse mt a) + => Manager + -> am + -> GenRequest mt rw a + -> IO (Either Error a) +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 (HTTP.Response LBS.ByteString) + httpLbs' req' = lift (httpLbs req' mgr) `catch` onHttpException + + performHttpReq :: forall rw mt b. ParseResponse mt b => HTTP.Request -> GenRequest mt rw b -> ExceptT Error IO (HTTP.Response b) + performHttpReq httpReq Query {} = do + res <- httpLbs' httpReq + (<$ res) <$> unTagged (parseResponse httpReq res :: Tagged mt (ExceptT Error IO b)) + + 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' :: ParseResponse mt a => GenRequest mt 'RO a -> IO (Either Error a) +executeRequest' req = withOpenSSL $ do + manager <- newManager tlsManagerSettings + executeRequestWithMgr' manager req + +-- | Like 'executeRequestWithMgr' but without authentication. +executeRequestWithMgr' + :: ParseResponse mt a + => Manager + -> GenRequest mt 'RO a + -> IO (Either Error a) +executeRequestWithMgr' mgr = executeRequestWithMgr mgr () + +-- | Helper for picking between 'executeRequest' and 'executeRequest''. +-- +-- The use is discouraged. +executeRequestMaybe + :: (AuthMethod am, ParseResponse mt a) + => Maybe am + -> GenRequest mt 'RO a + -> IO (Either Error a) +executeRequestMaybe = maybe executeRequest' executeRequest + +-- | Partial function to drop authentication need. +unsafeDropAuthRequirements :: GenRequest mt rw' a -> GenRequest mt rw a +unsafeDropAuthRequirements (Query ps qs) = Query ps qs +unsafeDropAuthRequirements r = + error $ "Trying to drop authenatication from" ++ show r + +------------------------------------------------------------------------------- +-- Parse response +------------------------------------------------------------------------------- + +class Accept (mt :: MediaType *) where + contentType :: Tagged mt BS.ByteString + contentType = Tagged "application/json" -- default is JSON + + modifyRequest :: Tagged mt (HTTP.Request -> HTTP.Request) + modifyRequest = Tagged id + +class Accept mt => ParseResponse (mt :: MediaType *) a where + parseResponse + :: MonadError Error m + => HTTP.Request -> HTTP.Response LBS.ByteString + -> Tagged mt (m a) + +------------------------------------------------------------------------------- +-- JSON (+ star) +------------------------------------------------------------------------------- + +-- | Parse API response. +-- +-- @ +-- parseResponse :: 'FromJSON' a => '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 +------------------------------------------------------------------------------ + +-- | Create @http-client@ 'Request'. +-- +-- * for 'PagedQuery', the initial request is created. +-- * for 'Status', the 'Request' for underlying 'Request' is created, +-- status checking is modifying accordingly. +-- +makeHttpRequest + :: forall am mt rw a m. (AuthMethod am, MonadThrow m, Accept mt) + => Maybe am + -> GenRequest mt rw a + -> m HTTP.Request +makeHttpRequest auth r = case r of + Query paths qs -> do + req <- parseUrl' $ url paths + return + $ setReqHeaders + . unTagged (modifyRequest :: Tagged mt (HTTP.Request -> HTTP.Request)) + . maybe id setAuthRequest auth + . setQueryString (qs <> extraQueryItems) + $ req + PagedQuery paths qs _ -> do + req <- parseUrl' $ url paths + return + $ setReqHeaders + . unTagged (modifyRequest :: Tagged mt (HTTP.Request -> HTTP.Request)) + . maybe id setAuthRequest auth + . setQueryString (qs <> extraQueryItems) + $ req + Command m paths body -> do + req <- parseUrl' $ url paths + return + $ setReqHeaders + . unTagged (modifyRequest :: Tagged mt (HTTP.Request -> HTTP.Request)) + . maybe id setAuthRequest auth + . setBody body + . setMethod (toMethod m) + $ req + where + parseUrl' :: MonadThrow m => String -> m HTTP.Request + parseUrl' = HTTP.parseUrlThrow + + url :: Paths -> String + url paths = maybe "https://api.github.com" T.unpack (endpoint =<< auth) ++ "/" ++ intercalate "/" paths' where + paths' = map (escapeURIString isUnescapedInURIComponent . T.unpack) paths + + setReqHeaders :: HTTP.Request -> HTTP.Request + setReqHeaders req = req { requestHeaders = reqHeaders <> requestHeaders req } + + setMethod :: Method -> HTTP.Request -> HTTP.Request + setMethod m req = req { method = m } + + reqHeaders :: RequestHeaders + reqHeaders = [("User-Agent", "github.hs/" <> fromString (showVersion version))] -- Version + <> [("Accept", unTagged (contentType :: Tagged mt BS.ByteString))] + + setBody :: LBS.ByteString -> HTTP.Request -> HTTP.Request + setBody body req = req { requestBody = RequestBodyLBS body } + + 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 :: 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 or Link uri -> Bool + isRelNext = any (== relNextLinkParam) . linkParams + + relNextLinkParam :: (LinkParam, Text) + relNextLinkParam = (Rel, "next") + +-- | 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' ('HTTP.Response' 'LBS.ByteString')) +-- -> (a -> 'Bool') +-- -> 'HTTP.Request' +-- -> 'ExceptT' 'Error' 'IO' ('HTTP.Response' a) +-- @ +performPagedRequest + :: 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 <- unTagged (parseResponse initReq res :: Tagged mt (m a)) + go m res initReq + where + 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 <- unTagged (parseResponse req' res' :: Tagged mt (m a)) + go (acc <> m) res' req' + (_, _) -> 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) + +-- | 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 + +------------------------------------------------------------------------------- +-- Internal +------------------------------------------------------------------------------- + +onHttpException :: MonadError Error m => HttpException -> m a +onHttpException = throwError . HTTPError