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 e22e77ba..3a8f6f25 100644 --- a/.gitignore +++ b/.gitignore @@ -1,4 +1,9 @@ +.env dist +dist-newstyle +/dist* +/tmp +.ghc.environment.* *swp .cabal-sandbox cabal.sandbox.config @@ -7,7 +12,11 @@ cabal.sandbox.config *~ *.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 index 0d13efa4..480cae6b 100644 --- a/.stylish-haskell.yaml +++ b/.stylish-haskell.yaml @@ -1,13 +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 - - records: {} - trailing_whitespace: {} columns: 80 language_extensions: - MultiParamTypeClasses - FlexibleContexts + - ExplicitForAll - DataKinds diff --git a/.travis.yml b/.travis.yml deleted file mode 100644 index 34081ed3..00000000 --- a/.travis.yml +++ /dev/null @@ -1,77 +0,0 @@ -# This file has been generated -- see https://github.com/hvr/multi-ghc-travis -language: c -sudo: false - -cache: - directories: - - $HOME/.cabsnap - - $HOME/.cabal/packages - - $HOME/.stack - -before_cache: - - rm -fv $HOME/.cabal/packages/hackage.haskell.org/build-reports.log - - rm -fv $HOME/.cabal/packages/hackage.haskell.org/00-index.tar - -env: - global: - secure: "C2YwYhIClWJKjKQ1AfsHn0Py5+6WkA79Ny6bfR9JxQ10aT3sq5FcZt0ZfwutK0+jQ5F6c3+L0yJaNm8dp1+0MGK0ALDE3vx9ftJkXLp/5LwSdfeHHiMLFoQsSs3mGw9DirxiHbWlDzBKNfRi397Vckh0sfEGx/rEBIs5PS86wIU=" - -matrix: - include: - - env: BUILD=cabal CABALVER=1.18 GHCVER=7.8.4 - compiler: ": #GHC 7.8.4" - addons: {apt: {packages: [cabal-install-1.18,ghc-7.8.4], sources: [hvr-ghc]}} - - env: BUILD=cabal CABALVER=1.22 GHCVER=7.10.3 - compiler: ": #GHC 7.10.3" - addons: {apt: {packages: [cabal-install-1.22,ghc-7.10.3], sources: [hvr-ghc]}} - - env: BUILD=cabal CABALVER=1.24 GHCVER=8.0.1 - compiler: ": #GHC 8.0.1" - addons: {apt: {packages: [cabal-install-1.24,ghc-8.0.1], sources: [hvr-ghc]}} - - env: BUILD=cabal CABALVER=1.18 GHCVER=7.8.4 STACKAGESNAPSHOT=lts-2.22 - compiler: ": #GHC 7.8.4 lts-2.22" - addons: {apt: {packages: [cabal-install-1.18,ghc-7.8.4], sources: [hvr-ghc]}} - - env: BUILD=cabal CABALVER=1.22 GHCVER=7.10.2 STACKAGESNAPSHOT=lts-3.22 - compiler: ": #GHC 7.10.2 lts-3.22" - addons: {apt: {packages: [cabal-install-1.22,ghc-7.10.2], sources: [hvr-ghc]}} - - env: BUILD=cabal CABALVER=1.22 GHCVER=7.10.3 STACKAGESNAPSHOT=lts-4.2 - compiler: ": #GHC 7.10.3 lts-4.2" - addons: {apt: {packages: [cabal-install-1.22,ghc-7.10.3], sources: [hvr-ghc]}} - - env: BUILD=cabal CABALVER=1.22 GHCVER=7.10.3 STACKAGESNAPSHOT=lts-5.1 - compiler: ": #GHC 7.10.3 lts-5.1" - addons: {apt: {packages: [cabal-install-1.22,ghc-7.10.3], sources: [hvr-ghc]}} - - env: BUILD=stack STACK_YAML=stack-lts-2.yaml GHCVER=7.8.4 - compiler: ": #STACK LTS2" - addons: {apt: {packages: [ghc-7.8.4], sources: [hvr-ghc]}} - - env: BUILD=stack STACK_YAML=stack-lts-3.yaml GHCVER=7.10.2 - compiler: ": #STACK LTS3" - addons: {apt: {packages: [ghc-7.10.2], sources: [hvr-ghc]}} - - env: BUILD=stack STACK_YAML=stack-lts-4.yaml GHCVER=7.10.3 - compiler: ": #STACK LTS4" - addons: {apt: {packages: [ghc-7.10.3], sources: [hvr-ghc]}} - - env: BUILD=stack STACK_YAML=stack-lts-5.yaml GHCVER=7.10.3 - compiler: ": #STACK LTS5" - addons: {apt: {packages: [ghc-7.10.3], sources: [hvr-ghc]}} - - env: BUILD=stack STACK_YAML=stack-nightly.yaml GHCVER=7.10.3 - compiler: ": #STACK nightly" - addons: {apt: {packages: [ghc-7.10.3], sources: [hvr-ghc]}} - - env: BUILD=stack STACK_YAML=stack-lts-4.yaml - compiler: ": #stack LTS4 OSX" - os: osx - -before_install: - - unset CC - - export PATH=/opt/ghc/$GHCVER/bin:/opt/cabal/$CABALVER/bin:$HOME/.local/bin:$PATH - -install: - - sh travis-install.sh - -# Here starts the actual work to be performed for the package under test; -# any command which exits with a non-zero exit code causes the build to fail. -script: - - sh travis-script.sh - -branches: - only: - - master - -# EOF diff --git a/CHANGELOG.md b/CHANGELOG.md index 103e2629..014e7e29 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,12 +1,320 @@ -Changes for 0.14.3 +## Changes for 0.30.0.1 -- Add `Hashable Auth` instance +_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) -Changes for 0.14.2 +- 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 -Changes for 0.14.1 +_2016-02-02, Oleg Grenrus_ - Add `membersOfWithR`, `listTeamMembersR` - Add related enums: `OrgMemberFilter`, `OrgMemberRole`, `TeamMemberRole` @@ -14,7 +322,9 @@ Changes for 0.14.1 `RepoPublicity` - Don't require network access for search tests -Changes for 0.14.0 +## Changes for 0.14.0 + +_2016-01-25, Oleg Grenrus_ Large API changes: @@ -25,27 +335,55 @@ Large API changes: - Add `Binary` instances for all data - `GithubOwner` is a `newtype` of `Either User Organization`. There's still `SimpleOwner`. -Changes for 0.5.0: +## Releases without changelog + +| Version | Date | Uploader | +|---|---|---| +| __0.13.2__ | _2015-04-26_ | _John Wiegley_ | +| __0.13.1__ | _2014-12-01_ | _César López-Natarén_ | +| __0.13__ | _2014-11-09_ | _César López-Natarén_ | +| __0.12__ | _2014-11-09_ | _César López-Natarén_ | +| __0.11.1__ | _2014-09-07_ | _César López-Natarén_ | +| __0.11.0__ | _2014-08-25_ | _César López-Natarén_ | +| __0.10.0__ | _2014-08-18_ | _César López-Natarén_ | +| __0.9__ | _2014-07-31_ | _John Wiegley_ | +| __0.8__ | _2014-05-02_ | _John Wiegley_ | +| __0.7.4__ | _2014-01-22_ | _John Wiegley_ | +| __0.7.3__ | _2013-12-21_ | _John Wiegley_ | +| __0.7.2__ | _2013-12-02_ | _John Wiegley_ | +| __0.7.1__ | _2013-08-08_ | _John Wiegley_ | +| __0.7.0__ | _2013-04-26_ | _John Wiegley_ | +| __0.6.0__ | _2013-04-12_ | _John Wiegley_ | + +## Changes for 0.5.0: -* OAuth. +_2013-02-05, Mike Burns_ + +* `OAuth`. * New function: `Github.Repos.organizationRepo`, to get the repo for a specific organization. * Introduce a new `newRepoAutoInit` flag to `NewRepo`, for whether to initialize a repo while creating it. -* Relax the attoparsec version requirements. +* Relax the `attoparsec` version requirements. * The above by [John Wiegley](https://github.com/jwiegley). -Changes for 0.4.1: +## 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. +* 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: +## Changes for 0.4.0: -* Use http-conduit version 1.4.1.10. +_2012-06-26, Mike Burns_ -Changes for 0.3.0: +* 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`. @@ -55,15 +393,19 @@ Changes for 0.3.0: 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: +## Changes for 0.2.1: + +_2012-02-16, Mike Burns_ + +* Expand the `unordered-containers` dependency to anything in 0.1.x . -* Expand the unordered-containers dependency to anything in 0.1.x . +## Changes for 0.2.0: -Changes for 0.2.0: +_2012-02-15, Mike Burns_ * `milestoneDueOn` and `repoLanguage` are now `Maybe` types. -* Introduce `GithubOwner` as the sum type for a `GithubUser` or `GithubOrganization`. Everything that once produced a `GithubUser` now produces a `GithubOwner`. All record accessors have changed their names -* Similar to `GithubOwner`, introduce `DetailedOwner`, which can be a `DetailedUser` or a `DetailedOrganization`. All record accessors have changed their names +* Introduce `GithubOwner` as the sum type for a `GithubUser` or `GithubOrganization`. Everything that once produced a `GithubUser` now produces a `GithubOwner`. All record accessors have changed their names. +* Similar to `GithubOwner`, introduce `DetailedOwner`, which can be a `DetailedUser` or a `DetailedOrganization`. All record accessors have changed their names. * An `HTTPConnectionError` now composes `SomeException` instead of `IOException`. All exceptions raised by the underlying http-conduit library are encapulated there. * The `githubIssueClosedBy` function now produces a `Maybe GithubOwner`. * Remove the Blobs API, as it is broken upstream. diff --git a/CONTRIBUTING.md b/CONTRIBUTING.md index c18ad2b4..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 test (or 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/README.md b/README.md index 9136e437..3ead9b24 100644 --- a/README.md +++ b/README.md @@ -1,15 +1,15 @@ -Github +GitHub ------ -[![Build Status](https://travis-ci.org/phadej/github.svg?branch=master)](https://travis-ci.org/phadej/github) -[![Hackage](https://img.shields.io/hackage/v/github.svg)][hackage] -[![Stackage LTS 5](http://stackage.org/package/github/badge/lts-5)](http://stackage.org/lts-5/package/github) -[![Stackage Nightly](http://stackage.org/package/github/badge/nightly)](http://stackage.org/nightly/package/github) +[![Hackage version](https://img.shields.io/hackage/v/github.svg?label=Hackage&color=informational)](http://hackage.haskell.org/package/github) +[![github on Stackage Nightly](https://stackage.org/package/github/badge/nightly)](https://stackage.org/nightly/package/github) +[![Stackage LTS version](https://www.stackage.org/package/github/badge/lts?label=Stackage)](https://www.stackage.org/package/github) +[![Haskell-CI](https://github.com/haskell-github/github/actions/workflows/haskell-ci.yml/badge.svg)](https://github.com/haskell-github/github/actions/workflows/haskell-ci.yml) -The Github API v3 for Haskell. +The GitHub API v3 for Haskell. -Some functions are missing; these are functions where the Github API did -not work as expected. The full Github API is in beta and constantly +Some functions are missing; these are functions where the GitHub API did +not work as expected. The full GitHub API is in beta and constantly improving. Installation @@ -18,21 +18,22 @@ Installation In your project's cabal file: ```cabal --- Packages needed in order to build this package. Build-depends: github ``` Or from the command line: ```sh -cabal install github +cabal v1-install github ``` Example Usage ============= See the samples in the -[samples/](https://github.com/fpco/github/tree/master/samples) directory. +[samples/](https://github.com/haskell-github/github/tree/master/samples) directory. + +Note: some samples might be outdated. Documentation ============= @@ -40,9 +41,9 @@ Documentation For details see the reference [documentation on Hackage][hackage]. Each module lines up with the hierarchy of -[documentation from the Github API](http://developer.github.com/v3/). +[documentation from the GitHub API](https://docs.github.com/en/rest). -Request functions (ending with `R`) construct a data type with can be executed +Request functions (ending with `R`) construct a data type which can be executed in `IO` by `executeRequest` functions. They are all listed in the root `GitHub` module. @@ -51,7 +52,7 @@ you want. You must call the function using IO goodness, then dispatch on the possible error message. Here's an example from the samples: Many function have samples under -[`samples/`](https://github.com/phadej/github/tree/master/samples) directory. +[`samples/`](https://github.com/haskell-github/github/tree/master/samples) directory. ```hs {-# LANGUAGE NoImplicitPrelude #-} @@ -63,11 +64,12 @@ import Data.Text (Text, pack) import Data.Text.IO as T (putStrLn) import Data.Monoid ((<>)) -import qualified GitHub.Endpoints.Users.Followers as GitHub +import GitHub (github') +import qualified GitHub main :: IO () main = do - possibleUsers <- GitHub.usersFollowing "mike-burns" + possibleUsers <- github' GitHub.usersFollowingR "phadej" T.putStrLn $ either (("Error: " <>) . pack . show) (foldMap ((<> "\n") . formatUser)) possibleUsers @@ -76,21 +78,11 @@ formatUser :: GitHub.SimpleUser -> Text formatUser = GitHub.untagName . GitHub.simpleUserLogin ``` -Test setup -========== - -To run integration part of tests, you'll need [github access token](https://github.com/settings/tokens/new) -Token is needed, because unauthorised access is highly limited. -It's enough to add only basic read access for public information. - -With `travis encrypt --org --repo yournick/github "GITHUB_TOKEN=yourtoken"` command you get a secret, -you can use in your travis setup to run the test-suite there. - Contributions ============= Please see -[CONTRIBUTING.md](https://github.com/fpco/github/blob/master/CONTRIBUTING.md) +[CONTRIBUTING.md](https://github.com/haskell-github/github/blob/master/CONTRIBUTING.md) for details on how you can help. Copyright @@ -98,8 +90,16 @@ Copyright Copyright 2011-2012 Mike Burns. Copyright 2013-2015 John Wiegley. -Copyright 2016 Oleg Grenrus. +Copyright 2016-2019 Oleg Grenrus. Available under the BSD 3-clause license. -[hackage]: http://hackage.haskell.org/package/github "Hackage" +[hackage]: https://hackage.haskell.org/package/github "Hackage" + +Alternative +=========== + +Library [`github-rest`](https://hackage.haskell.org/package/github-rest) +also provides an interface to the GitHub API. +It compares itself to `github` here: +https://github.com/LeapYear/github-rest#comparison-to-other-libraries diff --git a/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/default.nix b/default.nix deleted file mode 100644 index 4b04872b..00000000 --- a/default.nix +++ /dev/null @@ -1,26 +0,0 @@ -{ mkDerivation, aeson, attoparsec, base, base16-bytestring -, byteable, bytestring, case-insensitive, conduit, containers -, cryptohash, data-default, failure, hashable, hspec, HTTP -, http-conduit, http-types, network, old-locale, stdenv, text, time -, unordered-containers, vector -}: -mkDerivation { - pname = "github"; - version = "0.14.0"; - src = ./.; - buildDepends = [ - aeson attoparsec base base16-bytestring byteable bytestring - case-insensitive conduit containers cryptohash data-default failure - hashable HTTP http-conduit http-types network old-locale text time - unordered-containers vector - ]; - testDepends = [ - aeson attoparsec base base16-bytestring byteable bytestring - case-insensitive conduit containers cryptohash data-default failure - hashable hspec HTTP http-conduit http-types network old-locale text - time unordered-containers vector - ]; - homepage = "https://github.com/fpco/github"; - description = "Access to the Github API, v3"; - license = stdenv.lib.licenses.bsd3; -} 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 index c95cacba..9b3bdfd9 100644 --- a/fixtures/issue-search.json +++ b/fixtures/issue-search.json @@ -36,6 +36,7 @@ "state": "closed", "locked": false, "assignee": null, + "assignees": [], "milestone": null, "comments": 0, "created_at": "2015-12-25T21:37:39Z", @@ -84,6 +85,7 @@ "state": "open", "locked": false, "assignee": null, + "assignees": [], "milestone": null, "comments": 2, "created_at": "2015-12-01T11:09:03Z", 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/github.cabal b/github.cabal index e81c8ad6..759c9f95 100644 --- a/github.cabal +++ b/github.cabal @@ -1,6 +1,8 @@ -name: github -version: 0.15.0 -synopsis: Access to the GitHub API, v3. +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 @@ -13,65 +15,131 @@ description: > > main :: IO () > main = do - > possibleUser <- GH.executeRequest' $ GH.userInfoR "phadej" + > possibleUser <- GH.github' GH.userInfoForR "phadej" > print possibleUser . - For more of an overview please see the README: -license: BSD3 -license-file: LICENSE -author: Mike Burns, John Wiegley, Oleg Grenrus -maintainer: Oleg Grenrus -homepage: https://github.com/phadej/github -copyright: Copyright 2012-2013 Mike Burns, Copyright 2013-2015 John Wiegley, Copyright 2016 Oleg Grenrus -category: Network -build-type: Simple -tested-with: GHC==7.8.4, GHC==7.10.3, GHC==8.0.1 -cabal-version: >=1.10 + 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: - README.md, - CHANGELOG.md, - fixtures/issue-search.json, - fixtures/list-teams.json, - fixtures/members-list.json, - fixtures/user-organizations.json, - fixtures/user.json - -flag aeson-compat - description: Whether to use aeson-compat or aeson-extra - default: True - manual: False + fixtures/**/*.json source-repository head - type: git - location: git://github.com/phadej/github.git + 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 -Library - default-language: Haskell2010 - ghc-options: -Wall - hs-source-dirs: src 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.Activities 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 @@ -85,83 +153,119 @@ Library 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.ReviewComments + 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 - -- Packages needed in order to build this package. - build-depends: base >=4.7 && <4.10, - aeson >=0.7.0.6 && <0.12, - attoparsec >=0.11.3.4 && <0.14, - base-compat >=0.9.1 && <0.10, - base16-bytestring >=0.1.1.6 && <0.2, - binary >=0.7.1.0 && <0.9, - binary-orphans >=0.1.0.0 && <0.2, - byteable >=0.1.1 && <0.2, - bytestring >=0.10.4.0 && <0.11, - containers >=0.5.5.1 && <0.6, - cryptohash >=0.11 && <0.12, - deepseq >=1.3.0.2 && <1.5, - deepseq-generics >=0.1.1.2 && <0.3, - exceptions >=0.8.0.2 && <0.9, - hashable >=1.2.3.3 && <1.3, - http-client >=0.4.8.1 && <0.5, - http-client-tls >=0.2.2 && <0.3, - http-link-header >=1.0.1 && <1.1, - http-types >=0.8.6 && <0.10, - iso8601-time >=0.1.4 && <0.2, - mtl >=2.1.3.1 && <2.3, - network-uri >=2.6.0.3 && <2.7, - semigroups >=0.16.2.2 && <0.19, - text >=1.2.0.6 && <1.3, - time >=1.4 && <1.7, - transformers >=0.3.0.0 && <0.6, - transformers-compat >=0.4.0.3 && <0.6, - unordered-containers >=0.2 && <0.3, - vector >=0.10.12.3 && <0.12, - vector-instances >=3.3.0.1 && <3.4, - - tls >=1.3.5 - - if flag(aeson-compat) - build-depends: aeson-compat >=0.3.0.0 && <0.4 + 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: aeson-extra >=0.2.0.0 && <0.3 + 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 + default-language: Haskell2010 + type: exitcode-stdio-1.0 + hs-source-dirs: spec + main-is: Spec.hs + ghc-options: -Wall -threaded + build-tool-depends: hspec-discover:hspec-discover >=2.7.1 && <2.12 + other-extensions: TemplateHaskell other-modules: + GitHub.Actions.ArtifactsSpec + GitHub.Actions.CacheSpec + GitHub.Actions.SecretsSpec + GitHub.Actions.WorkflowJobSpec + GitHub.Actions.WorkflowRunsSpec + GitHub.Actions.WorkflowSpec GitHub.ActivitySpec GitHub.CommitsSpec - GitHub.OrganizationsSpec + GitHub.EventsSpec GitHub.IssuesSpec + GitHub.OrganizationsSpec + GitHub.PublicSSHKeysSpec + GitHub.PullRequestReviewsSpec GitHub.PullRequestsSpec + GitHub.RateLimitSpec + GitHub.ReleasesSpec GitHub.ReposSpec + GitHub.ReviewDecodeSpec GitHub.SearchSpec GitHub.UsersSpec - main-is: Spec.hs - ghc-options: -Wall - build-depends: base, - base-compat, - github, - vector, - unordered-containers, - file-embed, - hspec - if flag(aeson-compat) - build-depends: aeson-compat - else - build-depends: aeson-extra + build-depends: + aeson + , base + , base-compat + , bytestring + , file-embed + , github + , hspec >=2.6.1 && <2.12 + , http-client + , tagged + , text + , unordered-containers + , vector diff --git a/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/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/References/GitCreateReference.hs b/samples/GitData/References/GitCreateReference.hs index bf3d15b0..e56e1a2a 100644 --- a/samples/GitData/References/GitCreateReference.hs +++ b/samples/GitData/References/GitCreateReference.hs @@ -13,7 +13,7 @@ main = do 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/CreateIssue.hs b/samples/Issues/CreateIssue.hs index 296013f5..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.Auth as Github -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.BasicAuth "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.fromDate $ 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/IssueReport/Issues.hs b/samples/Issues/IssueReport/Issues.hs index 14ce129c..da2fb1ba 100644 --- a/samples/Issues/IssueReport/Issues.hs +++ b/samples/Issues/IssueReport/Issues.hs @@ -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 index 6b9f899c..7b2c2531 100644 --- a/samples/Issues/IssueReport/IssuesEnterprise.hs +++ b/samples/Issues/IssueReport/IssuesEnterprise.hs @@ -20,12 +20,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") ] @@ -33,7 +33,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" -- @@ -45,4 +45,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/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/ShowRepoIssues.hs b/samples/Issues/ShowRepoIssues.hs index b6f26e68..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.fromDate $ 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 index 7819914e..1fc7f897 100644 --- a/samples/Operational/Operational.hs +++ b/samples/Operational/Operational.hs @@ -1,37 +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 Control.Monad.Operational -import Network.HTTP.Client (Manager, newManager) -import Network.HTTP.Client.TLS (tlsManagerSettings) +import Network.HTTP.Client (Manager, newManager, responseBody) import qualified GitHub as GH -type GithubMonad a = Program (GH.Request 'False) a +data R a where + R :: FromJSON a => GH.Request 'GH.RA a -> R a + +type GithubMonad a = Program R a -runMonad :: Manager -> GH.Auth -> GithubMonad a -> ExceptT GH.Error IO 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 - req :>>= k -> do - b <- ExceptT $ GH.executeRequestWithMgr mgr auth req - runMonad mgr auth (k b) + R req :>>= k -> do + res <- ExceptT $ GH.executeRequestWithMgrAndRes mgr auth req + liftIO $ print $ GH.limitsFromHttpResponse res + runMonad mgr auth (k (responseBody res)) -githubRequest :: GH.Request 'False a -> GithubMonad a -githubRequest = singleton +githubRequest :: FromJSON a => GH.Request 'GH.RA a -> GithubMonad a +githubRequest = singleton . R main :: IO () -main = do - manager <- newManager tlsManagerSettings +main = GH.withOpenSSL $ do + manager <- newManager GH.tlsManagerSettings auth' <- getAuth case auth' of - Nothing -> return () + Nothing -> do + (owner, rl) <- runExceptT (runMonad manager () script) >>= either throw return + print owner + print rl Just auth -> do - owner <- runExceptT $ runMonad manager auth $ do - repo <- githubRequest $ GH.repositoryR "phadej" "github" - githubRequest $ GH.ownerInfoForR (GH.simpleOwnerLogin . GH.repoOwner $ repo) + (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 index 6004b100..df270bce 100644 --- a/samples/Organizations/Teams/CreateTeamFor.hs +++ b/samples/Organizations/Teams/CreateTeamFor.hs @@ -13,7 +13,7 @@ main = do Github.createTeamFor' (Github.OAuth token) org - (Github.CreateTeam team (Just desc) (read repos :: [String]) Github.PermissionPull) + (Github.CreateTeam team (Just desc) (read repos :: [String]) Github.PrivacyClosed Github.PermissionPull) _ -> error "usage: CreateTeamFor <[\"repos\"]>" case result of 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/ReviewComments/ListComments.hs b/samples/Pulls/ReviewComments/ListComments.hs deleted file mode 100644 index f41234f2..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.Owner -> 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 254fa703..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.Owner -> String -formatAuthor user = - (Github.githubOwnerLogin user) ++ " (" ++ (Github.githubOwnerUrl user) ++ ")" - diff --git a/samples/Pulls/UpdatePull.hs b/samples/Pulls/UpdatePull.hs index 5900b59a..2c36021a 100644 --- a/samples/Pulls/UpdatePull.hs +++ b/samples/Pulls/UpdatePull.hs @@ -6,7 +6,13 @@ 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 }) + 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/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/GitShow.hs b/samples/Repos/Commits/GitShow.hs index b913cb47..9b5ab8a2 100644 --- a/samples/Repos/Commits/GitShow.hs +++ b/samples/Repos/Commits/GitShow.hs @@ -18,7 +18,7 @@ formatCommit commit = 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/Contents.hs b/samples/Repos/Contents.hs index 2b3c1cb6..3132c6f5 100644 --- a/samples/Repos/Contents.hs +++ b/samples/Repos/Contents.hs @@ -1,9 +1,20 @@ -module GetContents where +{-# LANGUAGE NoImplicitPrelude #-} +{-# LANGUAGE OverloadedStrings #-} -import qualified Github.Repos as Github -import Data.List -import Prelude hiding (truncate, getContents) +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 "====" @@ -13,34 +24,93 @@ main = do putStrLn "=======" getContents "LICENSE" + createUpdateDeleteSampleFile + +getContents :: Text -> IO () getContents path = do - contents <- Github.contentsFor "mike-burns" "ohlaunch" path Nothing - putStrLn $ either (("Error: " ++) . show) formatContents contents + contents <- GitHub.contentsFor "mike-burns" "ohlaunch" path Nothing + putStrLn $ either (("Error: " <>) . tshow) formatContents contents -formatContents (Github.ContentFile fileData) = - formatContentInfo (Github.contentFileInfo fileData) ++ +formatContents :: GitHub.Content -> Text +formatContents (GitHub.ContentFile fileData) = + formatContentInfo (GitHub.contentFileInfo fileData) <> unlines - [ show (Github.contentFileSize fileData) ++ " bytes" - , "encoding: " ++ Github.contentFileEncoding fileData - , "data: " ++ truncate (Github.contentFileContent fileData) + [ tshow (GitHub.contentFileSize fileData) <> " bytes" + , "encoding: " <> GitHub.contentFileEncoding fileData + , "data: " <> truncate (GitHub.contentFileContent fileData) ] -formatContents (Github.ContentDirectory items) = - intercalate "\n\n" $ map formatItem items +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.contentUrl contentInfo - , "git url: " ++ Github.contentGitUrl contentInfo - , "html url: " ++ Github.contentHtmlUrl contentInfo + [ "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: " ++ show (Github.contentItemType item) ++ "\n" ++ - formatContentInfo (Github.contentItemInfo 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 + } -truncate str = take 40 str ++ "... (truncated)" +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/ShowRepo.hs b/samples/Repos/ShowRepo.hs index fb63c497..ac72069a 100644 --- a/samples/Repos/ShowRepo.hs +++ b/samples/Repos/ShowRepo.hs @@ -5,20 +5,19 @@ 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" ++ - (fromMaybe "" $ Github.repoCloneUrl repo) ++ "\t" ++ - (fromMaybe "" $ formatDate `fmap` 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.fromDate 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/Search/SearchCode.hs b/samples/Search/SearchCode.hs index 68a73c96..f5b472cb 100644 --- a/samples/Search/SearchCode.hs +++ b/samples/Search/SearchCode.hs @@ -1,34 +1,33 @@ {-# LANGUAGE OverloadedStrings #-} -module SearchCode where -import qualified Github.Search as Github -import qualified Github.Data as Github -import Control.Monad (forM,forM_) -import Data.Maybe (fromMaybe) +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 = "q=Code repo:jwiegley/github&per_page=100" - let auth = Nothing - result <- Github.searchCode' auth query + 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.searchCodeCodes r) (\r -> do - putStrLn $ formatCode r - putStrLn "" - ) - putStrLn $ "Count: " ++ show n ++ " matches for the query: \"" ++ query ++ "\"" - where n = Github.searchCodeTotalCount r + 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 :: GitHub.Code -> String formatCode r = - let fields = [ ("Name", Github.codeName) - ,("Path", Github.codePath) - ,("Sha", Github.codeSha) - ,("URL", Github.codeHtmlUrl) + 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) - + where n' = max 0 (n - length s) diff --git a/samples/Search/SearchIssues.hs b/samples/Search/SearchIssues.hs index 9b86ac22..288aef73 100644 --- a/samples/Search/SearchIssues.hs +++ b/samples/Search/SearchIssues.hs @@ -1,26 +1,29 @@ {-# LANGUAGE OverloadedStrings #-} -module SearchIssues where +module Main where -import qualified Github.Search as Github +import qualified GitHub +import qualified Data.Text as T import Control.Monad (forM_) +import Data.Monoid ((<>)) +main :: IO () main = do - let query = "q=build%20repo%3Aphadej%2Fgithub&per_page=100" - let auth = Nothing - result <- Github.searchIssues' auth query + 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.searchIssuesIssues r) (\i -> do - putStrLn $ formatIssue i - putStrLn "" - ) - putStrLn $ "Count: " ++ show n ++ " build issues" - where n = Github.searchIssuesTotalCount r + 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 = - (Github.githubOwnerLogin $ Github.issueUser issue) ++ - " opened this issue " ++ - (show $ Github.fromDate $ Github.issueCreatedAt issue) ++ "\n" ++ - (Github.issueState issue) ++ " with " ++ - (show $ Github.issueComments issue) ++ " comments" ++ "\n\n" ++ - (Github.issueTitle 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 ade7f784..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", formatMaybeDate . Github.repoCreatedAt) - ,("Pushed-At", formatMaybeDate . Github.repoPushedAt) - ,("Stars", show . Github.repoStargazersCount) + 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.fromDate + +formatMaybeDate :: Maybe UTCTime -> String +formatMaybeDate = maybe "???" show diff --git a/samples/Teams/DeleteTeam.hs b/samples/Teams/DeleteTeam.hs index 484102ff..b354d94c 100644 --- a/samples/Teams/DeleteTeam.hs +++ b/samples/Teams/DeleteTeam.hs @@ -1,10 +1,8 @@ +{-# LANGUAGE NoImplicitPrelude #-} {-# LANGUAGE OverloadedStrings #-} module Main (main) where import Common -import Prelude () - -import Data.String (fromString) import qualified GitHub import qualified GitHub.Endpoints.Organizations.Teams as GitHub diff --git a/samples/Teams/EditTeam.hs b/samples/Teams/EditTeam.hs index e5485d46..7e83e5c9 100644 --- a/samples/Teams/EditTeam.hs +++ b/samples/Teams/EditTeam.hs @@ -1,23 +1,21 @@ +{-# LANGUAGE NoImplicitPrelude #-} {-# LANGUAGE OverloadedStrings #-} module Main (main) where import Common -import Prelude () - -import Data.String (fromString) import qualified GitHub -import qualified GitHub.Endpoints.Organizations.Teams as GitHub main :: IO () main = do args <- getArgs result <- case args of [token, team_id, team_name, desc] -> - GitHub.editTeam' + GitHub.github (GitHub.OAuth $ fromString token) + GitHub.editTeamR (GitHub.mkTeamId $ read team_id) - (GitHub.EditTeam (GitHub.mkTeamName $ fromString team_name) (Just $ fromString desc) GitHub.PermissionPull) + (GitHub.EditTeam (GitHub.mkTeamName $ fromString team_name) (Just $ fromString desc) Nothing Nothing) _ -> error "usage: EditTeam " case result of diff --git a/samples/Teams/ListRepos.hs b/samples/Teams/ListRepos.hs index 505f4c7b..a03dc143 100644 --- a/samples/Teams/ListRepos.hs +++ b/samples/Teams/ListRepos.hs @@ -4,15 +4,14 @@ module Main (main) where import Common import Prelude () -import qualified GitHub -import qualified GitHub.Endpoints.Organizations.Teams as GitHub +import qualified GitHub as GH main :: IO () main = do args <- getArgs possibleRepos <- case args of - [team_id, token] -> GitHub.listTeamRepos' (Just $ GitHub.OAuth $ fromString token) (GitHub.mkTeamId $ read team_id) - [team_id] -> GitHub.listTeamRepos (GitHub.mkTeamId $ read team_id) + [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 diff --git a/samples/Teams/ListTeamsCurrent.hs b/samples/Teams/ListTeamsCurrent.hs index aa7718ec..eefd1e70 100644 --- a/samples/Teams/ListTeamsCurrent.hs +++ b/samples/Teams/ListTeamsCurrent.hs @@ -1,19 +1,16 @@ +{-# LANGUAGE NoImplicitPrelude #-} {-# LANGUAGE OverloadedStrings #-} module Main (main) where import Common -import Prelude () -import Data.String (fromString) - -import qualified GitHub -import qualified GitHub.Endpoints.Organizations.Teams as GitHub +import qualified GitHub as GH main :: IO () main = do args <- getArgs result <- case args of - [token] -> GitHub.listTeamsCurrent' (GitHub.OAuth $ fromString token) + [token] -> GH.github (GH.OAuth $ fromString token) GH.listTeamsCurrentR GH.FetchAll _ -> error "usage: ListTeamsCurrent " case result of Left err -> putStrLn $ "Error: " <> tshow err diff --git a/samples/Teams/Memberships/AddTeamMembershipFor.hs b/samples/Teams/Memberships/AddTeamMembershipFor.hs index faad9435..58c120a2 100644 --- a/samples/Teams/Memberships/AddTeamMembershipFor.hs +++ b/samples/Teams/Memberships/AddTeamMembershipFor.hs @@ -1,26 +1,22 @@ +{-# LANGUAGE NoImplicitPrelude #-} {-# LANGUAGE OverloadedStrings #-} module Main (main) where import Common -import Prelude () - -import Data.String (fromString) 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.addTeamMembershipFor' - (GitHub.OAuth $ fromString token) - (GitHub.mkTeamId $ read team_id) - (GitHub.mkOwnerName $ fromString username) - GitHub.RoleMember - _ -> - error "usage: AddTeamMembershipFor " + [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 index 9c7da148..1d7b7ed5 100644 --- a/samples/Teams/Memberships/DeleteTeamMembershipFor.hs +++ b/samples/Teams/Memberships/DeleteTeamMembershipFor.hs @@ -1,10 +1,8 @@ +{-# LANGUAGE NoImplicitPrelude #-} {-# LANGUAGE OverloadedStrings #-} module Main (main) where import Common -import Prelude () - -import Data.String (fromString) import qualified GitHub import qualified GitHub.Endpoints.Organizations.Teams as GitHub diff --git a/samples/Teams/Memberships/TeamMembershipInfoFor.hs b/samples/Teams/Memberships/TeamMembershipInfoFor.hs index 1596df5f..89a6fa82 100644 --- a/samples/Teams/Memberships/TeamMembershipInfoFor.hs +++ b/samples/Teams/Memberships/TeamMembershipInfoFor.hs @@ -1,10 +1,8 @@ +{-# LANGUAGE NoImplicitPrelude #-} {-# LANGUAGE OverloadedStrings #-} module Main (main) where import Common -import Prelude () - -import Data.String (fromString) import qualified GitHub import qualified GitHub.Endpoints.Organizations.Teams as GitHub 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 index a2ca4c8e..7a8744f8 100644 --- a/samples/Teams/TeamInfoFor.hs +++ b/samples/Teams/TeamInfoFor.hs @@ -1,20 +1,17 @@ +{-# LANGUAGE NoImplicitPrelude #-} {-# LANGUAGE OverloadedStrings #-} module Main (main) where import Common -import Prelude () -import Data.String (fromString) - -import qualified GitHub -import qualified GitHub.Endpoints.Organizations.Teams as GitHub +import qualified GitHub as GH main :: IO () main = do args <- getArgs result <- case args of - [team_id, token] -> GitHub.teamInfoFor' (Just $ GitHub.OAuth $ fromString token) (GitHub.mkTeamId $ read team_id) - [team_id] -> GitHub.teamInfoFor (GitHub.mkTeamId $ read team_id) + [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 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 index 78243e9e..6d71c8a5 100644 --- a/samples/Users/Followers/Example.hs +++ b/samples/Users/Followers/Example.hs @@ -1,11 +1,11 @@ {-# LANGUAGE NoImplicitPrelude #-} {-# LANGUAGE OverloadedStrings #-} +import Prelude () import Prelude.Compat import Data.Text (Text, pack) import Data.Text.IO as T (putStrLn) -import Data.Monoid ((<>)) import qualified GitHub.Endpoints.Users.Followers as GitHub diff --git a/samples/Users/Followers/ListFollowers.hs b/samples/Users/Followers/ListFollowers.hs index 8f608f61..dc5df3fe 100644 --- a/samples/Users/Followers/ListFollowers.hs +++ b/samples/Users/Followers/ListFollowers.hs @@ -9,7 +9,7 @@ import qualified GitHub main :: IO () main = do auth <- getAuth - possibleUsers <- GitHub.executeRequestMaybe auth $ GitHub.usersFollowingR "mike-burns" Nothing + possibleUsers <- GitHub.executeRequestMaybe auth $ GitHub.usersFollowingR "mike-burns" GitHub.FetchAll putStrLn $ either (("Error: " <>) . tshow) (foldMap ((<> "\n") . formatUser)) possibleUsers diff --git a/samples/Users/Followers/ListFollowing.hs b/samples/Users/Followers/ListFollowing.hs index 6e6e006c..81953aee 100644 --- a/samples/Users/Followers/ListFollowing.hs +++ b/samples/Users/Followers/ListFollowing.hs @@ -9,7 +9,7 @@ import qualified GitHub main :: IO () main = do auth <- getAuth - possibleUsers <- GitHub.executeRequestMaybe auth $ GitHub.usersFollowedByR "mike-burns" Nothing + possibleUsers <- GitHub.executeRequestMaybe auth $ GitHub.usersFollowedByR "mike-burns" GitHub.FetchAll putStrLn $ either (("Error: " <>) . tshow) (foldMap ((<> "\n") . formatUser)) possibleUsers 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 b9c5d433..9ec6e423 100644 --- a/samples/Users/ShowUser.hs +++ b/samples/Users/ShowUser.hs @@ -6,38 +6,37 @@ import Prelude () import Data.Maybe (fromMaybe) -import qualified GitHub -import qualified GitHub.Endpoints.Users as GitHub +import qualified GitHub as GH main :: IO () main = do - auth <- getAuth - possibleUser <- GitHub.userInfoFor' auth "mike-burns" + mauth <- getAuth + possibleUser <- maybe GH.github' GH.github mauth GH.userInfoForR "mike-burns" putStrLn $ either (("Error: " <>) . tshow) formatUser possibleUser -formatUser :: GitHub.User -> Text +formatUser :: GH.User -> Text formatUser user = - (formatName userName login) <> "\t" <> (fromMaybe "" company) <> "\t" <> - (fromMaybe "" location) <> "\n" <> - (fromMaybe "" blog) <> "\t" <> "<" <> (fromMaybe "" email) <> ">" <> "\n" <> - htmlUrl <> "\t" <> tshow createdAt <> "\n" <> + 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) + fromMaybe "" bio where - userName = GitHub.userName user - login = GitHub.userLogin user - company = GitHub.userCompany user - location = GitHub.userLocation user - blog = GitHub.userBlog user - email = GitHub.userEmail user - htmlUrl = GitHub.userHtmlUrl user - createdAt = GitHub.userCreatedAt user - isHireable = GitHub.userHireable user - bio = GitHub.userBio 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 :: Maybe Text -> GitHub.Name GitHub.User -> Text -formatName Nothing login = GitHub.untagName login -formatName (Just name) login = name <> "(" <> GitHub.untagName 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" diff --git a/samples/github-samples.cabal b/samples/github-samples.cabal index eb607530..2e7a8699 100644 --- a/samples/github-samples.cabal +++ b/samples/github-samples.cabal @@ -1,275 +1,226 @@ --- This file has been generated from package.yaml by hpack version 0.13.0. --- --- see: https://github.com/sol/hpack - -name: github-samples -version: 0.0.0 -build-type: Simple -cabal-version: >= 1.10 +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 + hs-source-dirs: src + ghc-options: -Wall build-depends: - base - , base-compat + , base >=4.11 && <5 + -- require base-4.11 because then (<>) is in Prelude , github , text - exposed-modules: - Common - default-language: Haskell2010 -executable github-add-team-membership-for - main-is: AddTeamMembershipFor.hs - hs-source-dirs: - Teams/Memberships - ghc-options: -Wall - build-depends: - base - , base-compat - , github - , text - , github-samples - other-modules: - DeleteTeamMembershipFor - TeamMembershipInfoFor + exposed-modules: Common default-language: Haskell2010 -executable github-delete-team - main-is: DeleteTeam.hs - hs-source-dirs: - Teams - ghc-options: -Wall +executable github-operational + default-language: Haskell2010 + main-is: Operational.hs + hs-source-dirs: Operational + ghc-options: -Wall -threaded build-depends: - base - , base-compat + , base + , base-compat-batteries , github - , text , github-samples - other-modules: - EditTeam - ListRepos - ListTeamsCurrent - Memberships.AddTeamMembershipFor - Memberships.DeleteTeamMembershipFor - Memberships.TeamMembershipInfoFor - TeamInfoFor - default-language: Haskell2010 + , http-client + , operational + , text + , transformers + , transformers-compat -executable github-delete-team-membership-for - main-is: DeleteTeamMembershipFor.hs - hs-source-dirs: - Teams/Memberships - ghc-options: -Wall +common deps + default-language: Haskell2010 + ghc-options: + -Wall + -threaded build-depends: - base - , base-compat + , base + , base-compat-batteries + , base64-bytestring , github - , text , github-samples - other-modules: - AddTeamMembershipFor - TeamMembershipInfoFor - default-language: Haskell2010 + , 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 - main-is: EditTeam.hs - hs-source-dirs: - Teams - ghc-options: -Wall - build-depends: - base - , base-compat - , github - , text - , github-samples - other-modules: - DeleteTeam - ListRepos - ListTeamsCurrent - Memberships.AddTeamMembershipFor - Memberships.DeleteTeamMembershipFor - Memberships.TeamMembershipInfoFor - TeamInfoFor - default-language: Haskell2010 + 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 - main-is: ListFollowers.hs - hs-source-dirs: - Users/Followers - ghc-options: -Wall - build-depends: - base - , base-compat - , github - , text - , github-samples - other-modules: - Example - ListFollowing - default-language: Haskell2010 + import: deps + main-is: ListFollowers.hs + hs-source-dirs: Users/Followers -executable github-list-followers-example - main-is: Example.hs - hs-source-dirs: - Users/Followers - ghc-options: -Wall - build-depends: - base - , base-compat - , github - , text - other-modules: - ListFollowers - ListFollowing - default-language: Haskell2010 +-- executable github-list-followers-example +-- import: deps +-- main-is: Example.hs +-- hs-source-dirs: Users/Followers executable github-list-following - main-is: ListFollowing.hs - hs-source-dirs: - Users/Followers - ghc-options: -Wall - build-depends: - base - , base-compat - , github - , text - , github-samples - other-modules: - Example - ListFollowers - default-language: Haskell2010 + import: deps + main-is: ListFollowing.hs + hs-source-dirs: Users/Followers executable github-list-team-current - main-is: ListTeamsCurrent.hs - hs-source-dirs: - Teams - ghc-options: -Wall - build-depends: - base - , base-compat - , github - , text - , github-samples - other-modules: - DeleteTeam - EditTeam - ListRepos - Memberships.AddTeamMembershipFor - Memberships.DeleteTeamMembershipFor - Memberships.TeamMembershipInfoFor - TeamInfoFor - default-language: Haskell2010 - -executable github-list-team-repos - main-is: ListRepos.hs - hs-source-dirs: - Teams - ghc-options: -Wall - build-depends: - base - , base-compat - , github - , text - , github-samples - other-modules: - DeleteTeam - EditTeam - ListTeamsCurrent - Memberships.AddTeamMembershipFor - Memberships.DeleteTeamMembershipFor - Memberships.TeamMembershipInfoFor - TeamInfoFor - default-language: Haskell2010 - -executable github-operational - main-is: Operational.hs - hs-source-dirs: - Operational - ghc-options: -Wall - build-depends: - base - , base-compat - , github - , text - , github-samples - , http-client - , http-client-tls - , operational - , transformers - , transformers-compat - default-language: Haskell2010 + 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 - main-is: ShowUser.hs - hs-source-dirs: - Users - ghc-options: -Wall - build-depends: - base - , base-compat - , github - , text - , github-samples - other-modules: - Followers.Example - Followers.ListFollowers - Followers.ListFollowing - ShowUser2 - default-language: Haskell2010 + import: deps + main-is: ShowUser.hs + hs-source-dirs: Users executable github-show-user-2 - main-is: ShowUser2.hs - hs-source-dirs: - Users - ghc-options: -Wall - build-depends: - base - , base-compat - , github - , text - , github-samples - other-modules: - Followers.Example - Followers.ListFollowers - Followers.ListFollowing - ShowUser - default-language: Haskell2010 - -executable github-team-membership-info-for - main-is: TeamMembershipInfoFor.hs - hs-source-dirs: - Teams/Memberships - ghc-options: -Wall - build-depends: - base - , base-compat - , github - , text - , github-samples - other-modules: - AddTeamMembershipFor - DeleteTeamMembershipFor - default-language: Haskell2010 + 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 - main-is: TeamInfoFor.hs - hs-source-dirs: - Teams - ghc-options: -Wall - build-depends: - base - , base-compat - , github - , text - , github-samples - other-modules: - DeleteTeam - EditTeam - ListRepos - ListTeamsCurrent - Memberships.AddTeamMembershipFor - Memberships.DeleteTeamMembershipFor - Memberships.TeamMembershipInfoFor - default-language: Haskell2010 + 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/package.yaml b/samples/package.yaml deleted file mode 100644 index af03e708..00000000 --- a/samples/package.yaml +++ /dev/null @@ -1,87 +0,0 @@ -name: github-samples - -ghc-options: -Wall - -dependencies: - - base - - base-compat - - github - - text - -library: - source-dirs: src - -executables: - github-show-user: - main: ShowUser.hs - source-dirs: Users - dependencies: - - github-samples - github-show-user-2: - main: ShowUser2.hs - source-dirs: Users - dependencies: - - github-samples - github-list-followers-example: - main: Example.hs - source-dirs: Users/Followers - github-list-followers: - main: ListFollowers.hs - source-dirs: Users/Followers - dependencies: - - github-samples - github-list-following: - main: ListFollowing.hs - source-dirs: Users/Followers - dependencies: - - github-samples - github-delete-team: - main: DeleteTeam.hs - source-dirs: Teams - dependencies: - - github-samples - github-edit-team: - main: EditTeam.hs - source-dirs: Teams - dependencies: - - github-samples - github-list-team-current: - main: ListTeamsCurrent.hs - source-dirs: Teams - dependencies: - - github-samples - github-list-team-repos: - main: ListRepos.hs - source-dirs: Teams - dependencies: - - github-samples - github-teaminfo-for: - main: TeamInfoFor.hs - source-dirs: Teams - dependencies: - - github-samples - github-add-team-membership-for: - main: AddTeamMembershipFor.hs - source-dirs: Teams/Memberships - dependencies: - - github-samples - github-delete-team-membership-for: - main: DeleteTeamMembershipFor.hs - source-dirs: Teams/Memberships - dependencies: - - github-samples - github-team-membership-info-for: - main: TeamMembershipInfoFor.hs - source-dirs: Teams/Memberships - dependencies: - - github-samples - github-operational: - main: Operational.hs - source-dirs: Operational - dependencies: - - github-samples - - http-client - - http-client-tls - - operational - - transformers - - transformers-compat diff --git a/samples/src/Common.hs b/samples/src/Common.hs index c48f8588..6051d2a4 100644 --- a/samples/src/Common.hs +++ b/samples/src/Common.hs @@ -1,25 +1,18 @@ +{-# LANGUAGE NoImplicitPrelude #-} module Common ( -- * Common stuff getAuth, tshow, -- * Re-exports - (<>), - fromString, - Text, putStrLn, getArgs, Proxy(..), - module Prelude.Compat, + module GitHub.Internal.Prelude, ) where -import Prelude () -import Prelude.Compat hiding (putStrLn) +import GitHub.Internal.Prelude hiding (putStrLn) -import Data.Monoid ((<>)) import Data.Proxy (Proxy (..)) -import Data.String (fromString) -import Data.String (fromString) -import Data.Text (Text) import Data.Text.IO (putStrLn) import System.Environment (lookupEnv) import System.Environment (getArgs) 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 index 71d62f1a..43b3c234 100644 --- a/spec/GitHub/ActivitySpec.hs +++ b/spec/GitHub/ActivitySpec.hs @@ -1,7 +1,8 @@ {-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE TemplateHaskell #-} module GitHub.ActivitySpec where +import qualified GitHub + import GitHub.Auth (Auth (..)) import GitHub.Endpoints.Activity.Starring (myStarredAcceptStarR) import GitHub.Endpoints.Activity.Watching (watchersForR) @@ -29,11 +30,11 @@ spec :: Spec spec = do describe "watchersForR" $ do it "works" $ withAuth $ \auth -> do - cs <- executeRequest auth $ watchersForR "phadej" "github" Nothing + 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 (Just 31) + 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 index b639d964..97f8c386 100644 --- a/spec/GitHub/CommitsSpec.hs +++ b/spec/GitHub/CommitsSpec.hs @@ -1,16 +1,13 @@ {-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE TemplateHaskell #-} module GitHub.CommitsSpec where import GitHub.Auth (Auth (..)) -import GitHub.Endpoints.Repos.Commits (Commit, commitSha, commitsFor', - commitsForR, diffR, mkName) -import GitHub.Request (executeRequest) +import GitHub.Endpoints.Repos.Commits (commitSha, commitsForR, diffR, mkCommitName, FetchCount (..)) +import GitHub.Request (github) import Control.Monad (forM_) import Data.Either.Compat (isRight) import Data.List (nub, sort) -import Data.Proxy (Proxy (..)) import Data.String (fromString) import System.Environment (lookupEnv) import Test.Hspec (Spec, describe, it, pendingWith, shouldBe, @@ -33,13 +30,13 @@ spec :: Spec spec = do describe "commitsFor" $ do it "works" $ withAuth $ \auth -> do - cs <- commitsFor' (Just auth) "phadej" "github" + cs <- github auth commitsForR "haskell-github" "github" FetchAll cs `shouldSatisfy` isRight V.length (fromRightS cs) `shouldSatisfy` (> 300) -- Page size is 30, so we get 60 commits it "limits the response" $ withAuth $ \auth -> do - cs <- executeRequest auth $ commitsForR "phadej" "github" (Just 40) + cs <- github auth commitsForR "haskell-github" "github" (FetchAtLeast 40) cs `shouldSatisfy` isRight let cs' = fromRightS cs V.length cs' `shouldSatisfy` (< 70) @@ -48,15 +45,19 @@ spec = do describe "diff" $ do it "works" $ withAuth $ \auth -> do - cs <- executeRequest auth $ commitsForR "phadej" "github" (Just 30) + cs <- github auth commitsForR "haskell-github" "github" (FetchAtLeast 30) cs `shouldSatisfy` isRight let commits = take 10 . V.toList . fromRightS $ cs let pairs = zip commits $ drop 1 commits forM_ pairs $ \(a, b) -> do - d <- executeRequest auth $ diffR "phadej" "github" (commitSha a) (commitSha b) + d <- github auth diffR "haskell-github" "github" (commitSha a) (commitSha b) d `shouldSatisfy` isRight it "issue #155" $ withAuth $ \auth -> do - let mkCommitName = mkName (Proxy :: Proxy Commit) - d <- executeRequest auth $ diffR "nomeata" "codespeed" (mkCommitName "ghc") (mkCommitName "tobami:master") + d <- github auth diffR "nomeata" "codespeed" (mkCommitName "ghc") (mkCommitName "tobami:master") + d `shouldSatisfy` isRight + + -- diff that includes a commit where a submodule is removed + it "issue #339" $ withAuth $ \auth -> do + d <- github auth diffR "scott-fleischman" "repo-remove-submodule" "d03c152482169d809be9b1eab71dcf64d7405f76" "42cfd732b20cd093534f246e630b309186eb485d" d `shouldSatisfy` isRight diff --git a/spec/GitHub/EventsSpec.hs b/spec/GitHub/EventsSpec.hs 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 index 354a84cb..e673975f 100644 --- a/spec/GitHub/IssuesSpec.hs +++ b/spec/GitHub/IssuesSpec.hs @@ -3,11 +3,16 @@ module GitHub.IssuesSpec where import qualified GitHub -import Data.Either.Compat (isRight) -import Data.Foldable (for_) -import Data.String (fromString) -import System.Environment (lookupEnv) -import Test.Hspec (Spec, describe, it, pendingWith, shouldSatisfy) +import 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 @@ -25,11 +30,41 @@ spec = do describe "issuesForRepoR" $ do it "works" $ withAuth $ \auth -> for_ repos $ \(owner, repo) -> do cs <- GitHub.executeRequest auth $ - GitHub.issuesForRepoR owner repo [] Nothing - cs `shouldSatisfy` isRight + GitHub.issuesForRepoR owner repo mempty GitHub.FetchAll + case cs of + Left e -> + expectationFailure . show $ e + Right cs' -> do + for_ cs' $ \i -> do + cms <- GitHub.executeRequest auth $ + GitHub.commentsR owner repo (GitHub.issueNumber i) 1 + cms `shouldSatisfy` isRight + + describe "issuesForRepoR paged" $ do + it "works" $ withAuth $ \auth -> for_ repos $ \(owner, repo) -> do + mgr <- newManager GitHub.tlsManagerSettings + ret <- GitHub.executeRequestWithMgrAndRes mgr auth $ + GitHub.issuesForRepoR owner repo mempty (GitHub.FetchPage (GitHub.PageParams (Just 2) (Just 1))) + + case ret of + Left e -> + expectationFailure . show $ e + Right res -> do + let issues = responseBody res + length issues `shouldSatisfy` (<= 2) + + for_ issues $ \i -> do + cms <- GitHub.executeRequest auth $ + GitHub.commentsR owner repo (GitHub.issueNumber i) 1 + cms `shouldSatisfy` isRight + + describe "issueR" $ do + it "fetches issue #428" $ withAuth $ \auth -> do + resIss <- GitHub.executeRequest auth $ + GitHub.issueR "haskell-github" "github" (GitHub.IssueNumber 428) + resIss `shouldSatisfy` isRight where repos = [ ("thoughtbot", "paperclip") - , ("phadej", "github") - , ("haskell", "cabal") + , ("haskell-github", "github") ] diff --git a/spec/GitHub/OrganizationsSpec.hs b/spec/GitHub/OrganizationsSpec.hs index e53ecb44..b6e7aea3 100644 --- a/spec/GitHub/OrganizationsSpec.hs +++ b/spec/GitHub/OrganizationsSpec.hs @@ -2,20 +2,20 @@ {-# LANGUAGE TemplateHaskell #-} module GitHub.OrganizationsSpec where +import GitHub (FetchCount (..), github) import GitHub.Auth (Auth (..)) -import GitHub.Data (SimpleOrganization (..), - SimpleOwner (..), - SimpleTeam (..)) -import GitHub.Endpoints.Organizations (publicOrganizationsFor') -import GitHub.Endpoints.Organizations.Members (membersOf') +import GitHub.Data + (SimpleOrganization (..), SimpleOwner (..), SimpleTeam (..)) +import GitHub.Endpoints.Organizations (publicOrganizationsForR) +import GitHub.Endpoints.Organizations.Members (membersOfR) -import Data.Aeson.Compat (eitherDecodeStrict) +import Data.Aeson (eitherDecodeStrict) import Data.Either.Compat (isRight) import Data.FileEmbed (embedFile) import Data.String (fromString) import System.Environment (lookupEnv) -import Test.Hspec (Spec, describe, it, pendingWith, shouldBe, - shouldSatisfy) +import Test.Hspec + (Spec, describe, it, pendingWith, shouldBe, shouldSatisfy) fromRightS :: Show a => Either a b -> b fromRightS (Right b) = b @@ -36,7 +36,7 @@ spec = do simpleOrganizationLogin (head $ fromRightS orgs) `shouldBe` "github" it "returns information about the user's organizations" $ withAuth $ \auth -> do - orgs <- publicOrganizationsFor' (Just auth) "mike-burns" + orgs <- github auth publicOrganizationsForR "mike-burns" FetchAll orgs `shouldSatisfy` isRight describe "teamsOf" $ do @@ -50,5 +50,5 @@ spec = do simpleOwnerLogin (head $ fromRightS ms) `shouldBe` "octocat" it "works" $ withAuth $ \auth -> do - ms <- membersOf' (Just auth) "haskell" + ms <- github auth membersOfR "haskell" FetchAll ms `shouldSatisfy` isRight diff --git a/spec/GitHub/PublicSSHKeysSpec.hs b/spec/GitHub/PublicSSHKeysSpec.hs new file mode 100644 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 index 9ff0f3e6..05945d01 100644 --- a/spec/GitHub/PullRequestsSpec.hs +++ b/spec/GitHub/PullRequestsSpec.hs @@ -1,38 +1,164 @@ -{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE TemplateHaskell #-} module GitHub.PullRequestsSpec where -import qualified GitHub +import qualified GitHub as GH -import Data.Either.Compat (isRight) -import Data.Foldable (for_) -import Data.Function.Compat ((&)) -import Data.String (fromString) -import System.Environment (lookupEnv) -import Test.Hspec (Spec, describe, it, pendingWith, shouldSatisfy) +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 :: (GitHub.Auth -> IO ()) -> IO () +withAuth :: (GH.Auth -> IO ()) -> IO () withAuth action = do mtoken <- lookupEnv "GITHUB_TOKEN" case mtoken of Nothing -> pendingWith "no GITHUB_TOKEN" - Just token -> action (GitHub.OAuth $ fromString token) + Just token -> action (GH.OAuth $ fromString token) spec :: Spec spec = do describe "pullRequestsForR" $ do it "works" $ withAuth $ \auth -> for_ repos $ \(owner, repo) -> do - cs <- GitHub.executeRequest auth $ - GitHub.pullRequestsForR owner repo opts Nothing + 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") - , ("phadej", "github") - , ("haskell", "cabal") + , ("haskell-github", "github") ] - opts = GitHub.defaultPullRequestOptions - & GitHub.setPullRequestOptionsState GitHub.PullRequestStateClosed + 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 index bda2780b..9ccc7066 100644 --- a/spec/GitHub/ReposSpec.hs +++ b/spec/GitHub/ReposSpec.hs @@ -1,15 +1,22 @@ +{-# LANGUAGE CPP #-} {-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE TemplateHaskell #-} + +#if __GLASGOW_HASKELL__ >= 900 +{-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-} +#endif + module GitHub.ReposSpec where -import GitHub.Auth (Auth (..)) -import GitHub.Endpoints.Repos (RepoPublicity (..), currentUserRepos, - languagesFor', userRepos') +import GitHub + (Auth (..), FetchCount (..), Repo (..), RepoPublicity (..), github, + repositoryR) +import GitHub.Endpoints.Repos (currentUserReposR, languagesForR, userReposR) import Data.Either.Compat (isRight) import Data.String (fromString) import System.Environment (lookupEnv) -import Test.Hspec (Spec, describe, it, pendingWith, shouldSatisfy) +import Test.Hspec + (Spec, describe, it, pendingWith, shouldBe, shouldSatisfy) import qualified Data.HashMap.Strict as HM @@ -26,18 +33,26 @@ withAuth action = do 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 <- currentUserRepos auth RepoPublicityAll + cs <- github auth currentUserReposR RepoPublicityAll FetchAll cs `shouldSatisfy` isRight describe "userRepos" $ do it "works" $ withAuth $ \auth -> do - cs <- userRepos' (Just auth) "phadej" RepoPublicityAll + cs <- github auth userReposR "phadej" RepoPublicityAll FetchAll cs `shouldSatisfy` isRight describe "languagesFor'" $ do it "works" $ withAuth $ \auth -> do - ls <- languagesFor' (Just auth) "phadej" "github" + ls <- github auth languagesForR "haskell-github" "github" ls `shouldSatisfy` isRight fromRightS ls `shouldSatisfy` HM.member "Haskell" diff --git a/spec/GitHub/ReviewDecodeSpec.hs b/spec/GitHub/ReviewDecodeSpec.hs new file mode 100644 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 index 11f12ee6..23c6b7a9 100644 --- a/spec/GitHub/SearchSpec.hs +++ b/spec/GitHub/SearchSpec.hs @@ -2,10 +2,10 @@ {-# LANGUAGE TemplateHaskell #-} module GitHub.SearchSpec where -import Prelude () +import Prelude () import Prelude.Compat -import Data.Aeson.Compat (eitherDecodeStrict) +import Data.Aeson (eitherDecodeStrict) import Data.FileEmbed (embedFile) import Data.Proxy (Proxy (..)) import Data.String (fromString) @@ -14,8 +14,11 @@ import Test.Hspec (Spec, describe, it, pendingWith, shouldBe) import qualified Data.Vector as V -import GitHub.Data (Auth (..), Issue (..), mkId) -import GitHub.Endpoints.Search (SearchResult (..), searchIssues') +import GitHub (github) +import GitHub.Data + (Auth (..), Issue (..), IssueNumber (..), IssueState (..), + SimpleUser (..), User, mkId) +import GitHub.Endpoints.Search (SearchResult' (..), SearchResult, searchIssuesR, searchUsersR) fromRightS :: Show a => Either a b -> b fromRightS (Right b) = b @@ -40,18 +43,25 @@ spec = do let issue1 = issues V.! 0 issueId issue1 `shouldBe` mkId (Proxy :: Proxy Issue) 123898390 - issueNumber issue1 `shouldBe` 130 + issueNumber issue1 `shouldBe` IssueNumber 130 issueTitle issue1 `shouldBe` "Make test runner more robust" - issueState issue1 `shouldBe` "closed" + issueState issue1 `shouldBe` StateClosed let issue2 = issues V.! 1 issueId issue2 `shouldBe` mkId (Proxy :: Proxy Issue) 119694665 - issueNumber issue2 `shouldBe` 127 + issueNumber issue2 `shouldBe` IssueNumber 127 issueTitle issue2 `shouldBe` "Decouple request creation from execution" - issueState issue2 `shouldBe` "open" + issueState issue2 `shouldBe` StateOpen it "performs an issue search via the API" $ withAuth $ \auth -> do - let query = "Decouple in:title repo:phadej/github created:<=2015-12-01" - issues <- searchResultResults . fromRightS <$> searchIssues' (Just auth) query + let query = "Decouple in:title repo:haskell-github/github created:<=2015-12-01" + issues <- fmap (searchResultResults . fromRightS) <$> github auth $ searchIssuesR query 5 length issues `shouldBe` 1 issueId (V.head issues) `shouldBe` mkId (Proxy :: Proxy Issue) 119694665 + + describe "searchUsers" $ + it "performs a user search via the API" $ withAuth $ \auth -> do + let query = "oleg.grenrus@iki.fi created:<2020-01-01" + users <- fmap (searchResultResults . fromRightS) <$> github auth $ searchUsersR query 5 + length users `shouldBe` 1 + simpleUserId (V.head users) `shouldBe` mkId (Proxy :: Proxy User) 51087 diff --git a/spec/GitHub/UsersSpec.hs b/spec/GitHub/UsersSpec.hs index 99842347..0b1913f5 100644 --- a/spec/GitHub/UsersSpec.hs +++ b/spec/GitHub/UsersSpec.hs @@ -2,20 +2,22 @@ {-# LANGUAGE TemplateHaskell #-} module GitHub.UsersSpec where -import Data.Aeson.Compat (eitherDecodeStrict) +import Data.Aeson (eitherDecodeStrict) import Data.Either.Compat (isLeft, isRight) import Data.FileEmbed (embedFile) import Data.String (fromString) import System.Environment (lookupEnv) -import Test.Hspec (Spec, describe, it, pendingWith, shouldBe, - shouldSatisfy) +import Test.Hspec + (Spec, describe, it, pendingWith, shouldBe, shouldSatisfy) -import GitHub.Data (Auth (..), Organization (..), - User (..), fromOwner) -import GitHub.Endpoints.Users (ownerInfoForR, userInfoCurrent', - userInfoFor') +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 (executeRequest) +import GitHub.Request (github) fromRightS :: Show a => Either a b -> b fromRightS (Right b) = b @@ -39,38 +41,42 @@ spec = do let userInfo = eitherDecodeStrict $(embedFile "fixtures/user.json") userLogin (fromRightS userInfo) `shouldBe` "mike-burns" + it "decodes user-bot json" $ do + let userInfo = eitherDecodeStrict $(embedFile "fixtures/user-bot.json") + userLogin (fromRightS userInfo) `shouldBe` "mike-burns" + it "returns information about the user" $ withAuth $ \auth -> do - userInfo <- userInfoFor' (Just auth) "mike-burns" + userInfo <- github auth userInfoForR "mike-burns" userLogin (fromRightS userInfo) `shouldBe` "mike-burns" it "catches http exceptions" $ withAuth $ \auth -> do - userInfo <- userInfoFor' (Just auth) "i-hope-this-user-will-never-exist" + userInfo <- github auth userInfoForR "i-hope-this-user-will-never-exist" userInfo `shouldSatisfy` isLeft it "should fail for organization" $ withAuth $ \auth -> do - userInfo <- userInfoFor' (Just auth) "haskell" + userInfo <- github auth userInfoForR "haskell" userInfo `shouldSatisfy` isLeft describe "ownerInfoFor" $ do it "works for users and organizations" $ withAuth $ \auth -> do - a <- executeRequest auth $ ownerInfoForR "haskell" - b <- executeRequest auth $ ownerInfoForR "phadej" + a <- github auth ownerInfoForR "haskell" + b <- github auth ownerInfoForR "phadej" a `shouldSatisfy` isRight b `shouldSatisfy` isRight (organizationLogin . fromRightS . fromOwner . fromRightS $ a) `shouldBe` "haskell" (userLogin . fromLeftS . fromOwner . fromRightS $ b) `shouldBe` "phadej" - describe "userInfoCurrent'" $ do - it "returns information about the autenticated user" $ withAuth $ \auth -> do - userInfo <- userInfoCurrent' auth + describe "userInfoCurrentR" $ do + it "returns information about the authenticated user" $ withAuth $ \auth -> do + userInfo <- github auth userInfoCurrentR userInfo `shouldSatisfy` isRight describe "usersFollowing" $ do it "works" $ withAuth $ \auth -> do - us <- executeRequest auth $ usersFollowingR "phadej" (Just 10) + us <- github auth usersFollowingR "phadej" (GitHub.FetchAtLeast 10) us `shouldSatisfy` isRight describe "usersFollowedBy" $ do it "works" $ withAuth $ \auth -> do - us <- executeRequest auth $ usersFollowedByR "phadej" (Just 10) + us <- github auth usersFollowedByR "phadej" (GitHub.FetchAtLeast 10) us `shouldSatisfy` isRight diff --git a/src/GitHub.hs b/src/GitHub.hs index 3c53cfb5..5d323de8 100644 --- a/src/GitHub.hs +++ b/src/GitHub.hs @@ -1,32 +1,45 @@ ------------------------------------------------------------------------------ -- | --- License : BSD-3-Clause --- Maintainer : Oleg Grenrus --- --- This module re-exports all request constructrors and data definitions from +-- This module re-exports all request constructors and data definitions from -- this package. -- --- See "GitHub.Request" module for executing 'Request', or other modules --- of this package (e.g. "GitHub.Users") for already composed versions. +-- See "GitHub.Request" module for executing 'Request', in short +-- use @'github' request@, for example +-- +-- @ +-- 'github' 'userInfoForR' +-- :: 'AuthMethod' am => am -> 'Name' 'User' -> IO (Either 'Error' 'User') +-- @ -- -- The missing endpoints lists show which endpoints we know are missing, there -- might be more. + module GitHub ( -- * Activity -- | See + -- ** Events + -- | See + repositoryEventsR, + userEventsR, + + -- ** Notifications + -- | See + getNotificationsR, + markNotificationAsReadR, + markAllNotificationsAsReadR, + -- ** Starring -- | See -- -- Missing endpoints: -- -- * Check if you are starring a repository - -- * Star a repository - -- * Unstar a repository stargazersForR, reposStarredByR, myStarredR, myStarredAcceptStarR, + starRepoR, + unstarRepoR, -- ** Watching -- | See @@ -35,9 +48,9 @@ module GitHub ( -- -- * Query a Repository Subscription -- * Set a Repository Subscription - -- * Delete a Repository Subscription watchersForR, reposWatchedByR, + unwatchRepoR, -- * Gists -- | See @@ -45,17 +58,17 @@ module GitHub ( -- Missing endpoints: -- -- * Query a specific revision of a gist - -- * Create a gist -- * Edit a gist -- * List gist commits - -- * Star a gist - -- * Unstar a gist -- * Check if a gist is starred -- * Fork a gist -- * List gist forks - -- * Delete a gist gistsR, gistR, + createGistR, + starGistR, + unstarGistR, + deleteGistR, -- ** Comments -- | See @@ -83,6 +96,8 @@ module GitHub ( referenceR, referencesR, createReferenceR, + deleteReferenceR, + namespacedReferencesR, -- ** Trees -- | See @@ -92,9 +107,8 @@ module GitHub ( -- * Issues -- | See -- - -- Missing endpoints: - -- - -- * List issues + currentUserIssuesR, + organizationIssuesR, issueR, issuesForRepoR, createIssueR, @@ -103,12 +117,10 @@ module GitHub ( -- ** Comments -- | See -- - -- Missing endpoints: - -- - -- * Delete comment commentR, commentsR, createCommentR, + deleteCommentR, editCommentR, -- ** Events @@ -136,13 +148,11 @@ module GitHub ( -- ** Milestone -- | See -- - -- Missing endpoints: - -- - -- * Create a milestone - -- * Update a milestone - -- * Delete a milestone milestonesR, milestoneR, + createMilestoneR, + updateMilestoneR, + deleteMilestoneR, -- * Organizations -- | See @@ -154,12 +164,21 @@ module GitHub ( -- * Edit an organization publicOrganizationsForR, publicOrganizationR, + organizationsR, -- ** Members -- | See -- - -- Missing endpoints: All except /Members List/ + -- 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 @@ -188,6 +207,8 @@ module GitHub ( -- | See pullRequestsForR, pullRequestR, + pullRequestPatchR, + pullRequestDiffR, createPullRequestR, updatePullRequestR, pullRequestCommitsR, @@ -201,11 +222,25 @@ module GitHub ( -- Missing endpoints: -- -- * List comments in a repository - -- * Create a comment -- * 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, - pullRequestReviewCommentR, -- * Repositories -- | See @@ -228,7 +263,9 @@ module GitHub ( -- ** Collaborators -- | See collaboratorsOnR, + collaboratorPermissionOnR, isCollaboratorOnR, + addCollaboratorR, -- ** Comments -- | See @@ -237,7 +274,7 @@ module GitHub ( -- -- * Create a commit comment -- * Update a commit comment - -- * Delete a commit comment + -- * Delete a commit comment commentsForR, commitCommentsForR, commitCommentForR, @@ -249,6 +286,43 @@ module GitHub ( 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 -- @@ -257,6 +331,12 @@ module GitHub ( -- * Create a fork forksForR, + -- ** Statuses + -- | See + createStatusR, + statusesForR, + statusForR, + -- ** Webhooks -- | See webhooksForR, @@ -267,15 +347,31 @@ module GitHub ( pingRepoWebhookR, deleteRepoWebhookR, + -- * Releases + releasesR, + releaseR, + latestReleaseR, + releaseByTagNameR, + + -- ** Invitations + -- | See + -- Missing endpoints: + + -- * Delete a repository invitation + -- * Update a repository invitation + -- * Decline a repository invitation + + listInvitationsOnR, + acceptInvitationFromR, + listInvitationsForR, + + -- * Search -- | See - -- - -- Missing endpoints: - -- - -- * Search users searchReposR, searchCodeR, searchIssuesR, + searchUsersR, -- * Users -- | See @@ -288,6 +384,17 @@ module GitHub ( ownerInfoForR, userInfoCurrentR, + -- ** Emails + -- | See + -- + -- Missing endpoints: + -- + -- * Add email address(es) + -- * Delete email address(es) + -- * Toggle primary email visibility + currentUserEmailsR, + currentUserPublicEmailsR, + -- ** Followers -- | See -- @@ -300,6 +407,88 @@ module GitHub ( 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 @@ -307,6 +496,14 @@ module GitHub ( ) 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 @@ -322,16 +519,28 @@ 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.ReviewComments +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 index 09475664..cd53cd2e 100644 --- a/src/GitHub/Auth.hs +++ b/src/GitHub/Auth.hs @@ -1,32 +1,58 @@ -{-# LANGUAGE DeriveDataTypeable #-} -{-# LANGUAGE DeriveGeneric #-} ------------------------------------------------------------------------------ --- | --- License : BSD-3-Clause --- Maintainer : Oleg Grenrus --- -module GitHub.Auth where +module GitHub.Auth ( + Auth (..), + Token, + JWTToken, + AuthMethod, + endpoint, + setAuthRequest + ) where -import Control.DeepSeq (NFData (..)) -import Control.DeepSeq.Generics (genericRnf) -import Data.Binary (Binary) -import Data.Data (Data, Typeable) -import Data.Hashable (Hashable) -import GHC.Generics (Generic) +import GitHub.Internal.Prelude +import Prelude () -import qualified Data.ByteString as BS +import qualified Data.ByteString as BS +import qualified Data.Text.Encoding as TE +import qualified Network.HTTP.Client as HTTP type Token = BS.ByteString +type JWTToken = Text -- | The Github auth data type data Auth - = BasicAuth BS.ByteString BS.ByteString - | OAuth Token -- ^ token - | EnterpriseOAuth String -- custom API endpoint without - -- trailing slash - Token -- token - deriving (Show, Data, Typeable, Eq, Ord, Generic) - -instance NFData Auth where rnf = genericRnf + = 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 index 65c48289..18fb770d 100644 --- a/src/GitHub/Data.hs +++ b/src/GitHub/Data.hs @@ -1,12 +1,6 @@ -{-# LANGUAGE CPP #-} -{-# LANGUAGE DeriveDataTypeable #-} -{-# LANGUAGE OverloadedStrings #-} ------------------------------------------------------------------------------ -- | --- License : BSD-3-Clause --- Maintainer : Oleg Grenrus --- --- This module re-exports the @GitHub.Data.@ and "Github.Auth" submodules. +-- This module re-exports the @GitHub.Data.@ and "GitHub.Auth" submodules. + module GitHub.Data ( -- * Tagged types -- ** Name @@ -18,6 +12,7 @@ module GitHub.Data ( mkTeamName, mkOrganizationName, mkRepoName, + mkCommitName, fromUserName, fromOrganizationName, -- ** Id @@ -31,46 +26,88 @@ module GitHub.Data ( 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 Prelude () -import Prelude.Compat - -import Data.Text (Text) +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 @@ -102,6 +139,9 @@ mkRepoId = Id mkRepoName :: Text -> Name Repo mkRepoName = N +mkCommitName :: Text -> Name Commit +mkCommitName = N + fromOrganizationName :: Name Organization -> Name Owner fromOrganizationName = N . untagName 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 index 21e46ad5..b480ef21 100644 --- a/src/GitHub/Data/Activities.hs +++ b/src/GitHub/Data/Activities.hs @@ -1,32 +1,21 @@ -{-# LANGUAGE DeriveDataTypeable #-} -{-# LANGUAGE DeriveGeneric #-} -{-# LANGUAGE OverloadedStrings #-} ------------------------------------------------------------------------------ --- | --- License : BSD-3-Clause --- Maintainer : Oleg Grenrus --- module GitHub.Data.Activities where -import Prelude () -import Prelude.Compat +import GitHub.Data.Id (Id, mkId) +import GitHub.Data.Repos (Repo, RepoRef) +import GitHub.Data.URL (URL) +import GitHub.Internal.Prelude -import Control.DeepSeq (NFData (..)) -import Control.DeepSeq.Generics (genericRnf) -import Data.Aeson.Compat (FromJSON (..), withObject, (.:)) -import Data.Binary (Binary) -import Data.Data (Data, Typeable) -import Data.Time (UTCTime) -import GHC.Generics (Generic) +import Prelude () -import GitHub.Data.Repos (Repo) +import qualified Data.Text as T -data RepoStarred = RepoStarred { - repoStarredStarredAt :: !UTCTime - ,repoStarredRepo :: !Repo -} deriving (Show, Data, Typeable, Eq, Ord, Generic) +data RepoStarred = RepoStarred + { repoStarredStarredAt :: !UTCTime + , repoStarredRepo :: !Repo + } + deriving (Show, Data, Eq, Ord, Generic) -instance NFData RepoStarred where rnf = genericRnf +instance NFData RepoStarred instance Binary RepoStarred -- JSON Instances @@ -35,3 +24,91 @@ instance FromJSON RepoStarred where <$> 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 index 61cbfca6..c5987c77 100644 --- a/src/GitHub/Data/Comments.hs +++ b/src/GitHub/Data/Comments.hs @@ -1,44 +1,27 @@ -{-# LANGUAGE DeriveDataTypeable #-} -{-# LANGUAGE DeriveGeneric #-} -{-# LANGUAGE OverloadedStrings #-} ------------------------------------------------------------------------------ --- | --- License : BSD-3-Clause --- Maintainer : Oleg Grenrus --- module GitHub.Data.Comments where -import Prelude () -import Prelude.Compat +import GitHub.Data.Definitions +import GitHub.Data.Id (Id) +import GitHub.Data.URL (URL) +import GitHub.Internal.Prelude +import Prelude () -import Control.DeepSeq (NFData (..)) -import Control.DeepSeq.Generics (genericRnf) -import Data.Aeson.Compat (FromJSON (..), ToJSON (..), object, withObject, - (.:), (.:?), (.=)) -import Data.Binary.Orphans (Binary) -import Data.Data (Data, Typeable) -import Data.Text (Text) -import Data.Time (UTCTime) -import GHC.Generics (Generic) +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) -import GitHub.Data.Definitions -import GitHub.Data.Id - -data Comment = Comment { - commentPosition :: !(Maybe Int) - ,commentLine :: !(Maybe Int) - ,commentBody :: !Text - ,commentCommitId :: !(Maybe Text) - ,commentUpdatedAt :: !UTCTime - ,commentHtmlUrl :: !(Maybe Text) - ,commentUrl :: !Text - ,commentCreatedAt :: !(Maybe UTCTime) - ,commentPath :: !(Maybe Text) - ,commentUser :: !SimpleUser - ,commentId :: !(Id Comment) -} deriving (Show, Data, Typeable, Eq, Ord, Generic) - -instance NFData Comment where rnf = genericRnf +instance NFData Comment instance Binary Comment instance FromJSON Comment where @@ -55,22 +38,55 @@ instance FromJSON Comment where <*> o .: "user" <*> o .: "id" -data NewComment = NewComment { - newCommentBody :: !Text -} deriving (Show, Data, Typeable, Eq, Ord, Generic) +data NewComment = NewComment + { newCommentBody :: !Text + } + deriving (Show, Data, Eq, Ord, Generic) -instance NFData NewComment where rnf = genericRnf +instance NFData NewComment instance Binary NewComment instance ToJSON NewComment where toJSON (NewComment b) = object [ "body" .= b ] -data EditComment = EditComment { - editCommentBody :: !Text -} deriving (Show, Data, Typeable, Eq, Ord, Generic) +data EditComment = EditComment + { editCommentBody :: !Text + } + deriving (Show, Data, Eq, Ord, Generic) -instance NFData EditComment where rnf = genericRnf +instance NFData EditComment instance Binary EditComment instance ToJSON EditComment where toJSON (EditComment b) = object [ "body" .= b ] + +data NewPullComment = NewPullComment + { newPullCommentCommit :: !Text + , newPullCommentPath :: !Text + , newPullCommentPosition :: !Int + , newPullCommentBody :: !Text + } + deriving (Show, Data, Eq, Ord, Generic) + +instance NFData NewPullComment +instance Binary NewPullComment + +instance ToJSON NewPullComment where + toJSON (NewPullComment c path pos b) = + object [ "body" .= b + , "commit_id" .= c + , "path" .= path + , "position" .= pos + ] + +data PullCommentReply = PullCommentReply + { pullCommentReplyBody :: Text + } + deriving (Show, Data, Eq, Ord, Generic) + +instance NFData PullCommentReply + +instance ToJSON PullCommentReply where + toJSON (PullCommentReply b) = + object [ "body" .= b + ] diff --git a/src/GitHub/Data/Content.hs b/src/GitHub/Data/Content.hs index 14519a5e..5e0c4b92 100644 --- a/src/GitHub/Data/Content.hs +++ b/src/GitHub/Data/Content.hs @@ -1,34 +1,26 @@ -{-# LANGUAGE DeriveDataTypeable #-} -{-# LANGUAGE DeriveGeneric #-} -{-# LANGUAGE OverloadedStrings #-} ------------------------------------------------------------------------------ --- | --- License : BSD-3-Clause --- Maintainer : Oleg Grenrus --- -module GitHub.Data.Content where +{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE CPP #-} -import Prelude () -import Prelude.Compat +module GitHub.Data.Content where -import Control.DeepSeq (NFData (..)) -import Control.DeepSeq.Generics (genericRnf) -import Data.Aeson.Compat (FromJSON (..), Value (..), withObject, - withText, (.:)) -import Data.Binary.Orphans (Binary) -import Data.Data (Data, Typeable) -import Data.Text (Text) -import Data.Vector (Vector) -import GHC.Generics (Generic) +import GitHub.Data.GitData +import GitHub.Data.URL +import GitHub.Internal.Prelude +import Prelude () +import Data.Aeson.Types (Pair) import qualified Data.Text as T +#if MIN_VERSION_aeson(2,0,0) +import Data.Aeson (Key) +#endif + data Content = ContentFile !ContentFileData | ContentDirectory !(Vector ContentItem) - deriving (Show, Data, Typeable, Eq, Ord, Generic) + deriving (Show, Data, Eq, Ord, Generic) -instance NFData Content where rnf = genericRnf +instance NFData Content instance Binary Content data ContentFileData = ContentFileData { @@ -36,24 +28,24 @@ data ContentFileData = ContentFileData { ,contentFileEncoding :: !Text ,contentFileSize :: !Int ,contentFileContent :: !Text -} deriving (Show, Data, Typeable, Eq, Ord, Generic) +} deriving (Show, Data, Eq, Ord, Generic) -instance NFData ContentFileData where rnf = genericRnf +instance NFData ContentFileData instance Binary ContentFileData -- | An item in a directory listing. data ContentItem = ContentItem { contentItemType :: !ContentItemType ,contentItemInfo :: !ContentInfo -} deriving (Show, Data, Typeable, Eq, Ord, Generic) +} deriving (Show, Data, Eq, Ord, Generic) -instance NFData ContentItem where rnf = genericRnf +instance NFData ContentItem instance Binary ContentItem data ContentItemType = ItemFile | ItemDir - deriving (Show, Data, Typeable, Eq, Ord, Generic) + deriving (Show, Data, Eq, Ord, Generic) -instance NFData ContentItemType where rnf = genericRnf +instance NFData ContentItemType instance Binary ContentItemType -- | Information common to both kinds of Content: files and directories. @@ -61,14 +53,79 @@ data ContentInfo = ContentInfo { contentName :: !Text ,contentPath :: !Text ,contentSha :: !Text - ,contentUrl :: !Text - ,contentGitUrl :: !Text - ,contentHtmlUrl :: !Text -} deriving (Show, Data, Typeable, Eq, Ord, Generic) + ,contentUrl :: !URL + ,contentGitUrl :: !URL + ,contentHtmlUrl :: !URL +} deriving (Show, Data, Eq, Ord, Generic) -instance NFData ContentInfo where rnf = genericRnf +instance NFData ContentInfo instance Binary ContentInfo +data ContentResultInfo = ContentResultInfo + { contentResultInfo :: !ContentInfo + , contentResultSize :: !Int + } deriving (Show, Data, 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 @@ -87,11 +144,10 @@ instance FromJSON ContentItem where <*> parseJSON (Object o) instance FromJSON ContentItemType where - parseJSON = withText "ContentItemType" $ \t -> - case t of - "file" -> return ItemFile - "dir" -> return ItemDir - _ -> fail $ "Invalid ContentItemType: " ++ T.unpack t + parseJSON = withText "ContentItemType" $ \t -> case T.toLower t of + "file" -> pure ItemFile + "dir" -> pure ItemDir + _ -> fail $ "Unknown ContentItemType: " <> T.unpack t instance FromJSON ContentInfo where parseJSON = withObject "ContentInfo" $ \o -> @@ -101,3 +157,57 @@ instance FromJSON ContentInfo where <*> 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 index a652e670..12f392df 100644 --- a/src/GitHub/Data/Definitions.hs +++ b/src/GitHub/Data/Definitions.hs @@ -1,35 +1,19 @@ -{-# LANGUAGE DeriveDataTypeable #-} -{-# LANGUAGE DeriveGeneric #-} -{-# LANGUAGE OverloadedStrings #-} ------------------------------------------------------------------------------ --- | --- License : BSD-3-Clause --- Maintainer : Oleg Grenrus --- module GitHub.Data.Definitions where -import Prelude () -import Prelude.Compat - -import Control.DeepSeq (NFData (..)) -import Control.DeepSeq.Generics (genericRnf) -import Control.Monad (mfilter) -import Data.Aeson.Compat (FromJSON (..), Object, withObject, withText, - (.:), (.:?)) -import Data.Aeson.Types (Parser) -import Data.Binary.Orphans (Binary) -import Data.Data (Data, Typeable) -import Data.Text (Text) -import Data.Time (UTCTime) -import GHC.Generics (Generic) -import Network.HTTP.Client (HttpException) +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.Text as T import qualified Data.ByteString as BS +import qualified Data.Text as T -import GitHub.Data.Id -import GitHub.Data.Name +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. @@ -38,13 +22,13 @@ data Error | ParseError !Text -- ^ An error in the parser itself. | JsonError !Text -- ^ The JSON is malformed or unexpected. | UserError !Text -- ^ Incorrect input. - deriving (Show, Typeable) + deriving (Show) instance E.Exception Error -- | Type of the repository owners. -data OwnerType = OwnerUser | OwnerOrganization - deriving (Eq, Ord, Enum, Bounded, Show, Read, Generic, Typeable, Data) +data OwnerType = OwnerUser | OwnerOrganization | OwnerBot + deriving (Eq, Ord, Enum, Bounded, Show, Read, Generic, Data) instance NFData OwnerType instance Binary OwnerType @@ -52,47 +36,46 @@ instance Binary OwnerType data SimpleUser = SimpleUser { simpleUserId :: !(Id User) , simpleUserLogin :: !(Name User) - , simpleUserAvatarUrl :: !Text - , simpleUserUrl :: !Text - , simpleUserType :: !OwnerType -- ^ Should always be 'OwnerUser' + , simpleUserAvatarUrl :: !URL + , simpleUserUrl :: !URL } - deriving (Show, Data, Typeable, Eq, Ord, Generic) + deriving (Show, Data, Eq, Ord, Generic) -instance NFData SimpleUser where rnf = genericRnf +instance NFData SimpleUser instance Binary SimpleUser data SimpleOrganization = SimpleOrganization { simpleOrganizationId :: !(Id Organization) , simpleOrganizationLogin :: !(Name Organization) - , simpleOrganizationUrl :: !Text - , simpleOrganizationAvatarUrl :: !Text + , simpleOrganizationUrl :: !URL + , simpleOrganizationAvatarUrl :: !URL } - deriving (Show, Data, Typeable, Eq, Ord, Generic) + deriving (Show, Data, Eq, Ord, Generic) -instance NFData SimpleOrganization where rnf = genericRnf +instance NFData SimpleOrganization instance Binary SimpleOrganization -- | Sometimes we don't know the type of the owner, e.g. in 'Repo' data SimpleOwner = SimpleOwner { simpleOwnerId :: !(Id Owner) , simpleOwnerLogin :: !(Name Owner) - , simpleOwnerUrl :: !Text - , simpleOwnerAvatarUrl :: !Text + , simpleOwnerUrl :: !URL + , simpleOwnerAvatarUrl :: !URL , simpleOwnerType :: !OwnerType } - deriving (Show, Data, Typeable, Eq, Ord, Generic) + deriving (Show, Data, Eq, Ord, Generic) -instance NFData SimpleOwner where rnf = genericRnf +instance NFData SimpleOwner instance Binary SimpleOwner data User = User { userId :: !(Id User) , userLogin :: !(Name User) , userName :: !(Maybe Text) - , userType :: !OwnerType -- ^ Should always be 'OwnerUser' + , userType :: !OwnerType -- ^ Should always be 'OwnerUser' or 'OwnerBot' , userCreatedAt :: !UTCTime , userPublicGists :: !Int - , userAvatarUrl :: !Text + , userAvatarUrl :: !URL , userFollowers :: !Int , userFollowing :: !Int , userHireable :: !(Maybe Bool) @@ -102,12 +85,12 @@ data User = User , userLocation :: !(Maybe Text) , userCompany :: !(Maybe Text) , userEmail :: !(Maybe Text) - , userUrl :: !Text - , userHtmlUrl :: !Text + , userUrl :: !URL + , userHtmlUrl :: !URL } - deriving (Show, Data, Typeable, Eq, Ord, Generic) + deriving (Show, Data, Eq, Ord, Generic) -instance NFData User where rnf = genericRnf +instance NFData User instance Binary User data Organization = Organization @@ -119,25 +102,25 @@ data Organization = Organization , organizationLocation :: !(Maybe Text) , organizationFollowers :: !Int , organizationCompany :: !(Maybe Text) - , organizationAvatarUrl :: !Text + , organizationAvatarUrl :: !URL , organizationPublicGists :: !Int - , organizationHtmlUrl :: !Text + , organizationHtmlUrl :: !URL , organizationEmail :: !(Maybe Text) , organizationFollowing :: !Int , organizationPublicRepos :: !Int - , organizationUrl :: !Text + , organizationUrl :: !URL , organizationCreatedAt :: !UTCTime } - deriving (Show, Data, Typeable, Eq, Ord, Generic) + deriving (Show, Data, Eq, Ord, Generic) -instance NFData Organization where rnf = genericRnf +instance NFData Organization instance Binary Organization --- | In practic, you cam't have concrete values of 'Owner'. +-- | In practice you can't have concrete values of 'Owner'. newtype Owner = Owner (Either User Organization) - deriving (Show, Data, Typeable, Eq, Ord, Generic) + deriving (Show, Data, Eq, Ord, Generic) -instance NFData Owner where rnf = genericRnf +instance NFData Owner instance Binary Owner fromOwner :: Owner -> Either User Organization @@ -146,11 +129,11 @@ fromOwner (Owner owner) = owner -- JSON instances instance FromJSON OwnerType where - parseJSON = withText "Owner type" $ \t -> - case t of - "User" -> pure $ OwnerUser - "Organization" -> pure $ OwnerOrganization - _ -> fail $ "Unknown owner type: " ++ T.unpack t + parseJSON = withText "OwnerType" $ \t -> case T.toLower t of + "user" -> pure $ OwnerUser + "organization" -> pure $ OwnerOrganization + "bot" -> pure $ OwnerBot + _ -> fail $ "Unknown OwnerType: " <> T.unpack t instance FromJSON SimpleUser where parseJSON = withObject "SimpleUser" $ \obj -> do @@ -159,7 +142,6 @@ instance FromJSON SimpleUser where <*> obj .: "login" <*> obj .: "avatar_url" <*> obj .: "url" - <*> obj .: "type" instance FromJSON SimpleOrganization where parseJSON = withObject "SimpleOrganization" $ \obj -> @@ -219,7 +201,7 @@ parseOrganization obj = Organization <*> obj .: "created_at" instance FromJSON User where - parseJSON = mfilter ((== OwnerUser) . userType) . withObject "User" parseUser + parseJSON = mfilter ((/= OwnerOrganization) . userType) . withObject "User" parseUser instance FromJSON Organization where parseJSON = withObject "Organization" parseOrganization @@ -229,23 +211,178 @@ instance FromJSON Owner where t <- obj .: "type" case t of OwnerUser -> Owner . Left <$> parseUser obj + OwnerBot -> Owner . Left <$> parseUser obj OwnerOrganization -> Owner . Right <$> parseOrganization obj -- | Filter members returned in the list. data OrgMemberFilter = OrgMemberFilter2faDisabled -- ^ Members without two-factor authentication enabled. Available for organization owners. | OrgMemberFilterAll -- ^ All members the authenticated user can see. - deriving (Show, Eq, Ord, Enum, Bounded, Typeable, Data, Generic) + deriving (Show, Eq, Ord, Enum, Bounded, Data, Generic) -- | Filter members returned by their role. data OrgMemberRole = OrgMemberRoleAll -- ^ All members of the organization, regardless of role. | OrgMemberRoleAdmin -- ^ Organization owners. | OrgMemberRoleMember -- ^ Non-owner organization members. - deriving (Show, Eq, Ord, Enum, Bounded, Typeable, Data, Generic) + deriving (Show, Eq, Ord, Enum, Bounded, Data, Generic) -- | Request query string type QueryString = [(BS.ByteString, Maybe BS.ByteString)] -- | 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 index 53fc6cb4..983b7a1d 100644 --- a/src/GitHub/Data/Gists.hs +++ b/src/GitHub/Data/Gists.hs @@ -1,102 +1,118 @@ -{-# LANGUAGE DeriveDataTypeable #-} -{-# LANGUAGE DeriveGeneric #-} -{-# LANGUAGE OverloadedStrings #-} ------------------------------------------------------------------------------ --- | --- License : BSD-3-Clause --- Maintainer : Oleg Grenrus --- module GitHub.Data.Gists where -import Prelude () -import Prelude.Compat - 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) -import Control.DeepSeq (NFData (..)) -import Control.DeepSeq.Generics (genericRnf) -import Data.Aeson.Compat (FromJSON (..), withObject, (.:), (.:?)) -import Data.Binary (Binary) -import Data.Data (Data, Typeable) -import Data.HashMap.Strict (HashMap) -import Data.Text (Text) -import Data.Time (UTCTime) -import GHC.Generics (Generic) - -data Gist = Gist { - gistUser :: !SimpleUser - ,gistGitPushUrl :: !Text - ,gistUrl :: !Text - ,gistDescription :: !(Maybe Text) - ,gistCreatedAt :: !UTCTime - ,gistPublic :: !Bool - ,gistComments :: !Int - ,gistUpdatedAt :: !UTCTime - ,gistHtmlUrl :: !Text - ,gistId :: !(Name Gist) - ,gistFiles :: !(HashMap Text GistFile) - ,gistGitPullUrl :: !Text -} deriving (Show, Data, Typeable, Eq, Generic) - -instance NFData Gist where rnf = genericRnf +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 :: !Text - ,gistFileSize :: !Int - ,gistFileLanguage :: !(Maybe Language) - ,gistFileFilename :: !Text - ,gistFileContent :: !(Maybe Text) -} deriving (Show, Data, Typeable, Eq, Generic) - -instance NFData GistFile where rnf = genericRnf + 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 :: !Text - ,gistCommentCreatedAt :: !UTCTime - ,gistCommentBody :: !Text - ,gistCommentUpdatedAt :: !UTCTime - ,gistCommentId :: !(Id GistComment) -} deriving (Show, Data, Typeable, Eq, Ord, Generic) - -instance NFData GistComment where rnf = genericRnf + 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" + 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 index 5a9012a8..41158632 100644 --- a/src/GitHub/Data/GitData.hs +++ b/src/GitHub/Data/GitData.hs @@ -1,313 +1,312 @@ -{-# LANGUAGE DeriveDataTypeable #-} -{-# LANGUAGE DeriveGeneric #-} -{-# LANGUAGE OverloadedStrings #-} ------------------------------------------------------------------------------ --- | --- License : BSD-3-Clause --- Maintainer : Oleg Grenrus --- module GitHub.Data.GitData where -import Prelude () -import Prelude.Compat - import GitHub.Data.Definitions import GitHub.Data.Name (Name) - -import Control.DeepSeq (NFData (..)) -import Control.DeepSeq.Generics (genericRnf) -import Data.Aeson.Compat (FromJSON (..), ToJSON (..), object, withObject, - (.!=), (.:), (.:?), (.=)) -import Data.Binary (Binary) -import Data.Data (Data, Typeable) -import Data.Text (Text) -import Data.Time (UTCTime) -import Data.Vector (Vector) -import GHC.Generics (Generic) +import GitHub.Data.URL (URL) +import GitHub.Internal.Prelude +import Prelude () import qualified Data.Vector as V -- | The options for querying commits. -data CommitQueryOption = CommitQuerySha !Text - | CommitQueryPath !Text - | CommitQueryAuthor !Text - | CommitQuerySince !UTCTime - | CommitQueryUntil !UTCTime - deriving (Show, Eq, Ord, Generic, Typeable, Data) - -data Stats = Stats { - statsAdditions :: !Int - ,statsTotal :: !Int - ,statsDeletions :: !Int -} deriving (Show, Data, Typeable, Eq, Ord, Generic) - -instance NFData Stats where rnf = genericRnf +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 :: !Text - ,commitGitCommit :: !GitCommit - ,commitCommitter :: !(Maybe SimpleUser) - ,commitAuthor :: !(Maybe SimpleUser) - ,commitFiles :: !(Vector File) - ,commitStats :: !(Maybe Stats) -} deriving (Show, Data, Typeable, Eq, Ord, Generic) - -instance NFData Commit where rnf = genericRnf +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 :: !Text - ,treeGitTrees :: !(Vector GitTree) -} deriving (Show, Data, Typeable, Eq, Ord, Generic) +data Tree = Tree + { treeSha :: !(Name Tree) + , treeUrl :: !URL + , treeGitTrees :: !(Vector GitTree) + } + deriving (Show, Data, Eq, Ord, Generic) -instance NFData Tree where rnf = genericRnf +instance NFData Tree instance Binary Tree -data GitTree = GitTree { - gitTreeType :: !Text - ,gitTreeSha :: !(Name GitTree) - -- Can be empty for submodule - ,gitTreeUrl :: !(Maybe Text) - ,gitTreeSize :: !(Maybe Int) - ,gitTreePath :: !Text - ,gitTreeMode :: !Text -} deriving (Show, Data, Typeable, Eq, Ord, Generic) - -instance NFData GitTree where rnf = genericRnf +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 :: !Text - ,gitCommitCommitter :: !GitUser - ,gitCommitAuthor :: !GitUser - ,gitCommitTree :: !Tree - ,gitCommitSha :: !(Maybe (Name GitCommit)) - ,gitCommitParents :: !(Vector Tree) -} deriving (Show, Data, Typeable, Eq, Ord, Generic) - -instance NFData GitCommit where rnf = genericRnf +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 :: !Text - ,blobEncoding :: !Text - ,blobContent :: !Text - ,blobSha :: !(Name Blob) - ,blobSize :: !Int -} deriving (Show, Data, Typeable, Eq, Ord, Generic) +data Blob = Blob + { blobUrl :: !URL + , blobEncoding :: !Text + , blobContent :: !Text + , blobSha :: !(Name Blob) + , blobSize :: !Int + } + deriving (Show, Data, Eq, Ord, Generic) -instance NFData Blob where rnf = genericRnf +instance NFData Blob instance Binary Blob -data Tag = Tag { - tagName :: !Text - ,tagZipballUrl :: !Text - ,tagTarballUrl :: !Text - ,tagCommit :: !BranchCommit -} deriving (Show, Data, Typeable, Eq, Ord, Generic) +data Tag = Tag + { tagName :: !Text + , tagZipballUrl :: !URL + , tagTarballUrl :: !URL + , tagCommit :: !BranchCommit + } + deriving (Show, Data, Eq, Ord, Generic) -instance NFData Tag where rnf = genericRnf +instance NFData Tag instance Binary Tag -data Branch = Branch { - branchName :: !Text - ,branchCommit :: !BranchCommit -} deriving (Show, Data, Typeable, Eq, Ord, Generic) +data Branch = Branch + { branchName :: !Text + , branchCommit :: !BranchCommit + } + deriving (Show, Data, Eq, Ord, Generic) -instance NFData Branch where rnf = genericRnf +instance NFData Branch -data BranchCommit = BranchCommit { - branchCommitSha :: !Text - ,branchCommitUrl :: !Text -} deriving (Show, Data, Typeable, Eq, Ord, Generic) +data BranchCommit = BranchCommit + { branchCommitSha :: !Text + , branchCommitUrl :: !URL + } + deriving (Show, Data, Eq, Ord, Generic) -instance NFData BranchCommit where rnf = genericRnf +instance NFData BranchCommit instance Binary BranchCommit -data Diff = Diff { - diffStatus :: !Text - ,diffBehindBy :: !Int - ,diffPatchUrl :: !Text - ,diffUrl :: !Text - ,diffBaseCommit :: !Commit - ,diffCommits :: !(Vector Commit) - ,diffTotalCommits :: !Int - ,diffHtmlUrl :: !Text - ,diffFiles :: !(Vector File) - ,diffAheadBy :: !Int - ,diffDiffUrl :: !Text - ,diffPermalinkUrl :: !Text -} deriving (Show, Data, Typeable, Eq, Ord, Generic) - -instance NFData Diff where rnf = genericRnf +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, Typeable, Eq, Ord, Generic) +data NewGitReference = NewGitReference + { newGitReferenceRef :: !Text + , newGitReferenceSha :: !Text + } + deriving (Show, Data, Eq, Ord, Generic) -instance NFData NewGitReference where rnf = genericRnf +instance NFData NewGitReference instance Binary NewGitReference -data GitReference = GitReference { - gitReferenceObject :: !GitObject - ,gitReferenceUrl :: !Text - ,gitReferenceRef :: !Text -} deriving (Show, Data, Typeable, Eq, Ord, Generic) +data GitReference = GitReference + { gitReferenceObject :: !GitObject + , gitReferenceUrl :: !URL + , gitReferenceRef :: !(Name GitReference) + } + deriving (Show, Data, Eq, Ord, Generic) -instance NFData GitReference where rnf = genericRnf +instance NFData GitReference instance Binary GitReference -data GitObject = GitObject { - gitObjectType :: !Text - ,gitObjectSha :: !Text - ,gitObjectUrl :: !Text -} deriving (Show, Data, Typeable, Eq, Ord, Generic) +data GitObject = GitObject + { gitObjectType :: !Text + , gitObjectSha :: !Text + , gitObjectUrl :: !URL + } + deriving (Show, Data, Eq, Ord, Generic) -instance NFData GitObject where rnf = genericRnf +instance NFData GitObject instance Binary GitObject -data GitUser = GitUser { - gitUserName :: !Text - ,gitUserEmail :: !Text - ,gitUserDate :: !UTCTime -} deriving (Show, Data, Typeable, Eq, Ord, Generic) +data GitUser = GitUser + { gitUserName :: !Text + , gitUserEmail :: !Text + , gitUserDate :: !UTCTime + } + deriving (Show, Data, Eq, Ord, Generic) -instance NFData GitUser where rnf = genericRnf +instance NFData GitUser instance Binary GitUser -data File = File { - fileBlobUrl :: !Text - ,fileStatus :: !Text - ,fileRawUrl :: !Text - ,fileAdditions :: !Int - ,fileSha :: !Text - ,fileChanges :: !Int - ,filePatch :: !(Maybe Text) - ,fileFilename :: !Text - ,fileDeletions :: !Int -} deriving (Show, Data, Typeable, Eq, Ord, Generic) - -instance NFData File where rnf = genericRnf +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" + 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" + 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 + 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" + 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 + 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" + 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" + 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 ] + toJSON (NewGitReference r s) = object [ "ref" .= r, "sha" .= s ] instance FromJSON GitReference where - parseJSON = withObject "GitReference" $ \o -> - GitReference <$> o .: "object" - <*> o .: "url" - <*> o .: "ref" + 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" + 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" + 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" + 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" + 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" + parseJSON = withObject "Branch" $ \o -> Branch + <$> o .: "name" + <*> o .: "commit" instance FromJSON BranchCommit where - parseJSON = withObject "BranchCommit" $ \o -> - BranchCommit <$> o .: "sha" <*> o .: "url" + parseJSON = withObject "BranchCommit" $ \o -> BranchCommit + <$> o .: "sha" + <*> o .: "url" diff --git a/src/GitHub/Data/Id.hs b/src/GitHub/Data/Id.hs index bda2976c..6c18c2e2 100644 --- a/src/GitHub/Data/Id.hs +++ b/src/GitHub/Data/Id.hs @@ -1,26 +1,15 @@ -{-# LANGUAGE DeriveDataTypeable #-} -{-# LANGUAGE DeriveGeneric #-} ------------------------------------------------------------------------------ --- | --- License : BSD-3-Clause --- Maintainer : Oleg Grenrus --- module GitHub.Data.Id ( Id(..), mkId, untagId, ) where -import Control.DeepSeq (NFData (..)) -import Data.Aeson.Compat (FromJSON (..), ToJSON (..)) -import Data.Binary (Binary) -import Data.Data (Data, Typeable) -import Data.Hashable (Hashable) -import GHC.Generics (Generic) +import GitHub.Internal.Prelude +import Prelude () -- | Numeric identifier. newtype Id entity = Id Int - deriving (Eq, Ord, Show, Generic, Typeable, Data) + deriving (Eq, Ord, Show, Generic, Data) -- | Smart constructor for 'Id'. mkId :: proxy entity -> Int -> Id entity diff --git a/src/GitHub/Data/Invitation.hs b/src/GitHub/Data/Invitation.hs 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 index 15a931c4..2f815c0d 100644 --- a/src/GitHub/Data/Issues.hs +++ b/src/GitHub/Data/Issues.hs @@ -1,275 +1,227 @@ -{-# LANGUAGE DeriveDataTypeable #-} -{-# LANGUAGE DeriveGeneric #-} -{-# LANGUAGE OverloadedStrings #-} ------------------------------------------------------------------------------ --- | --- License : BSD-3-Clause --- Maintainer : Oleg Grenrus --- module GitHub.Data.Issues where -import Prelude () -import Prelude.Compat - 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 Control.DeepSeq (NFData (..)) -import Control.DeepSeq.Generics (genericRnf) -import Data.Aeson.Compat (FromJSON (..), ToJSON (..), Value (..), object, - withObject, (.:), (.:?), (.=)) -import Data.Binary (Binary) -import Data.Data (Data, Typeable) -import Data.Text (Text) -import Data.Time (UTCTime) -import Data.Vector (Vector) -import GHC.Generics (Generic) - -data Issue = Issue { - issueClosedAt :: Maybe UTCTime - ,issueUpdatedAt :: UTCTime - ,issueEventsUrl :: Text - ,issueHtmlUrl :: Maybe Text - ,issueClosedBy :: Maybe SimpleUser - ,issueLabels :: (Vector IssueLabel) - ,issueNumber :: Int - ,issueAssignee :: Maybe SimpleUser - ,issueUser :: SimpleUser - ,issueTitle :: Text - ,issuePullRequest :: Maybe PullRequestReference - ,issueUrl :: Text - ,issueCreatedAt :: UTCTime - ,issueBody :: Maybe Text - ,issueState :: Text - ,issueId :: Id Issue - ,issueComments :: Int - ,issueMilestone :: Maybe Milestone -} deriving (Show, Data, Typeable, Eq, Ord, Generic) - -instance NFData Issue where rnf = genericRnf +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 -, newIssueAssignee :: Maybe Text -, newIssueMilestone :: Maybe Int -, newIssueLabels :: Maybe (Vector Text) -} deriving (Show, Data, Typeable, Eq, Ord, Generic) +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 where rnf = genericRnf +instance NFData NewIssue instance Binary NewIssue -data EditIssue = EditIssue { - editIssueTitle :: Maybe Text -, editIssueBody :: Maybe Text -, editIssueAssignee :: Maybe Text -, editIssueState :: Maybe Text -, editIssueMilestone :: Maybe Int -, editIssueLabels :: Maybe (Vector Text) -} deriving (Show, Data, Typeable, Eq, Ord, Generic) - -instance NFData EditIssue where rnf = genericRnf +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 Milestone = Milestone { - milestoneCreator :: SimpleUser - ,milestoneDueOn :: Maybe UTCTime - ,milestoneOpenIssues :: Int - ,milestoneNumber :: Int - ,milestoneClosedIssues :: Int - ,milestoneDescription :: Maybe Text - ,milestoneTitle :: Text - ,milestoneUrl :: Text - ,milestoneCreatedAt :: UTCTime - ,milestoneState :: Text -} deriving (Show, Data, Typeable, Eq, Ord, Generic) - -instance NFData Milestone where rnf = genericRnf -instance Binary Milestone - -data IssueLabel = IssueLabel { - labelColor :: Text - ,labelUrl :: Text - ,labelName :: Text -} deriving (Show, Data, Typeable, Eq, Ord, Generic) - -instance NFData IssueLabel where rnf = genericRnf -instance Binary IssueLabel - -data IssueComment = IssueComment { - issueCommentUpdatedAt :: UTCTime - ,issueCommentUser :: SimpleUser - ,issueCommentUrl :: Text - ,issueCommentHtmlUrl :: Text - ,issueCommentCreatedAt :: UTCTime - ,issueCommentBody :: Text - ,issueCommentId :: Int -} deriving (Show, Data, Typeable, Eq, Ord, Generic) - -instance NFData IssueComment where rnf = genericRnf +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 -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. - deriving (Show, Data, Typeable, Eq, Ord, Generic) - -instance NFData EventType where rnf = genericRnf +-- | 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 Event = Event { - eventActor :: !SimpleUser - ,eventType :: !EventType - ,eventCommitId :: !(Maybe Text) - ,eventUrl :: !Text - ,eventCreatedAt :: !UTCTime - ,eventId :: !Int - ,eventIssue :: !(Maybe Issue) -} deriving (Show, Data, Typeable, Eq, Ord, Generic) - -instance NFData Event where rnf = genericRnf -instance Binary Event - --- | 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 - deriving (Eq, Ord, Show, Typeable, Data, Generic) - -instance NFData IssueLimitation where rnf = genericRnf -instance Binary IssueLimitation - --- JSON instances - -instance FromJSON Event where - parseJSON = withObject "Event" $ \o -> - Event <$> o .: "actor" - <*> o .: "event" - <*> o .:? "commit_id" - <*> o .: "url" - <*> o .: "created_at" - <*> o .: "id" - <*> o .:? "issue" +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 (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 (String "unassigned") = pure ActorUnassigned - parseJSON (String "labeled") = pure Labeled - parseJSON (String "unlabeled") = pure Unlabeled - parseJSON (String "milestoned") = pure Milestoned - parseJSON (String "demilestoned") = pure Demilestoned - parseJSON (String "renamed") = pure Renamed - parseJSON (String "locked") = pure Locked - parseJSON (String "unlocked") = pure Unlocked - parseJSON (String "head_ref_deleted") = pure HeadRefDeleted - parseJSON (String "head_ref_restored") = pure HeadRefRestored - parseJSON _ = fail "Could not build an EventType" - -instance FromJSON IssueLabel where - parseJSON = withObject "IssueLabel" $ \o -> - IssueLabel <$> o .: "color" - <*> o .: "url" - <*> o .: "name" + 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" + 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 .:? "assignee" - <*> o .: "user" - <*> o .: "title" - <*> o .:? "pull_request" - <*> o .: "url" - <*> o .: "created_at" - <*> o .: "body" - <*> o .: "state" - <*> o .: "id" - <*> o .: "comments" - <*> o .:? "milestone" + 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 - [ "title" .= t - , "body" .= b - , "assignee" .= a - , "milestone" .= m - , "labels" .= ls ] + 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 - , "assignee" .= a - , "state" .= s - , "milestone" .= m - , "labels" .= ls ] - where notNull (_, Null) = False - notNull (_, _) = True - -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" + 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 index 024f7175..a9ecf8e5 100644 --- a/src/GitHub/Data/Name.hs +++ b/src/GitHub/Data/Name.hs @@ -1,27 +1,17 @@ -{-# LANGUAGE DeriveDataTypeable #-} -{-# LANGUAGE DeriveGeneric #-} ------------------------------------------------------------------------------ --- | --- License : BSD-3-Clause --- Maintainer : Oleg Grenrus --- module GitHub.Data.Name ( Name(..), mkName, untagName, ) where -import Control.DeepSeq (NFData (..)) -import Data.Aeson.Compat (FromJSON (..), ToJSON (..)) -import Data.Binary.Orphans (Binary) -import Data.Data (Data, Typeable) -import Data.Hashable (Hashable) -import Data.String (IsString (..)) -import Data.Text (Text) -import GHC.Generics (Generic) +import Prelude () +import GitHub.Internal.Prelude + +import Data.Aeson.Types + (FromJSONKey (..), ToJSONKey (..), fromJSONKeyCoerce, toJSONKeyText) newtype Name entity = N Text - deriving (Eq, Ord, Show, Generic, Typeable, Data) + deriving (Eq, Ord, Show, Generic, Data) -- | Smart constructor for 'Name' mkName :: proxy entity -> Text -> Name entity @@ -44,3 +34,11 @@ instance ToJSON (Name entity) where 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 index f7915881..74370960 100644 --- a/src/GitHub/Data/PullRequests.hs +++ b/src/GitHub/Data/PullRequests.hs @@ -1,11 +1,3 @@ -{-# LANGUAGE DeriveDataTypeable #-} -{-# LANGUAGE DeriveGeneric #-} -{-# LANGUAGE OverloadedStrings #-} ------------------------------------------------------------------------------ --- | --- License : BSD-3-Clause --- Maintainer : Oleg Grenrus --- module GitHub.Data.PullRequests ( SimplePullRequest(..), PullRequest(..), @@ -16,109 +8,99 @@ module GitHub.Data.PullRequests ( PullRequestEvent(..), PullRequestEventType(..), PullRequestReference(..), - PullRequestState(..), - PullRequestSort(..), - PullRequestSortDirection(..), - -- * Pull Request listing options - PullRequestOptions, - defaultPullRequestOptions, - pullRequestOptionsToQueryString, - setPullRequestOptionsState, - setPullRequestOptionsStateAll, - setPullRequestOptionsSort, - setPullRequestOptionsDirection, - setPullRequestOptionsHead, - setPullRequestOptionsBase, + MergeResult(..), ) where -import Prelude () -import Prelude.Compat - 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 Control.DeepSeq (NFData (..)) -import Control.DeepSeq.Generics (genericRnf) -import Data.Aeson.Compat (FromJSON (..), ToJSON (..), Value (..), object, - withObject, (.!=), (.:), (.:?), (.=)) -import Data.Aeson.Types (typeMismatch) -import Data.Binary.Orphans (Binary) -import Data.Data (Data, Typeable) -import Data.Maybe (catMaybes) -import Data.Text (Text) -import Data.Time (UTCTime) -import GHC.Generics (Generic) - -import qualified Data.Text.Encoding as TE +import qualified Data.Text as T data SimplePullRequest = SimplePullRequest - { simplePullRequestClosedAt :: !(Maybe UTCTime) - , simplePullRequestCreatedAt :: !UTCTime - , simplePullRequestUser :: !SimpleUser - , simplePullRequestPatchUrl :: !URL - , simplePullRequestState :: !PullRequestState - , simplePullRequestNumber :: !Int - , simplePullRequestHtmlUrl :: !URL - , simplePullRequestUpdatedAt :: !UTCTime - , simplePullRequestBody :: !Text - , simplePullRequestIssueUrl :: !Text - , simplePullRequestDiffUrl :: !URL - , simplePullRequestUrl :: !URL - , simplePullRequestLinks :: !PullRequestLinks - , simplePullRequestMergedAt :: !(Maybe UTCTime) - , simplePullRequestTitle :: !Text - , simplePullRequestId :: !(Id PullRequest) - } deriving (Show, Data, Typeable, Eq, Ord, Generic) - -instance NFData SimplePullRequest where rnf = genericRnf + { 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 :: !PullRequestState - , pullRequestNumber :: !Int - , pullRequestHtmlUrl :: !URL - , pullRequestUpdatedAt :: !UTCTime - , pullRequestBody :: !Text - , pullRequestIssueUrl :: !Text - , 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) - } deriving (Show, Data, Typeable, Eq, Ord, Generic) - -instance NFData PullRequest where rnf = genericRnf + { 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 PullRequestState) - } deriving (Show, Generic) + , editPullRequestState :: !(Maybe IssueState) + , editPullRequestBase :: !(Maybe Text) + , editPullRequestMaintainerCanModify + :: !(Maybe Bool) + } + deriving (Show, Generic) -instance NFData EditPullRequest where rnf = genericRnf +instance NFData EditPullRequest instance Binary EditPullRequest -data CreatePullRequest = - CreatePullRequest +data CreatePullRequest + = CreatePullRequest { createPullRequestTitle :: !Text , createPullRequestBody :: !Text , createPullRequestHead :: !Text @@ -129,9 +111,9 @@ data CreatePullRequest = , createPullRequestHead :: !Text , createPullRequestBase :: !Text } - deriving (Show, Generic) + deriving (Show, Generic) -instance NFData CreatePullRequest where rnf = genericRnf +instance NFData CreatePullRequest instance Binary CreatePullRequest data PullRequestLinks = PullRequestLinks @@ -139,9 +121,10 @@ data PullRequestLinks = PullRequestLinks , pullRequestLinksComments :: !URL , pullRequestLinksHtml :: !URL , pullRequestLinksSelf :: !URL - } deriving (Show, Data, Typeable, Eq, Ord, Generic) + } + deriving (Show, Data, Eq, Ord, Generic) -instance NFData PullRequestLinks where rnf = genericRnf +instance NFData PullRequestLinks instance Binary PullRequestLinks data PullRequestCommit = PullRequestCommit @@ -149,10 +132,11 @@ data PullRequestCommit = PullRequestCommit , pullRequestCommitRef :: !Text , pullRequestCommitSha :: !Text , pullRequestCommitUser :: !SimpleUser - , pullRequestCommitRepo :: !Repo - } deriving (Show, Data, Typeable, Eq, Ord, Generic) + , pullRequestCommitRepo :: !(Maybe Repo) + } + deriving (Show, Data, Eq, Ord, Generic) -instance NFData PullRequestCommit where rnf = genericRnf +instance NFData PullRequestCommit instance Binary PullRequestCommit data PullRequestEvent = PullRequestEvent @@ -162,9 +146,9 @@ data PullRequestEvent = PullRequestEvent , pullRequestRepository :: !Repo , pullRequestSender :: !SimpleUser } - deriving (Show, Data, Typeable, Eq, Ord, Generic) + deriving (Show, Data, Eq, Ord, Generic) -instance NFData PullRequestEvent where rnf = genericRnf +instance NFData PullRequestEvent instance Binary PullRequestEvent data PullRequestEventType @@ -176,121 +160,31 @@ data PullRequestEventType | PullRequestUnassigned | PullRequestLabeled | PullRequestUnlabeled - deriving (Show, Data, Typeable, Eq, Ord, Generic) + | PullRequestReviewRequested + | PullRequestReviewRequestRemoved + | PullRequestEdited + deriving (Show, Data, Eq, Ord, Generic) -instance NFData PullRequestEventType where rnf = genericRnf +instance NFData PullRequestEventType instance Binary PullRequestEventType data PullRequestReference = PullRequestReference - { pullRequestReferenceHtmlUrl :: !(Maybe Text) - , pullRequestReferencePatchUrl :: !(Maybe Text) - , pullRequestReferenceDiffUrl :: !(Maybe Text) + { pullRequestReferenceHtmlUrl :: !(Maybe URL) + , pullRequestReferencePatchUrl :: !(Maybe URL) + , pullRequestReferenceDiffUrl :: !(Maybe URL) } - deriving (Eq, Ord, Show, Generic, Typeable, Data) + deriving (Eq, Ord, Show, Generic, Data) -instance NFData PullRequestReference where rnf = genericRnf +instance NFData PullRequestReference instance Binary PullRequestReference -data PullRequestState - = PullRequestStateOpen - | PullRequestStateClosed - deriving (Eq, Ord, Show, Generic, Typeable, Data) - -instance NFData PullRequestState where rnf = genericRnf -instance Binary PullRequestState - -data PullRequestSort - = PullRequestSortCreated - | PulLRequestSortUpdated - | PullRequestSortPopularity - | PullRequestSortLongRunning - deriving (Eq, Ord, Show, Generic, Typeable, Data) - -instance NFData PullRequestSort where rnf = genericRnf -instance Binary PullRequestSort - -data PullRequestSortDirection - = PullRequestSortDesc - | PullRequestSortAsc - deriving (Eq, Ord, Show, Generic, Typeable, Data) - -instance NFData PullRequestSortDirection where rnf = genericRnf -instance Binary PullRequestSortDirection - --- | See . -data PullRequestOptions = PullRequestOptions - { pullRequestOptionsState :: !(Maybe PullRequestState) - , pullRequestOptionsHead :: !(Maybe Text) - , pullRequestOptionsBase :: !(Maybe Text) - , pullRequestOptionsSort :: !PullRequestSort - , pullRequestOptionsDirection :: !PullRequestSortDirection - } - -defaultPullRequestOptions :: PullRequestOptions -defaultPullRequestOptions = PullRequestOptions - (Just PullRequestStateOpen) - Nothing - Nothing - PullRequestSortCreated - PullRequestSortDesc - -setPullRequestOptionsState :: PullRequestState -> PullRequestOptions -> PullRequestOptions -setPullRequestOptionsState x opts = opts - { pullRequestOptionsState = Just x } - -setPullRequestOptionsStateAll :: PullRequestOptions -> PullRequestOptions -setPullRequestOptionsStateAll opts = opts - { pullRequestOptionsState = Nothing } - -setPullRequestOptionsSort :: PullRequestSort -> PullRequestOptions -> PullRequestOptions -setPullRequestOptionsSort x opts = opts - { pullRequestOptionsSort = x } - -setPullRequestOptionsDirection :: PullRequestSortDirection -> PullRequestOptions -> PullRequestOptions -setPullRequestOptionsDirection x opts = opts - { pullRequestOptionsDirection = x } - -setPullRequestOptionsHead :: Text -> PullRequestOptions -> PullRequestOptions -setPullRequestOptionsHead x opts = opts - { pullRequestOptionsHead = Just x } - -setPullRequestOptionsBase :: Text -> PullRequestOptions -> PullRequestOptions -setPullRequestOptionsBase x opts = opts - { pullRequestOptionsBase = Just x } - -pullRequestOptionsToQueryString :: PullRequestOptions -> QueryString -pullRequestOptionsToQueryString (PullRequestOptions state 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 state of - Nothing -> "all" - Just PullRequestStateOpen -> "open" - Just PullRequestStateClosed -> "closed" - sort' = case sort of - PullRequestSortCreated -> "created" - PulLRequestSortUpdated -> "updated" - PullRequestSortPopularity -> "popularity" - PullRequestSortLongRunning -> "long-running" - direction' = case dir of - PullRequestSortDesc -> "desc" - PullRequestSortAsc -> "asc" - head' = fmap TE.encodeUtf8 head_ - base' = fmap TE.encodeUtf8 base ------------------------------------------------------------------------------- -- JSON instances ------------------------------------------------------------------------------- instance FromJSON SimplePullRequest where - parseJSON = withObject "SimplePullRequest" $ \o -> - SimplePullRequest + parseJSON = withObject "SimplePullRequest" $ \o -> SimplePullRequest <$> o .:? "closed_at" <*> o .: "created_at" <*> o .: "user" @@ -299,7 +193,10 @@ instance FromJSON SimplePullRequest where <*> o .: "number" <*> o .: "html_url" <*> o .: "updated_at" - <*> o .:? "body" .!= "" -- TODO: no body is treated as empty + <*> o .:? "body" + <*> o .: "assignees" + <*> o .:? "requested_reviewers" .!= mempty + <*> o .:? "requested_teams" .!= mempty <*> o .: "issue_url" <*> o .: "diff_url" <*> o .: "url" @@ -308,18 +205,16 @@ instance FromJSON SimplePullRequest where <*> o .: "title" <*> o .: "id" -instance ToJSON PullRequestState where - toJSON PullRequestStateOpen = String "open" - toJSON PullRequestStateClosed = String "closed" - -instance FromJSON PullRequestState where - parseJSON (String "open") = pure PullRequestStateOpen - parseJSON (String "closed") = pure PullRequestStateClosed - parseJSON v = typeMismatch "PulLRequestState" v - instance ToJSON EditPullRequest where - toJSON (EditPullRequest t b s) = - object $ filter notNull [ "title" .= t, "body" .= b, "state" .= s ] + 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 @@ -331,8 +226,7 @@ instance ToJSON CreatePullRequest where object [ "issue" .= issueNum, "head" .= headPR, "base" .= basePR] instance FromJSON PullRequest where - parseJSON = withObject "PullRequest" $ \o -> - PullRequest + parseJSON = withObject "PullRequest" $ \o -> PullRequest <$> o .:? "closed_at" <*> o .: "created_at" <*> o .: "user" @@ -341,7 +235,10 @@ instance FromJSON PullRequest where <*> o .: "number" <*> o .: "html_url" <*> o .: "updated_at" - <*> o .: "body" + <*> o .:? "body" + <*> o .: "assignees" + <*> o .:? "requested_reviewers" .!= mempty + <*> o .:? "requested_teams" .!= mempty <*> o .: "issue_url" <*> o .: "diff_url" <*> o .: "url" @@ -360,13 +257,14 @@ instance FromJSON PullRequest where <*> 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") + 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 @@ -385,15 +283,19 @@ instance FromJSON PullRequestEvent where <*> o .: "sender" instance FromJSON PullRequestEventType where - parseJSON (String "opened") = pure PullRequestOpened - parseJSON (String "closed") = pure PullRequestClosed - parseJSON (String "synchronize") = pure PullRequestSynchronized - parseJSON (String "reopened") = pure PullRequestReopened - parseJSON (String "assigned") = pure PullRequestAssigned - parseJSON (String "unassigned") = pure PullRequestUnassigned - parseJSON (String "labeled") = pure PullRequestLabeled - parseJSON (String "unlabeled") = pure PullRequestUnlabeled - parseJSON v = typeMismatch "Could not build a PullRequestEventType" v + parseJSON = withText "PullRequestEventType" $ \t -> case T.toLower t of + "opened" -> pure PullRequestOpened + "closed" -> pure PullRequestClosed + "synchronize" -> pure PullRequestSynchronized + "reopened" -> pure PullRequestReopened + "assigned" -> pure PullRequestAssigned + "unassigned" -> pure PullRequestUnassigned + "labeled" -> pure PullRequestLabeled + "unlabeled" -> pure PullRequestUnlabeled + "review_requested" -> pure PullRequestReviewRequested + "review_request_removed" -> pure PullRequestReviewRequestRemoved + "edited" -> pure PullRequestEdited + _ -> fail $ "Unknown PullRequestEventType: " <> T.unpack t instance FromJSON PullRequestReference where parseJSON = withObject "PullRequestReference" $ \o -> PullRequestReference @@ -408,3 +310,10 @@ 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 index 91e9b4db..6dce3919 100644 --- a/src/GitHub/Data/Repos.hs +++ b/src/GitHub/Data/Repos.hs @@ -1,116 +1,159 @@ -{-# LANGUAGE CPP #-} -{-# LANGUAGE DeriveDataTypeable #-} -{-# LANGUAGE DeriveGeneric #-} -{-# LANGUAGE FlexibleInstances #-} -{-# LANGUAGE OverloadedStrings #-} -#define UNSAFE 1 ------------------------------------------------------------------------------ +{-# LANGUAGE FlexibleInstances #-} + -- | --- License : BSD-3-Clause --- Maintainer : Oleg Grenrus --- -- This module also exports -- @'FromJSON' a => 'FromJSON' ('HM.HashMap' 'Language' a)@ --- orphan-ish instance. -module GitHub.Data.Repos where +-- orphan-ish instance for @aeson < 1@ -import Prelude () -import Prelude.Compat +module GitHub.Data.Repos where import GitHub.Data.Definitions import GitHub.Data.Id (Id) import GitHub.Data.Name (Name) - ---import Control.Arrow (first) -- Data.Bifunctor would be better -import Control.DeepSeq (NFData (..)) -import Control.DeepSeq.Generics (genericRnf) -import Data.Aeson.Compat (FromJSON (..), ToJSON (..), object, withObject, - withText, (.:), (.:?), (.=)) -import Data.Binary (Binary) -import Data.Data (Data, Typeable) -import Data.Hashable (Hashable (..)) -import Data.String (IsString (..)) -import Data.Text (Text) -import Data.Time (UTCTime) -import GHC.Generics (Generic) +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) -#if UNSAFE -import Unsafe.Coerce (unsafeCoerce) -#endif - -data Repo = Repo { - repoSshUrl :: !(Maybe Text) - ,repoDescription :: !(Maybe Text) - ,repoCreatedAt :: !(Maybe UTCTime) - ,repoHtmlUrl :: !Text - ,repoSvnUrl :: !(Maybe Text) - ,repoForks :: !(Maybe Int) - ,repoHomepage :: !(Maybe Text) - ,repoFork :: !(Maybe Bool) - ,repoGitUrl :: !(Maybe Text) - ,repoPrivate :: !Bool - ,repoCloneUrl :: !(Maybe Text) - ,repoSize :: !(Maybe Int) - ,repoUpdatedAt :: !(Maybe UTCTime) - ,repoWatchers :: !(Maybe Int) - ,repoOwner :: !SimpleOwner - ,repoName :: !(Name Repo) - ,repoLanguage :: !(Maybe Language) - ,repoMasterBranch :: !(Maybe Text) - ,repoPushedAt :: !(Maybe UTCTime) -- ^ this is Nothing for new repositories - ,repoId :: !(Id Repo) - ,repoUrl :: !Text - ,repoOpenIssues :: !(Maybe Int) - ,repoHasWiki :: !(Maybe Bool) - ,repoHasIssues :: !(Maybe Bool) - ,repoHasDownloads :: !(Maybe Bool) - ,repoParent :: !(Maybe RepoRef) - ,repoSource :: !(Maybe RepoRef) - ,repoHooksUrl :: !Text - ,repoStargazersCount :: !Int -} deriving (Show, Data, Typeable, Eq, Ord, Generic) - -instance NFData Repo where rnf = genericRnf +instance NFData Repo instance Binary Repo +data CodeSearchRepo = CodeSearchRepo + { codeSearchRepoId :: !(Id Repo) + , codeSearchRepoName :: !(Name Repo) + , codeSearchRepoOwner :: !SimpleOwner + , codeSearchRepoPrivate :: !Bool + , codeSearchRepoHtmlUrl :: !URL + , codeSearchRepoDescription :: !(Maybe Text) + , codeSearchRepoFork :: !(Maybe Bool) + , codeSearchRepoUrl :: !URL + , codeSearchRepoGitUrl :: !(Maybe URL) + , codeSearchRepoSshUrl :: !(Maybe URL) + , codeSearchRepoCloneUrl :: !(Maybe URL) + , codeSearchRepoHooksUrl :: !URL + , codeSearchRepoSvnUrl :: !(Maybe URL) + , codeSearchRepoHomepage :: !(Maybe Text) + , codeSearchRepoLanguage :: !(Maybe Language) + , codeSearchRepoSize :: !(Maybe Int) + , codeSearchRepoDefaultBranch :: !(Maybe Text) + , codeSearchRepoHasIssues :: !(Maybe Bool) + , codeSearchRepoHasProjects :: !(Maybe Bool) + , codeSearchRepoHasWiki :: !(Maybe Bool) + , codeSearchRepoHasPages :: !(Maybe Bool) + , codeSearchRepoHasDownloads :: !(Maybe Bool) + , codeSearchRepoArchived :: !Bool + , codeSearchRepoDisabled :: !Bool + , codeSearchRepoPushedAt :: !(Maybe UTCTime) -- ^ this is Nothing for new repositories + , codeSearchRepoCreatedAt :: !(Maybe UTCTime) + , codeSearchRepoUpdatedAt :: !(Maybe UTCTime) + , codeSearchRepoPermissions :: !(Maybe RepoPermissions) -- ^ Repository permissions as they relate to the authenticated user. + } + deriving (Show, Data, Eq, Ord, Generic) + +instance NFData CodeSearchRepo +instance Binary CodeSearchRepo + +-- | Repository permissions, as they relate to the authenticated user. +-- +-- Returned by for example 'GitHub.Endpoints.Repos.currentUserReposR' +data RepoPermissions = RepoPermissions + { repoPermissionAdmin :: !Bool + , repoPermissionPush :: !Bool + , repoPermissionPull :: !Bool + } + deriving (Show, Data, Eq, Ord, Generic) + +instance NFData RepoPermissions +instance Binary RepoPermissions + data RepoRef = RepoRef { repoRefOwner :: !SimpleOwner , repoRefRepo :: !(Name Repo) } - deriving (Show, Data, Typeable, Eq, Ord, Generic) + deriving (Show, Data, Eq, Ord, Generic) -instance NFData RepoRef where rnf = genericRnf +instance NFData RepoRef instance Binary RepoRef -data NewRepo = NewRepo { - newRepoName :: !(Name Repo) -, newRepoDescription :: !(Maybe Text) -, newRepoHomepage :: !(Maybe Text) -, newRepoPrivate :: !(Maybe Bool) -, newRepoHasIssues :: !(Maybe Bool) -, newRepoHasWiki :: !(Maybe Bool) -, newRepoAutoInit :: !(Maybe Bool) -} deriving (Eq, Ord, Show, Data, Typeable, Generic) - -instance NFData NewRepo where rnf = genericRnf +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 - -data EditRepo = EditRepo { - editName :: !(Maybe (Name Repo)) -, editDescription :: !(Maybe Text) -, editHomepage :: !(Maybe Text) -, editPublic :: !(Maybe Bool) -, editHasIssues :: !(Maybe Bool) -, editHasWiki :: !(Maybe Bool) -, editHasDownloads :: !(Maybe Bool) -} deriving (Eq, Ord, Show, Data, Typeable, Generic) - -instance NFData EditRepo where rnf = genericRnf +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. @@ -120,19 +163,19 @@ data RepoPublicity | RepoPublicityPublic -- ^ Only public repos. | RepoPublicityPrivate -- ^ Only private repos. | RepoPublicityMember -- ^ Only repos to which the user is a member but not an owner. - deriving (Show, Eq, Ord, Enum, Bounded, Typeable, Data, Generic) + deriving (Show, Eq, Ord, Enum, Bounded, Data, Generic) -- | The value is the number of bytes of code written in that language. type Languages = HM.HashMap Language Int -- | A programming language. newtype Language = Language Text - deriving (Show, Data, Typeable, Eq, Ord, Generic) + deriving (Show, Data, Eq, Ord, Generic) getLanguage :: Language -> Text getLanguage (Language l) = l -instance NFData Language where rnf = genericRnf +instance NFData Language instance Binary Language instance Hashable Language where hashWithSalt salt (Language l) = hashWithSalt salt l @@ -140,112 +183,191 @@ 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 !Text !(Name User) !Text !(Id User) !Text - -- | An unknown Github user with their number of contributions and recorded name. - | AnonymousContributor !Int !Text - deriving (Show, Data, Typeable, Eq, Ord, Generic) - -instance NFData Contributor where rnf = genericRnf + -- | 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 OwnerUser + Just $ SimpleUser uid name avatarUrl url + +-- | The permission of a collaborator on a repository. +-- See +data CollaboratorPermission + = CollaboratorPermissionAdmin + | CollaboratorPermissionWrite + | CollaboratorPermissionRead + | CollaboratorPermissionNone + deriving (Show, Data, Enum, Bounded, Eq, Ord, Generic) + +instance NFData CollaboratorPermission +instance Binary CollaboratorPermission + +-- | A collaborator and its permission on a repository. +-- See +data CollaboratorWithPermission + = CollaboratorWithPermission SimpleUser CollaboratorPermission + deriving (Show, Data, Eq, Ord, Generic) + +instance NFData CollaboratorWithPermission +instance Binary CollaboratorWithPermission -- JSON instances instance FromJSON Repo where - parseJSON = withObject "Repo" $ \o -> - Repo <$> o .:? "ssh_url" - <*> o .: "description" - <*> o .:? "created_at" - <*> 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" - <*> o .: "hooks_url" - <*> o .: "stargazers_count" + 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 - , newRepoHasWiki = hasWiki - , newRepoAutoInit = autoInit + toJSON (NewRepo { newRepoName = name + , newRepoDescription = description + , newRepoHomepage = homepage + , newRepoPrivate = private + , newRepoHasIssues = hasIssues + , newRepoHasProjects = hasProjects + , newRepoHasWiki = hasWiki + , newRepoAutoInit = autoInit + , newRepoGitignoreTemplate = gitignoreTemplate + , newRepoLicenseTemplate = licenseTemplate + , newRepoAllowSquashMerge = allowSquashMerge + , newRepoAllowMergeCommit = allowMergeCommit + , newRepoAllowRebaseMerge = allowRebaseMerge }) = object [ "name" .= name , "description" .= description , "homepage" .= homepage , "private" .= private , "has_issues" .= hasIssues + , "has_projects" .= hasProjects , "has_wiki" .= hasWiki , "auto_init" .= autoInit + , "gitignore_template" .= gitignoreTemplate + , "license_template" .= licenseTemplate + , "allow_squash_merge" .= allowSquashMerge + , "allow_merge_commit" .= allowMergeCommit + , "allow_rebase_merge" .= allowRebaseMerge ] instance ToJSON EditRepo where - toJSON (EditRepo { editName = name - , editDescription = description - , editHomepage = homepage - , editPublic = public - , editHasIssues = hasIssues - , editHasWiki = hasWiki - , editHasDownloads = hasDownloads + toJSON (EditRepo { editName = name + , editDescription = description + , editHomepage = homepage + , editPrivate = private + , editHasIssues = hasIssues + , editHasProjects = hasProjects + , editHasWiki = hasWiki + , editDefaultBranch = defaultBranch + , editAllowSquashMerge = allowSquashMerge + , editAllowMergeCommit = allowMergeCommit + , editAllowRebaseMerge = allowRebaseMerge + , editArchived = archived }) = object - [ "name" .= name - , "description" .= description - , "homepage" .= homepage - , "public" .= public - , "has_issues" .= hasIssues - , "has_wiki" .= hasWiki - , "has_downloads" .= hasDownloads + [ "name" .= name + , "description" .= description + , "homepage" .= homepage + , "private" .= private + , "has_issues" .= hasIssues + , "has_projects" .= hasProjects + , "has_wiki" .= hasWiki + , "default_branch" .= defaultBranch + , "allow_squash_merge" .= allowSquashMerge + , "allow_merge_commit" .= allowMergeCommit + , "allow_rebase_merge" .= allowRebaseMerge + , "archived" .= archived ] +instance FromJSON RepoPermissions where + parseJSON = withObject "RepoPermissions" $ \o -> RepoPermissions + <$> o .: "admin" + <*> o .: "push" + <*> o .: "pull" + instance FromJSON RepoRef where - parseJSON = withObject "RepoRef" $ \o -> - RepoRef <$> o .: "owner" - <*> o .: "name" + parseJSON = withObject "RepoRef" $ \o -> RepoRef + <$> o .: "owner" + <*> o .: "name" instance FromJSON Contributor where parseJSON = withObject "Contributor" $ \o -> do t <- o .: "type" - case t of - _ | t == ("Anonymous" :: Text) -> - AnonymousContributor - <$> o .: "contributions" - <*> o .: "name" - _ | otherwise -> - KnownContributor - <$> o .: "contributions" - <*> o .: "avatar_url" - <*> o .: "login" - <*> o .: "url" - <*> o .: "id" - <*> o .: "gravatar_id" + 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) @@ -253,14 +375,34 @@ instance FromJSON Language where instance ToJSON Language where toJSON = toJSON . getLanguage -instance FromJSON a => FromJSON (HM.HashMap Language a) where - parseJSON = fmap mapKeyLanguage . parseJSON - where - mapKeyLanguage :: HM.HashMap Text a -> HM.HashMap Language a -#ifdef UNSAFE - mapKeyLanguage = unsafeCoerce -#else - mapKeyLanguage = mapKey Language - mapKey :: (Eq k2, Hashable k2) => (k1 -> k2) -> HM.HashMap k1 a -> HM.HashMap k2 a - mapKey f = HM.fromList . map (first f) . HM.toList -#endif +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 index 5ee1c901..07ac89dd 100644 --- a/src/GitHub/Data/Request.hs +++ b/src/GitHub/Data/Request.hs @@ -1,167 +1,225 @@ -{-# LANGUAGE CPP #-} -{-# LANGUAGE DataKinds #-} -{-# LANGUAGE DeriveDataTypeable #-} -{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE KindSignatures #-} -{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE StandaloneDeriving #-} ------------------------------------------------------------------------------ --- | --- License : BSD-3-Clause --- Maintainer : Oleg Grenrus --- + module GitHub.Data.Request ( - Request(..), + -- * Request + Request, + GenRequest (..), + -- * Smart constructors + query, pagedQuery, command, + -- * Auxiliary types + RW(..), CommandMethod(..), toMethod, - StatusMap(..), - MergeResult(..), + FetchCount(..), + PageParams(..), + PageLinks(..), + MediaType (..), Paths, IsPathPart(..), QueryString, Count, ) where -import Data.Aeson.Compat (FromJSON) -import Data.Hashable (Hashable (..)) -import Data.Typeable (Typeable) -import Data.Vector (Vector) -import GHC.Generics (Generic) +import GitHub.Data.Definitions (Count, IssueNumber, QueryString, unIssueNumber) +import GitHub.Data.Id (Id, untagId) +import GitHub.Data.Name (Name, untagName) +import GitHub.Internal.Prelude import qualified Data.ByteString.Lazy as LBS import qualified Data.Text as T -import qualified Network.HTTP.Types as Types import qualified Network.HTTP.Types.Method as Method - -import GitHub.Data.Definitions (Count, QueryString) -import GitHub.Data.Id (Id, untagId) -import GitHub.Data.Name (Name, untagName) +import Network.URI (URI) ------------------------------------------------------------------------------ --- Auxillary types +-- Path parts ------------------------------------------------------------------------------ -type Paths = [String] +type Paths = [Text] class IsPathPart a where - toPathPart :: a -> String + toPathPart :: a -> Text instance IsPathPart (Name a) where - toPathPart = T.unpack . untagName + toPathPart = untagName instance IsPathPart (Id a) where - toPathPart = show . untagId + toPathPart = T.pack . show . untagId + +instance IsPathPart IssueNumber where + toPathPart = T.pack . show . unIssueNumber + +------------------------------------------------------------------------------- +-- Command Method +------------------------------------------------------------------------------- -- | Http method of requests with body. -data CommandMethod a where - Post :: CommandMethod a - Patch :: CommandMethod a - Put :: CommandMethod a - Delete :: CommandMethod () - deriving (Typeable) - -deriving instance Eq (CommandMethod a) - -instance Show (CommandMethod a) where - showsPrec _ Post = showString "Post" - showsPrec _ Patch = showString "Patch" - showsPrec _ Put = showString "Put" - showsPrec _ Delete = showString "Delete" - -instance Hashable (CommandMethod a) where - hashWithSalt salt Post = hashWithSalt salt (0 :: Int) - hashWithSalt salt Patch = hashWithSalt salt (1 :: Int) - hashWithSalt salt Put = hashWithSalt salt (2 :: Int) - hashWithSalt salt Delete = hashWithSalt salt (3 :: Int) - -toMethod :: CommandMethod a -> Method.Method +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 --- | Result of merge operation -data MergeResult = MergeSuccessful - | MergeCannotPerform - | MergeConflict - deriving (Eq, Ord, Read, Show, Enum, Bounded, Generic, Typeable) - -instance Hashable MergeResult - --- | Status code transform -data StatusMap a where - StatusOnlyOk :: StatusMap Bool - StatusMerge :: StatusMap MergeResult - deriving (Typeable) - -deriving instance Eq (StatusMap a) - -instance Show (StatusMap a) where - showsPrec _ StatusOnlyOk = showString "StatusOnlyOK" - showsPrec _ StatusMerge = showString "StatusMerge" - -instance Hashable (StatusMap a) where - hashWithSalt salt StatusOnlyOk = hashWithSalt salt (0 :: Int) - hashWithSalt salt StatusMerge = hashWithSalt salt (1 :: Int) +------------------------------------------------------------------------------- +-- 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) ------------------------------------------------------------------------------ --- Github request +-- RW ------------------------------------------------------------------------------ +-- | Type used as with @DataKinds@ to tag whether requests need authentication +-- or aren't read-only. +data RW + = RO -- ^ /Read-only/, doesn't necessarily requires authentication + | RA -- ^ /Read 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. -- --- * @k@ describes whether authentication is required. It's required for non-@GET@ requests. +-- * @rw@ describes whether authentication is required. It's required for non-@GET@ requests. +-- * @mt@ describes the media type, i.e. how the response should be interpreted. -- * @a@ is the result type -- -- /Note:/ 'Request' is not 'Functor' on purpose. -data Request (k :: Bool) a where - Query :: FromJSON a => Paths -> QueryString -> Request k a - PagedQuery :: FromJSON (Vector a) => Paths -> QueryString -> Maybe Count -> Request k (Vector a) - Command :: FromJSON a => CommandMethod a -> Paths -> LBS.ByteString -> Request 'True a - StatusQuery :: StatusMap a -> Request k () -> Request k a - HeaderQuery :: Types.RequestHeaders -> Request k a -> Request k a - deriving (Typeable) - -deriving instance Eq (Request k a) - -instance Show (Request k a) where - showsPrec d r = - case r of - Query ps qs -> showParen (d > appPrec) $ - showString "Query " - . showsPrec (appPrec + 1) ps - . showString " " - . showsPrec (appPrec + 1) qs - PagedQuery ps qs l -> showParen (d > appPrec) $ - showString "PagedQuery " - . showsPrec (appPrec + 1) ps - . showString " " - . showsPrec (appPrec + 1) qs - . showString " " - . showsPrec (appPrec + 1) l - Command m ps body -> showParen (d > appPrec) $ - showString "Command " - . showsPrec (appPrec + 1) m - . showString " " - . showsPrec (appPrec + 1) ps - . showString " " - . showsPrec (appPrec + 1) body - StatusQuery m req -> showParen (d > appPrec) $ - showString "Status " - . showsPrec (appPrec + 1) m - . showString " " - . showsPrec (appPrec + 1) req - HeaderQuery m req -> showParen (d > appPrec) $ - showString "Header " - . showsPrec (appPrec + 1) m - . showString " " - . showsPrec (appPrec + 1) req - - where appPrec = 10 :: Int - -instance Hashable (Request k a) where +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 @@ -176,11 +234,5 @@ instance Hashable (Request k a) where `hashWithSalt` m `hashWithSalt` ps `hashWithSalt` body - hashWithSalt salt (StatusQuery sm req) = - salt `hashWithSalt` (3 :: Int) - `hashWithSalt` sm - `hashWithSalt` req - hashWithSalt salt (HeaderQuery h req) = - salt `hashWithSalt` (4 :: Int) - `hashWithSalt` h - `hashWithSalt` req + +-- 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 index c2c46198..a84710d2 100644 --- a/src/GitHub/Data/Search.hs +++ b/src/GitHub/Data/Search.hs @@ -1,61 +1,54 @@ -{-# LANGUAGE DeriveDataTypeable #-} -{-# LANGUAGE DeriveGeneric #-} -{-# LANGUAGE OverloadedStrings #-} ------------------------------------------------------------------------------ --- | --- License : BSD-3-Clause --- Maintainer : Oleg Grenrus --- module GitHub.Data.Search where -import Prelude () -import Prelude.Compat +import GitHub.Data.Repos (CodeSearchRepo) +import GitHub.Data.URL (URL) +import GitHub.Internal.Prelude +import Prelude () -import GitHub.Data.Repos (Repo) +import qualified Data.Vector as V -import Control.DeepSeq (NFData (..)) -import Control.DeepSeq.Generics (genericRnf) -import Data.Aeson.Compat (FromJSON (..), withObject, (.!=), (.:), (.:?)) -import Data.Binary (Binary) -import Data.Data (Data, Typeable) -import Data.Text (Text) -import Data.Vector (Vector) -import GHC.Generics (Generic) +data SearchResult' entities = SearchResult + { searchResultTotalCount :: !Int + , searchResultResults :: !entities + } + deriving (Show, Data, Eq, Ord, Generic) -import qualified Data.Vector as V +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) -data SearchResult entity = SearchResult { - searchResultTotalCount :: !Int - ,searchResultResults :: !(Vector entity) -} deriving (Show, Data, Typeable, Eq, Ord, Generic) - -instance NFData entity => NFData (SearchResult entity) where rnf = genericRnf -instance Binary entity => Binary (SearchResult entity) - -instance FromJSON entity => FromJSON (SearchResult entity) where - parseJSON = withObject "SearchResult" $ \o -> - SearchResult <$> o .: "total_count" - <*> o .:? "items" .!= V.empty - -data Code = Code { - codeName :: !Text - ,codePath :: !Text - ,codeSha :: !Text - ,codeUrl :: !Text - ,codeGitUrl :: !Text - ,codeHtmlUrl :: !Text - ,codeRepo :: !Repo -} deriving (Show, Data, Typeable, Eq, Ord, Generic) - -instance NFData Code where rnf = genericRnf +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" + 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 index 694288a9..01b1429c 100644 --- a/src/GitHub/Data/Teams.hs +++ b/src/GitHub/Data/Teams.hs @@ -1,252 +1,254 @@ -{-# LANGUAGE DeriveDataTypeable #-} -{-# LANGUAGE DeriveGeneric #-} -{-# LANGUAGE OverloadedStrings #-} ------------------------------------------------------------------------------ --- | --- License : BSD-3-Clause --- Maintainer : Oleg Grenrus --- -module GitHub.Data.Teams where +{-# LANGUAGE NoImplicitPrelude #-} -import Prelude () -import Prelude.Compat +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 -import Control.DeepSeq (NFData (..)) -import Control.DeepSeq.Generics (genericRnf) -import Data.Aeson.Compat (FromJSON (..), ToJSON (..), Value (..), object, - withObject, (.!=), (.:), (.:?), (.=)) -import Data.Binary (Binary) -import Data.Data (Data, Typeable) -import Data.Text (Text) -import Data.Vector (Vector) -import GHC.Generics (Generic) - -import GitHub.Data.Id (Id) -import GitHub.Data.Name (Name) -import GitHub.Data.Repos (Repo) - -data Privacy = - PrivacyClosed - | PrivacySecret - deriving (Show, Data, Enum, Bounded, Typeable, Eq, Ord, Generic) - -instance NFData Privacy where rnf = genericRnf +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, Typeable, Eq, Ord, Generic) +data Permission + = PermissionPull + | PermissionPush + | PermissionAdmin + deriving (Show, Data, Enum, Bounded, Eq, Ord, Generic) -instance NFData Permission where rnf = genericRnf +instance NFData Permission instance Binary Permission -data SimpleTeam = SimpleTeam { - simpleTeamId :: !(Id Team) - ,simpleTeamUrl :: !Text - ,simpleTeamName :: !Text -- TODO (0.15.0): unify this and 'simpleTeamSlug' as in 'Team'. - ,simpleTeamSlug :: !(Name Team) - ,simpleTeamDescription :: !(Maybe Text) - ,simpleTeamPrivacy :: !(Maybe Privacy) - ,simpleTeamPermission :: !Permission - ,simpleTeamMembersUrl :: !Text - ,simpleTeamRepositoriesUrl :: !Text -} deriving (Show, Data, Typeable, Eq, Ord, Generic) - -instance NFData SimpleTeam where rnf = genericRnf +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 :: !Text - ,teamName :: !(Name Team) - ,teamSlug :: !Text - ,teamDescription :: !(Maybe Text) - ,teamPrivacy :: !(Maybe Privacy) - ,teamPermission :: !Permission - ,teamMembersUrl :: !Text - ,teamRepositoriesUrl :: !Text - ,teamMembersCount :: !Int - ,teamReposCount :: !Int - ,teamOrganization :: !SimpleOrganization -} deriving (Show, Data, Typeable, Eq, Ord, Generic) - -instance NFData Team where rnf = genericRnf +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, Typeable, Eq, Ord, Generic) +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 where rnf = genericRnf +instance NFData CreateTeam instance Binary CreateTeam -data EditTeam = EditTeam { - editTeamName :: !(Name Team) - ,editTeamDescription :: !(Maybe Text) - {-,editTeamPrivacy :: Privacy-} - ,editTeamPermission :: !Permission -} deriving (Show, Data, Typeable, Eq, Ord, Generic) +data EditTeam = EditTeam + { editTeamName :: !(Name Team) + , editTeamDescription :: !(Maybe Text) + , editTeamPrivacy :: !(Maybe Privacy) + , editTeamPermission :: !(Maybe Permission) + } + deriving (Show, Data, Eq, Ord, Generic) -instance NFData EditTeam where rnf = genericRnf +instance NFData EditTeam instance Binary EditTeam -data Role = - RoleMaintainer - | RoleMember - deriving (Show, Data, Typeable, Eq, Ord, Generic) +data Role + = RoleMaintainer + | RoleMember + deriving (Show, Data, Eq, Ord, Generic) instance NFData Role instance Binary Role -data ReqState = - StatePending - | StateActive - deriving (Show, Data, Typeable, Eq, Ord, Generic) +data ReqState + = StatePending + | StateActive + deriving (Show, Data, Eq, Ord, Generic) -instance NFData ReqState where rnf = genericRnf +instance NFData ReqState instance Binary ReqState -data TeamMembership = TeamMembership { - teamMembershipUrl :: !Text, - teamMembershipRole :: !Role, - teamMembershipReqState :: !ReqState -} deriving (Show, Data, Typeable, Eq, Ord, Generic) +data TeamMembership = TeamMembership + { teamMembershipUrl :: !URL + , teamMembershipRole :: !Role + , teamMembershipReqState :: !ReqState + } + deriving (Show, Data, Eq, Ord, Generic) -instance NFData TeamMembership where rnf = genericRnf +instance NFData TeamMembership instance Binary TeamMembership data CreateTeamMembership = CreateTeamMembership { createTeamMembershipRole :: !Role -} deriving (Show, Data, Typeable, Eq, Ord, Generic) +} deriving (Show, Data, Eq, Ord, Generic) -instance NFData CreateTeamMembership where rnf = genericRnf +instance NFData CreateTeamMembership instance Binary CreateTeamMembership -- JSON Instances instance FromJSON SimpleTeam where - parseJSON = withObject "SimpleTeam" $ \o -> - SimpleTeam <$> o .: "id" - <*> o .: "url" - <*> o .: "name" - <*> o .: "slug" - <*> o .:?"description" .!= Nothing - <*> o .:?"privacy" .!= Nothing - <*> o .: "permission" - <*> o .: "members_url" - <*> o .: "repositories_url" + 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" .!= Nothing - <*> o .: "permission" - <*> o .: "members_url" - <*> o .: "repositories_url" - <*> o .: "members_count" - <*> o .: "repos_count" - <*> o .: "organization" + 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-} permissions) = - object [ "name" .= name - , "description" .= desc - , "repo_names" .= repo_names - {-, "privacy" .= privacy-} - , "permissions" .= permissions ] + toJSON (CreateTeam name desc repo_names privacy permission) = + object $ filter notNull + [ "name" .= name + , "description" .= desc + , "repo_names" .= repo_names + , "privacy" .= privacy + , "permission" .= permission + ] + where + notNull (_, Null) = False + notNull (_, _) = True instance ToJSON EditTeam where - toJSON (EditTeam name desc {-privacy-} permissions) = - object [ "name" .= name - , "description" .= desc - {-, "privacy" .= privacy-} - , "permissions" .= permissions ] + toJSON (EditTeam name desc privacy permission) = + object $ filter notNull + [ "name" .= name + , "description" .= desc + , "privacy" .= privacy + , "permission" .= permission + ] + where + notNull (_, Null) = False + notNull (_, _) = True instance FromJSON TeamMembership where - parseJSON = withObject "TeamMembership" $ \o -> - TeamMembership <$> o .: "url" - <*> o .: "role" - <*> o .: "state" + parseJSON = withObject "TeamMembership" $ \o -> TeamMembership + <$> o .: "url" + <*> o .: "role" + <*> o .: "state" instance FromJSON CreateTeamMembership where - parseJSON = withObject "CreateTeamMembership" $ \o -> - CreateTeamMembership <$> o .: "role" + parseJSON = withObject "CreateTeamMembership" $ \o -> CreateTeamMembership + <$> o .: "role" instance ToJSON CreateTeamMembership where - toJSON (CreateTeamMembership { createTeamMembershipRole = role }) = - object [ "role" .= role ] + 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 (String attr) = - case attr of - "maintainer" -> return RoleMaintainer - "member" -> return RoleMember - _ -> fail "Unknown Role" - parseJSON _ = fail "Could not build Role" + 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 ToJSON Permission where - toJSON attr = - String $ - case attr of - PermissionPull -> "pull" - PermissionPush -> "push" - PermissionAdmin -> "admin" + toJSON RoleMaintainer = String "maintainer" + toJSON RoleMember = String "member" instance FromJSON Permission where - parseJSON (String attr) = - case attr of - "pull" -> return PermissionPull - "push" -> return PermissionPush - "admin" -> return PermissionAdmin - _ -> fail "Unknown Permission Attribute" - parseJSON _ = fail "Could not build Permission" + 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 (String attr) = - case attr of - "secret" -> return PrivacySecret - "closed" -> return PrivacyClosed - _ -> fail "Unknown Privacy Attribute" - parseJSON _ = fail "Could not build Privacy" + 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 attr = - String $ - case attr of - PrivacySecret -> "secret" - PrivacyClosed -> "closed" + toJSON PrivacySecret = String "secret" + toJSON PrivacyClosed = String "closed" instance FromJSON ReqState where - parseJSON (String attr) = - case attr of - "active" -> return StateActive - "pending" -> return StatePending - _ -> fail "Unknown ReqState" - parseJSON _ = fail "Could not build ReqState" + 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" + toJSON StateActive = String "active" + toJSON StatePending = String "pending" -- | Filters members returned by their role in the team. data TeamMemberRole = TeamMemberRoleAll -- ^ all members of the team. | TeamMemberRoleMaintainer -- ^ team maintainers | TeamMemberRoleMember -- ^ normal members of the team. - deriving (Show, Eq, Ord, Enum, Bounded, Typeable, Data, Generic) + deriving (Show, Eq, Ord, Enum, Bounded, Data, Generic) diff --git a/src/GitHub/Data/URL.hs b/src/GitHub/Data/URL.hs index 9ab236df..69ddde70 100644 --- a/src/GitHub/Data/URL.hs +++ b/src/GitHub/Data/URL.hs @@ -1,36 +1,21 @@ -{-# LANGUAGE DeriveDataTypeable #-} -{-# LANGUAGE DeriveGeneric #-} ------------------------------------------------------------------------------ --- | --- License : BSD-3-Clause --- Maintainer : Oleg Grenrus --- module GitHub.Data.URL ( URL(..), getUrl, ) where -import Prelude () -import Prelude.Compat - -import Control.DeepSeq (NFData (..)) -import Control.DeepSeq.Generics (genericRnf) -import Data.Aeson.Compat (FromJSON (..), ToJSON (..), withText) -import Data.Binary.Orphans (Binary) -import Data.Data (Data, Typeable) -import Data.Text (Text) -import GHC.Generics (Generic) +import GitHub.Internal.Prelude +import Prelude () -- | Data representing URLs in responses. -- -- /N.B./ syntactical validity is not verified. newtype URL = URL Text - deriving (Eq, Ord, Show, Generic, Typeable, Data) + deriving (Eq, Ord, Show, Generic, Data) getUrl :: URL -> Text getUrl (URL url) = url -instance NFData URL where rnf = genericRnf +instance NFData URL instance Binary URL instance ToJSON URL where diff --git a/src/GitHub/Data/Webhooks.hs b/src/GitHub/Data/Webhooks.hs index b52b867d..7d2bac40 100644 --- a/src/GitHub/Data/Webhooks.hs +++ b/src/GitHub/Data/Webhooks.hs @@ -1,177 +1,280 @@ -{-# LANGUAGE DeriveDataTypeable #-} -{-# LANGUAGE DeriveGeneric #-} -{-# LANGUAGE OverloadedStrings #-} ------------------------------------------------------------------------------ --- | --- License : BSD-3-Clause --- Maintainer : Oleg Grenrus --- module GitHub.Data.Webhooks where -import Prelude () -import Prelude.Compat - -import GitHub.Data.Id (Id) - -import Control.DeepSeq (NFData (..)) -import Control.DeepSeq.Generics (genericRnf) -import Data.Aeson.Compat (FromJSON (..), ToJSON (..), Value (..), object, - withObject, (.:), (.=)) -import Data.Binary.Orphans (Binary) -import Data.Data (Data, Typeable) -import Data.Text (Text) -import Data.Time (UTCTime) -import Data.Vector (Vector) -import GHC.Generics (Generic) +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 :: !Text - ,repoWebhookTestUrl :: !Text - ,repoWebhookId :: !(Id RepoWebhook) - ,repoWebhookName :: !Text - ,repoWebhookActive :: !Bool - ,repoWebhookEvents :: !(Vector RepoWebhookEvent) - ,repoWebhookConfig :: !(M.Map Text Text) - ,repoWebhookLastResponse :: !RepoWebhookResponse - ,repoWebhookUpdatedAt :: !UTCTime - ,repoWebhookCreatedAt :: !UTCTime -} deriving (Show, Data, Typeable, Eq, Ord, Generic) - -instance NFData RepoWebhook where rnf = genericRnf +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 -data RepoWebhookEvent = - WebhookWildcardEvent - | WebhookCommitCommentEvent - | WebhookCreateEvent - | WebhookDeleteEvent - | WebhookDeploymentEvent - | WebhookDeploymentStatusEvent - | WebhookForkEvent - | WebhookGollumEvent - | WebhookIssueCommentEvent - | WebhookIssuesEvent - | WebhookMemberEvent - | WebhookPageBuildEvent - | WebhookPublicEvent - | WebhookPullRequestReviewCommentEvent - | WebhookPullRequestEvent - | WebhookPushEvent - | WebhookReleaseEvent - | WebhookStatusEvent - | WebhookTeamAddEvent - | WebhookWatchEvent - deriving (Show, Data, Typeable, Eq, Ord, Generic) - -instance NFData RepoWebhookEvent where rnf = genericRnf +-- | 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 :: !Text - ,repoWebhookResponseMessage :: !(Maybe Text) -} deriving (Show, Data, Typeable, Eq, Ord, Generic) +data RepoWebhookResponse = RepoWebhookResponse + { repoWebhookResponseCode :: !(Maybe Int) + , repoWebhookResponseStatus :: !(Maybe Text) + , repoWebhookResponseMessage :: !(Maybe Text) + } + deriving (Show, Data, Eq, Ord, Generic) -instance NFData RepoWebhookResponse where rnf = genericRnf +instance NFData RepoWebhookResponse instance Binary RepoWebhookResponse -data PingEvent = PingEvent { - pingEventZen :: !Text - ,pingEventHook :: !RepoWebhook - ,pingEventHookId :: !(Id RepoWebhook) -} deriving (Show, Data, Typeable, Eq, Ord, Generic) +data PingEvent = PingEvent + { pingEventZen :: !Text + , pingEventHook :: !RepoWebhook + , pingEventHookId :: !(Id RepoWebhook) + } + deriving (Show, Data, Eq, Ord, Generic) -instance NFData PingEvent where rnf = genericRnf +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, Typeable, Data, Generic) +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 where rnf = genericRnf +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, Typeable, Data, Generic) +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 where rnf = genericRnf +instance NFData EditRepoWebhook instance Binary EditRepoWebhook -- JSON instances instance FromJSON RepoWebhookEvent where - parseJSON (String "*") = pure WebhookWildcardEvent - parseJSON (String "commit_comment") = pure WebhookCommitCommentEvent - parseJSON (String "create") = pure WebhookCreateEvent - parseJSON (String "delete") = pure WebhookDeleteEvent - parseJSON (String "deployment") = pure WebhookDeploymentEvent - parseJSON (String "deployment_status") = pure WebhookDeploymentStatusEvent - parseJSON (String "fork") = pure WebhookForkEvent - parseJSON (String "gollum") = pure WebhookGollumEvent - parseJSON (String "issue_comment") = pure WebhookIssueCommentEvent - parseJSON (String "issues") = pure WebhookIssuesEvent - parseJSON (String "member") = pure WebhookMemberEvent - parseJSON (String "page_build") = pure WebhookPageBuildEvent - parseJSON (String "public") = pure WebhookPublicEvent - parseJSON (String "pull_request_review_comment") = pure WebhookPullRequestReviewCommentEvent - parseJSON (String "pull_request") = pure WebhookPullRequestEvent - parseJSON (String "push") = pure WebhookPushEvent - parseJSON (String "release") = pure WebhookReleaseEvent - parseJSON (String "status") = pure WebhookStatusEvent - parseJSON (String "team_add") = pure WebhookTeamAddEvent - parseJSON (String "watch") = pure WebhookWatchEvent - parseJSON _ = fail "Could not build a Webhook event" + parseJSON = withText "RepoWebhookEvent" $ \t -> case T.toLower t of + "*" -> pure WebhookWildcardEvent + "check_run" -> pure WebhookCheckRunEvent + "check_suite" -> pure WebhookCheckSuiteEvent + "code_scanning_alert" -> pure WebhookCodeScanningAlert + "commit_comment" -> pure WebhookCommitCommentEvent + "content_reference" -> pure WebhookContentReferenceEvent + "create" -> pure WebhookCreateEvent + "delete" -> pure WebhookDeleteEvent + "deploy_key" -> pure WebhookDeployKeyEvent + "deployment" -> pure WebhookDeploymentEvent + "deployment_status" -> pure WebhookDeploymentStatusEvent + "discussion" -> pure WebhookDiscussion + "discussion_comment" -> pure WebhookDiscussionComment + "download" -> pure WebhookDownloadEvent + "follow" -> pure WebhookFollowEvent + "fork" -> pure WebhookForkEvent + "gist" -> pure WebhookGistEvent + "github_app_authorization" -> pure WebhookGitHubAppAuthorizationEvent + "gollum" -> pure WebhookGollumEvent + "installation" -> pure WebhookInstallationEvent + "installation_repositories" -> pure WebhookInstallationRepositoriesEvent + "issue_comment" -> pure WebhookIssueCommentEvent + "issues" -> pure WebhookIssuesEvent + "label" -> pure WebhookLabelEvent + "marketplace_purchase" -> pure WebhookMarketplacePurchaseEvent + "member" -> pure WebhookMemberEvent + "membership" -> pure WebhookMembershipEvent + "meta" -> pure WebhookMetaEvent + "milestone" -> pure WebhookMilestoneEvent + "org_block" -> pure WebhookOrgBlockEvent + "organization" -> pure WebhookOrganizationEvent + "package" -> pure WebhookPackage + "page_build" -> pure WebhookPageBuildEvent + "ping" -> pure WebhookPingEvent + "project" -> pure WebhookProjectEvent + "project_card" -> pure WebhookProjectCardEvent + "project_column" -> pure WebhookProjectColumnEvent + "public" -> pure WebhookPublicEvent + "pull_request" -> pure WebhookPullRequestEvent + "pull_request_review" -> pure WebhookPullRequestReviewEvent + "pull_request_review_comment" -> pure WebhookPullRequestReviewCommentEvent + "push" -> pure WebhookPushEvent + "registry_package" -> pure WebhookRegistryPackageEvent + "release" -> pure WebhookReleaseEvent + "repository" -> pure WebhookRepositoryEvent + "repository_dispatch" -> pure WebhookRepositoryDispatch + "repository_import" -> pure WebhookRepositoryImportEvent + "repository_vulnerability_alert" -> pure WebhookRepositoryVulnerabilityAlertEvent + "secret_scanning_alert" -> pure WebhookSecretScanningAlert + "security_advisory" -> pure WebhookSecurityAdvisoryEvent + "sponsorship" -> pure WebhookSponsorship + "star" -> pure WebhookStarEvent + "status" -> pure WebhookStatusEvent + "team" -> pure WebhookTeamEvent + "team_add" -> pure WebhookTeamAddEvent + "watch" -> pure WebhookWatchEvent + "workflow_dispatch" -> pure WebhookWorkflowDispatch + "workflow_run" -> pure WebhookWorkflowRun + _ -> fail $ "Unknown RepoWebhookEvent: " <> T.unpack t instance ToJSON RepoWebhookEvent where - toJSON (WebhookWildcardEvent) = String "*" - toJSON (WebhookCommitCommentEvent) = String "commit_comment" - toJSON (WebhookCreateEvent) = String "create" - toJSON (WebhookDeleteEvent) = String "delete" - toJSON (WebhookDeploymentEvent) = String "deployment" - toJSON (WebhookDeploymentStatusEvent) = String "deployment_status" - toJSON (WebhookForkEvent) = String "fork" - toJSON (WebhookGollumEvent) = String "gollum" - toJSON (WebhookIssueCommentEvent) = String "issue_comment" - toJSON (WebhookIssuesEvent) = String "issues" - toJSON (WebhookMemberEvent) = String "member" - toJSON (WebhookPageBuildEvent) = String "page_build" - toJSON (WebhookPublicEvent) = String "public" - toJSON (WebhookPullRequestReviewCommentEvent) = String "pull_request_review_comment" - toJSON (WebhookPullRequestEvent) = String "pull_request" - toJSON (WebhookPushEvent) = String "push" - toJSON (WebhookReleaseEvent) = String "release" - toJSON (WebhookStatusEvent) = String "status" - toJSON (WebhookTeamAddEvent) = String "team_add" - toJSON (WebhookWatchEvent) = String "watch" + toJSON WebhookWildcardEvent = String "*" + toJSON WebhookCheckRunEvent = String "check_run" + toJSON WebhookCheckSuiteEvent = String "check_suite" + toJSON WebhookCodeScanningAlert = String "code_scanning_alert" + toJSON WebhookCommitCommentEvent = String "commit_comment" + toJSON WebhookContentReferenceEvent = String "content_reference" + toJSON WebhookCreateEvent = String "create" + toJSON WebhookDeleteEvent = String "delete" + toJSON WebhookDeployKeyEvent = String "deploy_key" + toJSON WebhookDeploymentEvent = String "deployment" + toJSON WebhookDeploymentStatusEvent = String "deployment_status" + toJSON WebhookDiscussion = String "discussion" + toJSON WebhookDiscussionComment = String "discussion_comment" + toJSON WebhookDownloadEvent = String "download" + toJSON WebhookFollowEvent = String "follow" + toJSON WebhookForkEvent = String "fork" + toJSON WebhookGistEvent = String "gist" + toJSON WebhookGitHubAppAuthorizationEvent = String "github_app_authorization" + toJSON WebhookGollumEvent = String "gollum" + toJSON WebhookInstallationEvent = String "installation" + toJSON WebhookInstallationRepositoriesEvent = String "installation_repositories" + toJSON WebhookIssueCommentEvent = String "issue_comment" + toJSON WebhookIssuesEvent = String "issues" + toJSON WebhookLabelEvent = String "label" + toJSON WebhookMarketplacePurchaseEvent = String "marketplace_purchase" + toJSON WebhookMemberEvent = String "member" + toJSON WebhookMembershipEvent = String "membership" + toJSON WebhookMetaEvent = String "meta" + toJSON WebhookMilestoneEvent = String "milestone" + toJSON WebhookOrgBlockEvent = String "org_block" + toJSON WebhookOrganizationEvent = String "organization" + toJSON WebhookPackage = String "package" + toJSON WebhookPageBuildEvent = String "page_build" + toJSON WebhookPingEvent = String "ping" + toJSON WebhookProjectCardEvent = String "project_card" + toJSON WebhookProjectColumnEvent = String "project_column" + toJSON WebhookProjectEvent = String "project" + toJSON WebhookPublicEvent = String "public" + toJSON WebhookPullRequestEvent = String "pull_request" + toJSON WebhookPullRequestReviewCommentEvent = String "pull_request_review_comment" + toJSON WebhookPullRequestReviewEvent = String "pull_request_review" + toJSON WebhookPushEvent = String "push" + toJSON WebhookRegistryPackageEvent = String "registry_package" + toJSON WebhookReleaseEvent = String "release" + toJSON WebhookRepositoryDispatch = String "repository_dispatch" + toJSON WebhookRepositoryEvent = String "repository" + toJSON WebhookRepositoryImportEvent = String "repository_import" + toJSON WebhookRepositoryVulnerabilityAlertEvent = String "repository_vulnerability_alert" + toJSON WebhookSecretScanningAlert = String "secret_scanning_alert" + toJSON WebhookSecurityAdvisoryEvent = String "security_advisory" + toJSON WebhookSponsorship = String "sponsorship" + toJSON WebhookStarEvent = String "star" + toJSON WebhookStatusEvent = String "status" + toJSON WebhookTeamAddEvent = String "team_add" + toJSON WebhookTeamEvent = String "team" + toJSON WebhookWatchEvent = String "watch" + toJSON WebhookWorkflowDispatch = String "workflow_dispatch" + toJSON WebhookWorkflowRun = String "workflow_run" instance FromJSON RepoWebhook where - parseJSON = withObject "RepoWebhook" $ \o -> - RepoWebhook <$> o .: "url" - <*> o .: "test_url" - <*> o .: "id" - <*> o .: "name" - <*> o .: "active" - <*> o .: "events" - <*> o .: "config" - <*> o .: "last_response" - <*> o .: "updated_at" - <*> o .: "created_at" + 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" + parseJSON = withObject "RepoWebhookResponse" $ \o -> RepoWebhookResponse + <$> o .: "code" + <*> o .:? "status" + <*> o .:? "message" instance ToJSON NewRepoWebhook where toJSON (NewRepoWebhook { newRepoWebhookName = name @@ -201,7 +304,7 @@ instance ToJSON EditRepoWebhook where ] instance FromJSON PingEvent where - parseJSON = withObject "PingEvent" $ \o -> - PingEvent <$> o .: "zen" - <*> o .: "hook" - <*> o .: "hook_id" + 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 index 0ca26283..1ea7590b 100644 --- a/src/GitHub/Data/Webhooks/Validate.hs +++ b/src/GitHub/Data/Webhooks/Validate.hs @@ -1,41 +1,34 @@ -{-# LANGUAGE CPP #-} -{-# LANGUAGE OverloadedStrings #-} ------------------------------------------------------------------------------ -- | --- License : BSD-3-Clause --- Maintainer : Oleg Grenrus --- -- Verification of incomming webhook payloads, as described at -- + module GitHub.Data.Webhooks.Validate ( isValidPayload ) where -import Prelude () -import Prelude.Compat +import GitHub.Internal.Prelude +import Prelude () -import Crypto.Hash -import Data.Byteable (constEqBytes, toBytes) -import qualified Data.ByteString.Base16 as Hex -import qualified Data.ByteString.Char8 as BS -import Data.Monoid +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 - :: String -- ^ the secret - -> Maybe String -- ^ the hash provided by the remote party - -- in @X-Hub-Signature@ (if any), - -- including the 'sha1=...' prefix - -> BS.ByteString -- ^ the body + :: 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 (constEqBytes sign) shaOptBS +isValidPayload secret shaOpt payload = maybe False (sign ==) shaOptBS where - shaOptBS = BS.pack <$> shaOpt - hexDigest = Hex.encode . toBytes . hmacGetDigest - - hm = hmac (BS.pack secret) payload :: HMAC SHA1 + 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 index 86828213..7d77057b 100644 --- a/src/GitHub/Endpoints/Activity/Starring.hs +++ b/src/GitHub/Endpoints/Activity/Starring.hs @@ -1,72 +1,54 @@ -{-# LANGUAGE DataKinds #-} -{-# LANGUAGE OverloadedStrings #-} ------------------------------------------------------------------------------ -- | --- License : BSD-3-Clause --- Maintainer : Oleg Grenrus --- -- The repo starring API as described on -- . + module GitHub.Endpoints.Activity.Starring ( - stargazersFor, stargazersForR, - reposStarredBy, reposStarredByR, - myStarred, myStarredR, - myStarredAcceptStar, myStarredAcceptStarR, + starRepoR, + unstarRepoR, module GitHub.Data, ) where -import Data.Vector (Vector) import GitHub.Auth import GitHub.Data -import GitHub.Request - --- | The list of users that have starred the specified Github repo. --- --- > userInfoFor' Nothing "mike-burns" -stargazersFor :: Maybe Auth -> Name Owner -> Name Repo -> IO (Either Error (Vector SimpleUser)) -stargazersFor auth user repo = - executeRequestMaybe auth $ stargazersForR user repo Nothing +import GitHub.Internal.Prelude +import Prelude () -- | List Stargazers. -- See -stargazersForR :: Name Owner -> Name Repo -> Maybe Count -> Request k (Vector SimpleUser) +stargazersForR :: Name Owner -> Name Repo -> FetchCount -> Request k (Vector SimpleUser) stargazersForR user repo = - PagedQuery ["repos", toPathPart user, toPathPart repo, "stargazers"] [] - --- | All the public repos starred by the specified user. --- --- > reposStarredBy Nothing "croaky" -reposStarredBy :: Maybe Auth -> Name Owner -> IO (Either Error (Vector Repo)) -reposStarredBy auth user = - executeRequestMaybe auth $ reposStarredByR user Nothing + pagedQuery ["repos", toPathPart user, toPathPart repo, "stargazers"] [] -- | List repositories being starred. -- See -reposStarredByR :: Name Owner -> Maybe Count -> Request k (Vector Repo) +reposStarredByR :: Name Owner -> FetchCount -> Request k (Vector Repo) reposStarredByR user = - PagedQuery ["users", toPathPart user, "starred"] [] - --- | All the repos starred by the authenticated user. -myStarred :: Auth -> IO (Either Error (Vector Repo)) -myStarred auth = - executeRequest auth $ myStarredR Nothing + pagedQuery ["users", toPathPart user, "starred"] [] -- | All the repos starred by the authenticated user. -- See -myStarredR :: Maybe Count -> Request 'True (Vector Repo) -myStarredR = PagedQuery ["user", "starred"] [] - - --- | All the repos starred by the authenticated user. -myStarredAcceptStar :: Auth -> IO (Either Error (Vector RepoStarred)) -myStarredAcceptStar auth = - executeRequest auth $ myStarredAcceptStarR Nothing +myStarredR :: FetchCount -> Request 'RA (Vector Repo) +myStarredR = pagedQuery ["user", "starred"] [] -- | All the repos starred by the authenticated user. -- See -myStarredAcceptStarR :: Maybe Count -> Request 'True (Vector RepoStarred) -myStarredAcceptStarR = HeaderQuery [("Accept", "application/vnd.github.v3.star+json")] . PagedQuery ["user", "starred"] [] +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 index 7dc93299..3ad5954b 100644 --- a/src/GitHub/Endpoints/Activity/Watching.hs +++ b/src/GitHub/Endpoints/Activity/Watching.hs @@ -1,61 +1,33 @@ ------------------------------------------------------------------------------ -- | --- License : BSD-3-Clause --- Maintainer : Oleg Grenrus --- -- The repo watching API as described on -- . + module GitHub.Endpoints.Activity.Watching ( - watchersFor, - watchersFor', watchersForR, - reposWatchedBy, - reposWatchedBy', reposWatchedByR, + unwatchRepoR, module GitHub.Data, ) where -import Data.Vector (Vector) import GitHub.Auth import GitHub.Data -import GitHub.Request - --- | The list of users that are watching the specified Github repo. --- --- > watchersFor "thoughtbot" "paperclip" -watchersFor :: Name Owner -> Name Repo -> IO (Either Error (Vector SimpleUser)) -watchersFor = watchersFor' Nothing - --- | The list of users that are watching the specified Github repo. --- With authentication --- --- > watchersFor' (Just (User (user, password))) "thoughtbot" "paperclip" -watchersFor' :: Maybe Auth -> Name Owner -> Name Repo -> IO (Either Error (Vector SimpleUser)) -watchersFor' auth user repo = - executeRequestMaybe auth $ watchersForR user repo Nothing +import GitHub.Internal.Prelude +import Prelude () -- | List watchers. -- See -watchersForR :: Name Owner -> Name Repo -> Maybe Count -> Request k (Vector SimpleUser) +watchersForR :: Name Owner -> Name Repo -> FetchCount -> Request k (Vector SimpleUser) watchersForR user repo limit = - PagedQuery ["repos", toPathPart user, toPathPart repo, "watchers"] [] limit - --- | All the public repos watched by the specified user. --- --- > reposWatchedBy "croaky" -reposWatchedBy :: Name Owner -> IO (Either Error (Vector Repo)) -reposWatchedBy = reposWatchedBy' Nothing - --- | All the public repos watched by the specified user. --- With authentication --- --- > reposWatchedBy' (Just (User (user, password))) "croaky" -reposWatchedBy' :: Maybe Auth -> Name Owner -> IO (Either Error (Vector Repo)) -reposWatchedBy' auth user = - executeRequestMaybe auth $ reposWatchedByR user Nothing + pagedQuery ["repos", toPathPart user, toPathPart repo, "watchers"] [] limit -- | List repositories being watched. -- See -reposWatchedByR :: Name Owner -> Maybe Count -> Request k (Vector Repo) +reposWatchedByR :: Name Owner -> FetchCount -> Request k (Vector Repo) reposWatchedByR user = - PagedQuery ["users", toPathPart user, "subscriptions"] [] + 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 index 537f3626..da1fc194 100644 --- a/src/GitHub/Endpoints/Gists.hs +++ b/src/GitHub/Endpoints/Gists.hs @@ -1,56 +1,47 @@ ------------------------------------------------------------------------------ -- | --- License : BSD-3-Clause --- Maintainer : Oleg Grenrus --- -- The gists API as described at . + module GitHub.Endpoints.Gists ( - gists, - gists', gistsR, - gist, - gist', gistR, + createGistR, + starGistR, + unstarGistR, + deleteGistR, module GitHub.Data, ) where -import Data.Vector (Vector) import GitHub.Data -import GitHub.Request - --- | The list of all gists created by the user --- --- > gists' (Just ("github-username", "github-password")) "mike-burns" -gists' :: Maybe Auth -> Name Owner -> IO (Either Error (Vector Gist)) -gists' auth user = - executeRequestMaybe auth $ gistsR user Nothing - --- | The list of all public gists created by the user. --- --- > gists "mike-burns" -gists :: Name Owner -> IO (Either Error (Vector Gist)) -gists = gists' Nothing +import GitHub.Internal.Prelude +import Prelude () -- | List gists. -- See -gistsR :: Name Owner -> Maybe Count -> Request k (Vector Gist) -gistsR user = PagedQuery ["users", toPathPart user, "gists"] [] - --- | A specific gist, given its id, with authentication credentials --- --- > gist' (Just ("github-username", "github-password")) "225074" -gist' :: Maybe Auth -> Name Gist -> IO (Either Error Gist) -gist' auth gid = - executeRequestMaybe auth $ gistR gid - --- | A specific gist, given its id. --- --- > gist "225074" -gist :: Name Gist -> IO (Either Error Gist) -gist = gist' Nothing +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 :: Name Gist -> Request k Gist gistR gid = - Query ["gists", toPathPart 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 index 0298e1a0..5234a63c 100644 --- a/src/GitHub/Endpoints/Gists/Comments.hs +++ b/src/GitHub/Endpoints/Gists/Comments.hs @@ -1,45 +1,25 @@ ------------------------------------------------------------------------------ -- | --- License : BSD-3-Clause --- Maintainer : Oleg Grenrus --- -- The loving comments people have left on Gists, described on -- . + module GitHub.Endpoints.Gists.Comments ( - commentsOn, commentsOnR, - comment, gistCommentR, module GitHub.Data, ) where -import Data.Vector (Vector) - import GitHub.Data -import GitHub.Request - --- | All the comments on a Gist, given the Gist ID. --- --- > commentsOn "1174060" -commentsOn :: Name Gist -> IO (Either Error (Vector GistComment)) -commentsOn gid = - executeRequest' $ commentsOnR gid Nothing +import GitHub.Internal.Prelude +import Prelude () -- | List comments on a gist. -- See -commentsOnR :: Name Gist -> Maybe Count -> Request k (Vector GistComment) +commentsOnR :: Name Gist -> FetchCount -> Request k (Vector GistComment) commentsOnR gid = - PagedQuery ["gists", toPathPart gid, "comments"] [] - --- | A specific comment, by the comment ID. --- --- > comment (Id 62449) -comment :: Id GistComment -> IO (Either Error GistComment) -comment cid = - executeRequest' $ gistCommentR cid + pagedQuery ["gists", toPathPart gid, "comments"] [] -- | Query a single comment. -- See gistCommentR :: Id GistComment -> Request k GistComment gistCommentR cid = - Query ["gists", "comments", toPathPart cid] [] + query ["gists", "comments", toPathPart cid] [] diff --git a/src/GitHub/Endpoints/GitData/Blobs.hs b/src/GitHub/Endpoints/GitData/Blobs.hs index f473b09a..c7b39aea 100644 --- a/src/GitHub/Endpoints/GitData/Blobs.hs +++ b/src/GitHub/Endpoints/GitData/Blobs.hs @@ -1,35 +1,17 @@ ------------------------------------------------------------------------------ -- | --- License : BSD-3-Clause --- Maintainer : Oleg Grenrus --- -- The API for dealing with git blobs from Github repos, as described in -- . + module GitHub.Endpoints.GitData.Blobs ( - blob, - blob', blobR, module GitHub.Data, ) where import GitHub.Data -import GitHub.Request - --- | Query a blob by SHA1. --- --- > blob' (Just ("github-username", "github-password")) "thoughtbot" "paperclip" "bc5c51d1ece1ee45f94b056a0f5a1674d7e8cba9" -blob' :: Maybe Auth -> Name Owner -> Name Repo -> Name Blob -> IO (Either Error Blob) -blob' auth user repo sha = - executeRequestMaybe auth $ blobR user repo sha - --- | Query a blob by SHA1. --- --- > blob "thoughtbot" "paperclip" "bc5c51d1ece1ee45f94b056a0f5a1674d7e8cba9" -blob :: Name Owner -> Name Repo -> Name Blob -> IO (Either Error Blob) -blob = blob' Nothing +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] [] + 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 index c4c51ef5..82a18bf3 100644 --- a/src/GitHub/Endpoints/GitData/Commits.hs +++ b/src/GitHub/Endpoints/GitData/Commits.hs @@ -1,28 +1,17 @@ ------------------------------------------------------------------------------ -- | --- License : BSD-3-Clause --- Maintainer : Oleg Grenrus --- -- The API for underlying git commits of a Github repo, as described on -- . + module GitHub.Endpoints.GitData.Commits ( - commit, gitCommitR, module GitHub.Data, ) where import GitHub.Data -import GitHub.Request - --- | A single commit, by SHA1. --- --- > commit "thoughtbot" "paperclip" "bc5c51d1ece1ee45f94b056a0f5a1674d7e8cba9" -commit :: Name Owner -> Name Repo -> Name GitCommit -> IO (Either Error GitCommit) -commit user repo sha = - executeRequest' $ gitCommitR user repo sha +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] [] + 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 index 7a1a5137..a1f10814 100644 --- a/src/GitHub/Endpoints/GitData/References.hs +++ b/src/GitHub/Endpoints/GitData/References.hs @@ -1,89 +1,47 @@ -{-# LANGUAGE DataKinds #-} ------------------------------------------------------------------------------ -- | --- License : BSD-3-Clause --- Maintainer : Oleg Grenrus --- -- The underlying git references on a Github repo, exposed for the world to -- see. The git internals documentation will also prove handy for understanding -- these. API documentation at . + module GitHub.Endpoints.GitData.References ( - reference, - reference', referenceR, - references, - references', referencesR, - createReference, createReferenceR, - namespacedReferences, + deleteReferenceR, + namespacedReferencesR, module GitHub.Data, ) where -import Data.Aeson.Compat (encode) -import Data.Vector (Vector) - import GitHub.Data -import GitHub.Request - --- | A single reference by the ref name. --- --- > reference' (Just ("github-username", "github-password")) "mike-burns" "github" "heads/master" -reference' :: Maybe Auth -> Name Owner -> Name Repo -> Name GitReference -> IO (Either Error GitReference) -reference' auth user repo ref = - executeRequestMaybe auth $ referenceR user repo ref - --- | A single reference by the ref name. --- --- > reference "mike-burns" "github" "heads/master" -reference :: Name Owner -> Name Repo -> Name GitReference -> IO (Either Error GitReference) -reference = reference' Nothing +import GitHub.Internal.Prelude +import Prelude () --- | Query a reference. +-- | A single reference -- | Query a reference. -- See referenceR :: Name Owner -> Name Repo -> Name GitReference -> Request k GitReference referenceR user repo ref = - Query ["repos", toPathPart user, toPathPart repo, "git", "refs", toPathPart ref] [] - --- | The history of references for a repo. --- --- > references "mike-burns" "github" -references' :: Maybe Auth -> Name Owner -> Name Repo -> IO (Either Error (Vector GitReference)) -references' auth user repo = - executeRequestMaybe auth $ referencesR user repo Nothing - --- | The history of references for a repo. --- --- > references "mike-burns" "github" -references :: Name Owner -> Name Repo -> IO (Either Error (Vector GitReference)) -references = references' Nothing + query ["repos", toPathPart user, toPathPart repo, "git", "refs", toPathPart ref] [] -- | Query all References. -- See -referencesR :: Name Owner -> Name Repo -> Maybe Count -> Request k (Vector GitReference) +referencesR :: Name Owner -> Name Repo -> FetchCount -> Request k (Vector GitReference) referencesR user repo = - PagedQuery ["repos", toPathPart user, toPathPart repo, "git", "refs"] [] - --- | Create a reference. -createReference :: Auth -> Name Owner -> Name Repo -> NewGitReference -> IO (Either Error GitReference) -createReference auth user repo newRef = - executeRequest auth $ createReferenceR user repo newRef + pagedQuery ["repos", toPathPart user, toPathPart repo, "git", "refs"] [] -- | Create a reference. -- See -createReferenceR :: Name Owner -> Name Repo -> NewGitReference -> Request 'True GitReference +createReferenceR :: Name Owner -> Name Repo -> NewGitReference -> Request 'RW GitReference createReferenceR user repo newRef = - Command Post ["repos", toPathPart user, toPathPart repo , "git", "refs"] (encode newRef) + command Post ["repos", toPathPart user, toPathPart repo , "git", "refs"] (encode newRef) --- | Limited references by a namespace. --- --- > namespacedReferences "thoughtbot" "paperclip" "tags" -namespacedReferences :: Name Owner -> Name Repo -> String -> IO (Either Error [GitReference]) -namespacedReferences user repo namespace = - executeRequest' $ namespacedReferencesR user repo namespace +-- | Delete a reference. +-- See +deleteReferenceR :: Name Owner -> Name Repo -> Name GitReference -> GenRequest 'MtUnit 'RW () +deleteReferenceR user repo ref = + Command Delete ["repos", toPathPart user, toPathPart repo , "git", "refs", toPathPart ref] mempty -- | Query namespaced references. -- See -namespacedReferencesR :: Name Owner -> Name Repo -> String -> Request k [GitReference] +namespacedReferencesR :: Name Owner -> Name Repo -> Text -> Request k [GitReference] namespacedReferencesR user repo namespace = - Query ["repos", toPathPart user, toPathPart repo, "git", "refs", 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 index 661737a0..4bdf389b 100644 --- a/src/GitHub/Endpoints/GitData/Trees.hs +++ b/src/GitHub/Endpoints/GitData/Trees.hs @@ -1,58 +1,25 @@ -{-# LANGUAGE OverloadedStrings #-} ------------------------------------------------------------------------------ -- | --- License : BSD-3-Clause --- Maintainer : Oleg Grenrus --- -- The underlying tree of SHA1s and files that make up a git repo. The API is -- described on . + module GitHub.Endpoints.GitData.Trees ( - tree, - tree', treeR, - nestedTree, - nestedTree', nestedTreeR, module GitHub.Data, ) where import GitHub.Data -import GitHub.Request - --- | A tree for a SHA1. --- --- > tree (Just ("github-username", "github-password")) "thoughtbot" "paperclip" "fe114451f7d066d367a1646ca7ac10e689b46844" -tree' :: Maybe Auth -> Name Owner -> Name Repo -> Name Tree -> IO (Either Error Tree) -tree' auth user repo sha = - executeRequestMaybe auth $ treeR user repo sha - --- | A tree for a SHA1. --- --- > tree "thoughtbot" "paperclip" "fe114451f7d066d367a1646ca7ac10e689b46844" -tree :: Name Owner -> Name Repo -> Name Tree -> IO (Either Error Tree) -tree = tree' Nothing +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] [] - --- | A recursively-nested tree for a SHA1. --- --- > nestedTree' (Just ("github-username", "github-password")) "thoughtbot" "paperclip" "fe114451f7d066d367a1646ca7ac10e689b46844" -nestedTree' :: Maybe Auth -> Name Owner -> Name Repo -> Name Tree -> IO (Either Error Tree) -nestedTree' auth user repo sha = - executeRequestMaybe auth $ nestedTreeR user repo sha - --- | A recursively-nested tree for a SHA1. --- --- > nestedTree "thoughtbot" "paperclip" "fe114451f7d066d367a1646ca7ac10e689b46844" -nestedTree :: Name Owner -> Name Repo -> Name Tree -> IO (Either Error Tree) -nestedTree = nestedTree' Nothing + query ["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")] + 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 index f3e7a6c0..47888dc5 100644 --- a/src/GitHub/Endpoints/Issues.hs +++ b/src/GitHub/Endpoints/Issues.hs @@ -1,136 +1,64 @@ -{-# LANGUAGE CPP #-} -{-# LANGUAGE DataKinds #-} -{-# LANGUAGE OverloadedStrings #-} ------------------------------------------------------------------------------ -- | --- License : BSD-3-Clause --- Maintainer : Oleg Grenrus --- -- The issues API as described on . + module GitHub.Endpoints.Issues ( - issue, - issue', + currentUserIssuesR, + organizationIssuesR, issueR, - issuesForRepo, - issuesForRepo', issuesForRepoR, - IssueLimitation(..), - createIssue, createIssueR, newIssue, - editIssue, editIssueR, editOfIssue, module GitHub.Data, ) where import GitHub.Data -import GitHub.Request - -import Data.Aeson.Compat (encode) -import Data.List (intercalate) -import Data.Text (Text) -import Data.Time.ISO8601 (formatISO8601) -import Data.Vector (Vector) - -import qualified Data.ByteString.Char8 as BS8 +import GitHub.Internal.Prelude +import Prelude () --- | Details on a specific issue, given the repo owner and name, and the issue --- number.' --- --- > issue' (Just ("github-username", "github-password")) "thoughtbot" "paperclip" "462" -issue' :: Maybe Auth -> Name Owner -> Name Repo -> Id Issue -> IO (Either Error Issue) -issue' auth user reqRepoName reqIssueNumber = - executeRequestMaybe auth $ issueR user reqRepoName reqIssueNumber +-- | See . +currentUserIssuesR :: IssueMod -> FetchCount -> Request 'RA (Vector Issue) +currentUserIssuesR opts = + pagedQuery ["user", "issues"] (issueModToQueryString opts) --- | Details on a specific issue, given the repo owner and name, and the issue --- number. --- --- > issue "thoughtbot" "paperclip" (Id "462") -issue :: Name Owner -> Name Repo -> Id Issue -> IO (Either Error Issue) -issue = issue' Nothing +-- | 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 -> Id Issue -> Request k Issue +issueR :: Name Owner -> Name Repo -> IssueNumber -> Request k Issue issueR user reqRepoName reqIssueNumber = - Query ["repos", toPathPart user, toPathPart reqRepoName, "issues", toPathPart reqIssueNumber] [] - --- | All issues for a repo (given the repo owner and name), with optional --- restrictions as described in the @IssueLimitation@ data type. --- --- > issuesForRepo' (Just ("github-username", "github-password")) "thoughtbot" "paperclip" [NoMilestone, OnlyClosed, Mentions "jyurek", Ascending] -issuesForRepo' :: Maybe Auth -> Name Owner -> Name Repo -> [IssueLimitation] -> IO (Either Error (Vector Issue)) -issuesForRepo' auth user reqRepoName issueLimitations = - executeRequestMaybe auth $ issuesForRepoR user reqRepoName issueLimitations Nothing - --- | 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 :: Name Owner -> Name Repo -> [IssueLimitation] -> IO (Either Error (Vector Issue)) -issuesForRepo = issuesForRepo' Nothing + query ["repos", toPathPart user, toPathPart reqRepoName, "issues", toPathPart reqIssueNumber] [] -- | List issues for a repository. -- See -issuesForRepoR :: Name Owner -> Name Repo -> [IssueLimitation] -> Maybe Count -> Request k (Vector Issue) -issuesForRepoR user reqRepoName issueLimitations = - PagedQuery ["repos", toPathPart user, toPathPart reqRepoName, "issues"] qs +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 = map convert issueLimitations - - convert AnyMilestone = ("milestone", Just "*") - convert NoMilestone = ("milestone", Just "none") - convert (MilestoneId n) = ("milestone", Just . BS8.pack $ show n) - convert Open = ("state", Just "open") - convert OnlyClosed = ("state", Just "closed") - convert Unassigned = ("assignee", Just "none") - convert AnyAssignment = ("assignee", Just "") - convert (AssignedTo u) = ("assignee", Just $ BS8.pack u) - convert (Mentions u) = ("mentioned", Just $ BS8.pack u) - convert (Labels l) = ("labels", Just . BS8.pack $ intercalate "," l) - convert Ascending = ("direction", Just "asc") - convert Descending = ("direction", Just "desc") - convert (PerPage n) = ("per_page", Just . BS8.pack $ show n) - convert (Since t) = ("since", Just . BS8.pack $ formatISO8601 t) + qs = issueRepoModToQueryString opts -- Creating new issues. newIssue :: Text -> NewIssue -newIssue title = NewIssue title Nothing Nothing Nothing Nothing - - --- | Create a new issue. --- --- > createIssue (User (user, password)) user repo --- > (newIssue "some_repo") {...} -createIssue :: Auth -> Name Owner -> Name Repo -> NewIssue - -> IO (Either Error Issue) -createIssue auth user repo ni = - executeRequest auth $ createIssueR user repo ni +newIssue title = NewIssue title Nothing mempty Nothing Nothing -- | Create an issue. -- See -createIssueR :: Name Owner -> Name Repo -> NewIssue -> Request 'True Issue +createIssueR :: Name Owner -> Name Repo -> NewIssue -> Request 'RW Issue createIssueR user repo = - Command Post ["repos", toPathPart user, toPathPart repo, "issues"] . encode + command Post ["repos", toPathPart user, toPathPart repo, "issues"] . encode -- Editing issues. editOfIssue :: EditIssue editOfIssue = EditIssue Nothing Nothing Nothing Nothing Nothing Nothing --- | Edit an issue. --- --- > editIssue (User (user, password)) user repo issue --- > editOfIssue {...} -editIssue :: Auth -> Name Owner -> Name Repo -> Id Issue -> EditIssue - -> IO (Either Error Issue) -editIssue auth user repo iss edit = - executeRequest auth $ editIssueR user repo iss edit - -- | Edit an issue. -- See -editIssueR :: Name Owner -> Name Repo -> Id Issue -> EditIssue -> Request 'True Issue +editIssueR :: Name Owner -> Name Repo -> IssueNumber -> EditIssue -> Request 'RW Issue editIssueR user repo iss = - Command Patch ["repos", toPathPart user, toPathPart repo, "issues", toPathPart iss] . encode + 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 index a6f90234..0c307d3f 100644 --- a/src/GitHub/Endpoints/Issues/Comments.hs +++ b/src/GitHub/Endpoints/Issues/Comments.hs @@ -1,93 +1,52 @@ -{-# LANGUAGE DataKinds #-} ------------------------------------------------------------------------------ -- | --- License : BSD-3-Clause --- Maintainer : Oleg Grenrus --- -- The Github issue comments API from -- . + module GitHub.Endpoints.Issues.Comments ( - comment, commentR, - comments, commentsR, - comments', - createComment, createCommentR, - editComment, + deleteCommentR, editCommentR, module GitHub.Data, ) where -import Data.Aeson.Compat (encode) -import Data.Text (Text) -import Data.Vector (Vector) - import GitHub.Data -import GitHub.Request - --- | A specific comment, by ID. --- --- > comment "thoughtbot" "paperclip" 1468184 -comment :: Name Owner -> Name Repo -> Id Comment -> IO (Either Error IssueComment) -comment user repo cid = - executeRequest' $ commentR user repo cid +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] [] - --- | All comments on an issue, by the issue's number. --- --- > comments "thoughtbot" "paperclip" 635 -comments :: Name Owner -> Name Repo -> Id Issue -> IO (Either Error (Vector IssueComment)) -comments = comments' Nothing - --- | All comments on an issue, by the issue's number, using authentication. --- --- > comments' (User (user, password)) "thoughtbot" "paperclip" 635 -comments' :: Maybe Auth -> Name Owner -> Name Repo -> Id Issue -> IO (Either Error (Vector IssueComment)) -comments' auth user repo iid = - executeRequestMaybe auth $ commentsR user repo iid Nothing + query ["repos", toPathPart user, toPathPart repo, "issues", "comments", toPathPart cid] [] -- | List comments on an issue. -- See -commentsR :: Name Owner -> Name Repo -> Id Issue -> Maybe Count -> Request k (Vector IssueComment) +commentsR :: Name Owner -> Name Repo -> IssueNumber -> FetchCount -> Request k (Vector IssueComment) commentsR user repo iid = - PagedQuery ["repos", toPathPart user, toPathPart repo, "issues", toPathPart iid, "comments"] [] - --- | Create a new comment. --- --- > createComment (User (user, password)) user repo issue --- > "some words" -createComment :: Auth -> Name Owner -> Name Repo -> Id Issue -> Text - -> IO (Either Error Comment) -createComment auth user repo iss body = - executeRequest auth $ createCommentR user repo iss body + pagedQuery ["repos", toPathPart user, toPathPart repo, "issues", toPathPart iid, "comments"] [] -- | Create a comment. -- See -createCommentR :: Name Owner -> Name Repo -> Id Issue -> Text -> Request 'True Comment +createCommentR :: Name Owner -> Name Repo -> IssueNumber -> Text -> Request 'RW Comment createCommentR user repo iss body = - Command Post parts (encode $ NewComment body) + command Post parts (encode $ NewComment body) where parts = ["repos", toPathPart user, toPathPart repo, "issues", toPathPart iss, "comments"] --- | Edit a comment. --- --- > editComment (User (user, password)) user repo commentid --- > "new words" -editComment :: Auth -> Name Owner -> Name Repo -> Id Comment -> Text - -> IO (Either Error Comment) -editComment auth user repo commid body = - executeRequest auth $ editCommentR user repo commid body - -- | Edit a comment. -- See -editCommentR :: Name Owner -> Name Repo -> Id Comment -> Text -> Request 'True Comment +editCommentR :: Name Owner -> Name Repo -> Id Comment -> Text -> Request 'RW Comment editCommentR user repo commid body = - Command Patch parts (encode $ EditComment 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 index 8e555c2d..0639026c 100644 --- a/src/GitHub/Endpoints/Issues/Events.hs +++ b/src/GitHub/Endpoints/Issues/Events.hs @@ -1,81 +1,32 @@ ------------------------------------------------------------------------------ -- | --- License : BSD-3-Clause --- Maintainer : Oleg Grenrus --- -- The Github issue events API, which is described on -- + module GitHub.Endpoints.Issues.Events ( - eventsForIssue, - eventsForIssue', eventsForIssueR, - eventsForRepo, - eventsForRepo', eventsForRepoR, - event, - event', eventR, module GitHub.Data, ) where -import Data.Vector (Vector) - import GitHub.Data -import GitHub.Request - --- | All events that have happened on an issue. --- --- > eventsForIssue "thoughtbot" "paperclip" 49 -eventsForIssue :: Name Owner -> Name Repo -> Id Issue -> IO (Either Error (Vector Event)) -eventsForIssue = eventsForIssue' Nothing - --- | All events that have happened on an issue, using authentication. --- --- > eventsForIssue' (User (user, password)) "thoughtbot" "paperclip" 49 -eventsForIssue' :: Maybe Auth -> Name Owner -> Name Repo -> Id Issue -> IO (Either Error (Vector Event)) -eventsForIssue' auth user repo iid = - executeRequestMaybe auth $ eventsForIssueR user repo iid Nothing +import GitHub.Internal.Prelude +import Prelude () -- | List events for an issue. -- See -eventsForIssueR :: Name Owner -> Name Repo -> Id Issue -> Maybe Count -> Request k (Vector Event) +eventsForIssueR :: Name Owner -> Name Repo -> Id Issue -> FetchCount -> Request k (Vector IssueEvent) eventsForIssueR user repo iid = - PagedQuery ["repos", toPathPart user, toPathPart repo, "issues", toPathPart iid, "events"] [] - --- | All the events for all issues in a repo. --- --- > eventsForRepo "thoughtbot" "paperclip" -eventsForRepo :: Name Owner -> Name Repo -> IO (Either Error (Vector Event)) -eventsForRepo = eventsForRepo' Nothing - --- | All the events for all issues in a repo, using authentication. --- --- > eventsForRepo' (User (user, password)) "thoughtbot" "paperclip" -eventsForRepo' :: Maybe Auth -> Name Owner -> Name Repo -> IO (Either Error (Vector Event)) -eventsForRepo' auth user repo = - executeRequestMaybe auth $ eventsForRepoR user repo Nothing + pagedQuery ["repos", toPathPart user, toPathPart repo, "issues", toPathPart iid, "events"] [] -- | List events for a repository. -- See -eventsForRepoR :: Name Owner -> Name Repo -> Maybe Count -> Request k (Vector Event) +eventsForRepoR :: Name Owner -> Name Repo -> FetchCount -> Request k (Vector IssueEvent) eventsForRepoR user repo = - PagedQuery ["repos", toPathPart user, toPathPart repo, "issues", "events"] [] - --- | Details on a specific event, by the event's ID. --- --- > event "thoughtbot" "paperclip" 5335772 -event :: Name Owner -> Name Repo -> Id Event -> IO (Either Error Event) -event = event' Nothing - --- | Details on a specific event, by the event's ID, using authentication. --- --- > event' (User (user, password)) "thoughtbot" "paperclip" 5335772 -event' :: Maybe Auth -> Name Owner -> Name Repo -> Id Event -> IO (Either Error Event) -event' auth user repo eid = - executeRequestMaybe auth $ eventR user repo eid + pagedQuery ["repos", toPathPart user, toPathPart repo, "issues", "events"] [] -- | Query a single event. -- See -eventR :: Name Owner -> Name Repo -> Id Event -> Request k Event +eventR :: Name Owner -> Name Repo -> Id IssueEvent -> Request k IssueEvent eventR user repo eid = - Query ["repos", toPathPart user, toPathPart repo, "issues", "events", show 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 index 81ad0d50..bdf2319d 100644 --- a/src/GitHub/Endpoints/Issues/Labels.hs +++ b/src/GitHub/Endpoints/Issues/Labels.hs @@ -1,177 +1,65 @@ -{-# LANGUAGE DataKinds #-} -{-# LANGUAGE OverloadedStrings #-} ------------------------------------------------------------------------------ -- | --- License : BSD-3-Clause --- Maintainer : Oleg Grenrus --- -- The API for dealing with labels on Github issues as described on -- . + module GitHub.Endpoints.Issues.Labels ( - labelsOnRepo, - labelsOnRepo', labelsOnRepoR, - label, - label', labelR, - createLabel, createLabelR, - updateLabel, updateLabelR, - deleteLabel, deleteLabelR, - labelsOnIssue, - labelsOnIssue', labelsOnIssueR, - addLabelsToIssue, addLabelsToIssueR, - removeLabelFromIssue, removeLabelFromIssueR, - replaceAllLabelsForIssue, replaceAllLabelsForIssueR, - removeAllLabelsFromIssue, removeAllLabelsFromIssueR, - labelsOnMilestone, - labelsOnMilestone', labelsOnMilestoneR, module GitHub.Data, ) where -import Prelude () -import Prelude.Compat - -import Data.Aeson.Compat (encode, object, (.=)) -import Data.Foldable (toList) -import Data.Vector (Vector) - import GitHub.Data -import GitHub.Request - --- | All the labels available to use on any issue in the repo. --- --- > labelsOnRepo "thoughtbot" "paperclip" -labelsOnRepo :: Name Owner -> Name Repo -> IO (Either Error (Vector IssueLabel)) -labelsOnRepo = labelsOnRepo' Nothing - --- | All the labels available to use on any issue in the repo using authentication. --- --- > labelsOnRepo' (Just (User (user password))) "thoughtbot" "paperclip" -labelsOnRepo' :: Maybe Auth -> Name Owner -> Name Repo -> IO (Either Error (Vector IssueLabel)) -labelsOnRepo' auth user repo = - executeRequestMaybe auth $ labelsOnRepoR user repo Nothing +import GitHub.Internal.Prelude +import Prelude () -- | List all labels for this repository. -- See -labelsOnRepoR :: Name Owner -> Name Repo -> Maybe Count -> Request k (Vector IssueLabel) +labelsOnRepoR :: Name Owner -> Name Repo -> FetchCount -> Request k (Vector IssueLabel) labelsOnRepoR user repo = - PagedQuery ["repos", toPathPart user, toPathPart repo, "labels"] [] - --- | A label by name. --- --- > label "thoughtbot" "paperclip" "bug" -label :: Name Owner -> Name Repo -> Name IssueLabel -> IO (Either Error IssueLabel) -label = label' Nothing - --- | A label by name using authentication. --- --- > label' (Just (User (user password))) "thoughtbot" "paperclip" "bug" -label' :: Maybe Auth -> Name Owner -> Name Repo -> Name IssueLabel -> IO (Either Error IssueLabel) -label' auth user repo lbl = - executeRequestMaybe auth $ labelR user repo lbl + 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 --- --- > createLabel (User (user password)) "thoughtbot" "paperclip" "bug" "f29513" -createLabel :: Auth -> Name Owner -> Name Repo -> Name IssueLabel -> String -> IO (Either Error IssueLabel) -createLabel auth user repo lbl color = - executeRequest auth $ createLabelR user repo lbl color + query ["repos", toPathPart user, toPathPart repo, "labels", toPathPart lbl] [] -- | Create a label. -- See -createLabelR :: Name Owner -> Name Repo -> Name IssueLabel -> String -> Request 'True IssueLabel -createLabelR user repo lbl color = - Command Post paths $ encode body - where - paths = ["repos", toPathPart user, toPathPart repo, "labels"] - body = object ["name" .= untagName lbl, "color" .= color] - --- | Update a label --- --- > updateLabel (User (user password)) "thoughtbot" "paperclip" "bug" "new-bug" "ff1111" -updateLabel :: Auth - -> Name Owner - -> Name Repo - -> Name IssueLabel -- ^ old label name - -> Name IssueLabel -- ^ new label name - -> String -- ^ new color - -> IO (Either Error IssueLabel) -updateLabel auth user repo oldLbl newLbl color = - executeRequest auth $ updateLabelR user repo oldLbl newLbl color +createLabelR :: Name Owner -> Name Repo -> NewIssueLabel -> Request 'RW IssueLabel +createLabelR user repo = + command Post ["repos", toPathPart user, toPathPart repo, "labels"] . encode -- | Update a label. -- See updateLabelR :: Name Owner -> Name Repo -> Name IssueLabel -- ^ old label name - -> Name IssueLabel -- ^ new label name - -> String -- ^ new color - -> Request 'True IssueLabel -updateLabelR user repo oldLbl newLbl color = - Command Patch paths (encode body) - where - paths = ["repos", toPathPart user, toPathPart repo, "labels", toPathPart oldLbl] - body = object ["name" .= untagName newLbl, "color" .= color] - --- | Delete a label --- --- > deleteLabel (User (user password)) "thoughtbot" "paperclip" "bug" -deleteLabel :: Auth -> Name Owner -> Name Repo -> Name IssueLabel -> IO (Either Error ()) -deleteLabel auth user repo lbl = - executeRequest auth $ deleteLabelR user repo lbl + -> 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 -> Request 'True () +deleteLabelR :: Name Owner -> Name Repo -> Name IssueLabel -> GenRequest 'MtUnit 'RW () deleteLabelR user repo lbl = Command Delete ["repos", toPathPart user, toPathPart repo, "labels", toPathPart lbl] mempty --- | The labels on an issue in a repo. --- --- > labelsOnIssue "thoughtbot" "paperclip" 585 -labelsOnIssue :: Name Owner -> Name Repo -> Id Issue -> IO (Either Error (Vector IssueLabel)) -labelsOnIssue = labelsOnIssue' Nothing - --- | The labels on an issue in a repo using authentication. --- --- > labelsOnIssue' (Just (User (user password))) "thoughtbot" "paperclip" (Id 585) -labelsOnIssue' :: Maybe Auth -> Name Owner -> Name Repo -> Id Issue -> IO (Either Error (Vector IssueLabel)) -labelsOnIssue' auth user repo iid = - executeRequestMaybe auth $ labelsOnIssueR user repo iid Nothing - -- | List labels on an issue. -- See -labelsOnIssueR :: Name Owner -> Name Repo -> Id Issue -> Maybe Count -> Request k (Vector IssueLabel) +labelsOnIssueR :: Name Owner -> Name Repo -> Id Issue -> FetchCount -> Request k (Vector IssueLabel) labelsOnIssueR user repo iid = - PagedQuery ["repos", toPathPart user, toPathPart repo, "issues", toPathPart iid, "labels"] [] - --- | Add labels to an issue. --- --- > addLabelsToIssue (User (user password)) "thoughtbot" "paperclip" (Id 585) ["Label1" "Label2"] -addLabelsToIssue :: Foldable f - => Auth - -> Name Owner - -> Name Repo - -> Id Issue - -> f (Name IssueLabel) - -> IO (Either Error (Vector IssueLabel)) -addLabelsToIssue auth user repo iid lbls = - executeRequest auth $ addLabelsToIssueR user repo iid lbls + pagedQuery ["repos", toPathPart user, toPathPart repo, "issues", toPathPart iid, "labels"] [] -- | Add lables to an issue. -- See @@ -180,38 +68,18 @@ addLabelsToIssueR :: Foldable f -> Name Repo -> Id Issue -> f (Name IssueLabel) - -> Request 'True (Vector IssueLabel) + -> Request 'RW (Vector IssueLabel) addLabelsToIssueR user repo iid lbls = - Command Post paths (encode $ toList lbls) + command Post paths (encode $ toList lbls) where paths = ["repos", toPathPart user, toPathPart repo, "issues", toPathPart iid, "labels"] --- | Remove a label from an issue. --- --- > removeLabelFromIssue (User (user password)) "thoughtbot" "paperclip" (Id 585) "bug" -removeLabelFromIssue :: Auth -> Name Owner -> Name Repo -> Id Issue -> Name IssueLabel -> IO (Either Error ()) -removeLabelFromIssue auth user repo iid lbl = - executeRequest auth $ removeLabelFromIssueR user repo iid lbl - -- | Remove a label from an issue. -- See -removeLabelFromIssueR :: Name Owner -> Name Repo -> Id Issue -> Name IssueLabel -> Request 'True () +removeLabelFromIssueR :: Name Owner -> Name Repo -> Id Issue -> Name IssueLabel -> GenRequest 'MtUnit 'RW () removeLabelFromIssueR user repo iid lbl = Command Delete ["repos", toPathPart user, toPathPart repo, "issues", toPathPart iid, "labels", toPathPart lbl] mempty --- | Replace all labels on an issue. Sending an empty list will remove all labels from the issue. --- --- > replaceAllLabelsForIssue (User (user password)) "thoughtbot" "paperclip" (Id 585) ["Label1" "Label2"] -replaceAllLabelsForIssue :: Foldable f - => Auth - -> Name Owner - -> Name Repo - -> Id Issue - -> f (Name IssueLabel) - -> IO (Either Error (Vector IssueLabel)) -replaceAllLabelsForIssue auth user repo iid lbls = - executeRequest auth $ replaceAllLabelsForIssueR user repo iid lbls - -- | Replace all labels on an issue. -- See -- @@ -221,40 +89,20 @@ replaceAllLabelsForIssueR :: Foldable f -> Name Repo -> Id Issue -> f (Name IssueLabel) - -> Request 'True (Vector IssueLabel) + -> Request 'RW (Vector IssueLabel) replaceAllLabelsForIssueR user repo iid lbls = - Command Put paths (encode $ toList lbls) + command Put paths (encode $ toList lbls) where paths = ["repos", toPathPart user, toPathPart repo, "issues", toPathPart iid, "labels"] --- | Remove all labels from an issue. --- --- > removeAllLabelsFromIssue (User (user password)) "thoughtbot" "paperclip" (Id 585) -removeAllLabelsFromIssue :: Auth -> Name Owner -> Name Repo -> Id Issue -> IO (Either Error ()) -removeAllLabelsFromIssue auth user repo iid = - executeRequest auth $ removeAllLabelsFromIssueR user repo iid - -- | Remove all labels from an issue. -- See -removeAllLabelsFromIssueR :: Name Owner -> Name Repo -> Id Issue -> Request 'True () +removeAllLabelsFromIssueR :: Name Owner -> Name Repo -> Id Issue -> GenRequest 'MtUnit 'RW () removeAllLabelsFromIssueR user repo iid = Command Delete ["repos", toPathPart user, toPathPart repo, "issues", toPathPart iid, "labels"] mempty --- | All the labels on a repo's milestone given the milestone ID. --- --- > labelsOnMilestone "thoughtbot" "paperclip" (Id 2) -labelsOnMilestone :: Name Owner -> Name Repo -> Id Milestone -> IO (Either Error (Vector IssueLabel)) -labelsOnMilestone = labelsOnMilestone' Nothing - --- | All the labels on a repo's milestone given the milestone ID using authentication. --- --- > labelsOnMilestone' (Just (User (user password))) "thoughtbot" "paperclip" (Id 2) -labelsOnMilestone' :: Maybe Auth -> Name Owner -> Name Repo -> Id Milestone -> IO (Either Error (Vector IssueLabel)) -labelsOnMilestone' auth user repo mid = - executeRequestMaybe auth $ labelsOnMilestoneR user repo mid Nothing - -- | Query labels for every issue in a milestone. -- See -labelsOnMilestoneR :: Name Owner -> Name Repo -> Id Milestone -> Maybe Count -> Request k (Vector IssueLabel) +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"] [] + 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 index 91447df2..18d5d9d4 100644 --- a/src/GitHub/Endpoints/Issues/Milestones.hs +++ b/src/GitHub/Endpoints/Issues/Milestones.hs @@ -1,51 +1,47 @@ ------------------------------------------------------------------------------ -- | --- License : BSD-3-Clause --- Maintainer : Oleg Grenrus --- -- The milestones API as described on -- . + module GitHub.Endpoints.Issues.Milestones ( - milestones, - milestones', milestonesR, - milestone, milestoneR, + createMilestoneR, + updateMilestoneR, + deleteMilestoneR, module GitHub.Data, ) where -import Data.Vector (Vector) - import GitHub.Data -import GitHub.Request - --- | All milestones in the repo. --- --- > milestones "thoughtbot" "paperclip" -milestones :: Name Owner -> Name Repo -> IO (Either Error (Vector Milestone)) -milestones = milestones' Nothing - --- | All milestones in the repo, using authentication. --- --- > milestones' (User (user, passwordG) "thoughtbot" "paperclip" -milestones' :: Maybe Auth -> Name Owner -> Name Repo -> IO (Either Error (Vector Milestone)) -milestones' auth user repo = - executeRequestMaybe auth $ milestonesR user repo Nothing +import GitHub.Internal.Prelude +import Prelude () -- | List milestones for a repository. -- See -milestonesR :: Name Owner -> Name Repo -> Maybe Count -> Request k (Vector Milestone) -milestonesR user repo = PagedQuery ["repos", toPathPart user, toPathPart repo, "milestones"] [] - --- | Details on a specific milestone, given it's milestone number. --- --- > milestone "thoughtbot" "paperclip" (Id 2) -milestone :: Name Owner -> Name Repo -> Id Milestone -> IO (Either Error Milestone) -milestone user repo mid = - executeRequest' $ milestoneR user repo mid +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] [] + 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 index d10d745a..0cb3da47 100644 --- a/src/GitHub/Endpoints/Organizations.hs +++ b/src/GitHub/Endpoints/Organizations.hs @@ -1,54 +1,28 @@ ------------------------------------------------------------------------------ -- | --- License : BSD-3-Clause --- Maintainer : Oleg Grenrus --- -- The orgs API as described on . + module GitHub.Endpoints.Organizations ( - publicOrganizationsFor, - publicOrganizationsFor', publicOrganizationsForR, - publicOrganization, - publicOrganization', publicOrganizationR, + organizationsR, module GitHub.Data, ) where -import Data.Vector (Vector) import GitHub.Data -import GitHub.Request - --- | The public organizations for a user, given the user's login, with authorization --- --- > publicOrganizationsFor' (Just ("github-username", "github-password")) "mike-burns" -publicOrganizationsFor' :: Maybe Auth -> Name User -> IO (Either Error (Vector SimpleOrganization)) -publicOrganizationsFor' auth org = - executeRequestMaybe auth $ publicOrganizationsForR org Nothing +import GitHub.Internal.Prelude +import Prelude () --- | List user organizations. The public organizations for a user, given the user's login. --- --- > publicOrganizationsFor "mike-burns" -publicOrganizationsFor :: Name User -> IO (Either Error (Vector SimpleOrganization)) -publicOrganizationsFor = publicOrganizationsFor' Nothing +-- | List all user organizations. +-- See +organizationsR :: FetchCount -> Request k (Vector SimpleOrganization) +organizationsR = pagedQuery ["user", "orgs"] [] --- | List user organizations. +-- | List public user organizations. -- See -publicOrganizationsForR :: Name User -> Maybe Count -> Request k (Vector SimpleOrganization) -publicOrganizationsForR user = PagedQuery ["users", toPathPart user, "orgs"] [] - --- | Details on a public organization. Takes the organization's login. --- --- > publicOrganization' (Just ("github-username", "github-password")) "thoughtbot" -publicOrganization' :: Maybe Auth -> Name Organization -> IO (Either Error Organization) -publicOrganization' auth = executeRequestMaybe auth . publicOrganizationR - --- | Query an organization. Details on a public organization. Takes the organization's login. --- --- > publicOrganization "thoughtbot" -publicOrganization :: Name Organization -> IO (Either Error Organization) -publicOrganization = publicOrganization' Nothing +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] [] +publicOrganizationR reqOrganizationName = query ["orgs", toPathPart reqOrganizationName] [] diff --git a/src/GitHub/Endpoints/Organizations/Members.hs b/src/GitHub/Endpoints/Organizations/Members.hs index 398184c1..8de82b77 100644 --- a/src/GitHub/Endpoints/Organizations/Members.hs +++ b/src/GitHub/Endpoints/Organizations/Members.hs @@ -1,50 +1,33 @@ -{-# LANGUAGE OverloadedStrings #-} ------------------------------------------------------------------------------ -- | --- License : BSD-3-Clause --- Maintainer : Oleg Grenrus --- -- The organization members API as described on -- . + module GitHub.Endpoints.Organizations.Members ( - membersOf, - membersOf', membersOfR, membersOfWithR, + isMemberOfR, + orgInvitationsR, + orgMembershipR, module GitHub.Data, ) where -import Data.Vector (Vector) - import GitHub.Data -import GitHub.Request - --- | All the users who are members of the specified organization, --- | with or without authentication. --- --- > membersOf' (Just $ OAuth "token") "thoughtbot" -membersOf' :: Maybe Auth -> Name Organization -> IO (Either Error (Vector SimpleUser)) -membersOf' auth org = - executeRequestMaybe auth $ membersOfR org Nothing - --- | All the users who are members of the specified organization, --- | without authentication. --- --- > membersOf "thoughtbot" -membersOf :: Name Organization -> IO (Either Error (Vector SimpleUser)) -membersOf = membersOf' Nothing +import GitHub.Internal.Prelude +import Prelude () -- | All the users who are members of the specified organization. -- -- See -membersOfR :: Name Organization -> Maybe Count -> Request k (Vector SimpleUser) -membersOfR organization = PagedQuery ["orgs", toPathPart organization, "members"] [] +membersOfR :: Name Organization -> FetchCount -> Request k (Vector SimpleUser) +membersOfR organization = + pagedQuery ["orgs", toPathPart organization, "members"] [] -- | 'membersOfR' with filters. -- -- See -membersOfWithR :: Name Organization -> OrgMemberFilter -> OrgMemberRole -> Maybe Count -> Request k (Vector SimpleUser) -membersOfWithR org f r = PagedQuery ["orgs", toPathPart org, "members"] [("filter", Just f'), ("role", Just r')] +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" @@ -53,3 +36,23 @@ membersOfWithR org f r = PagedQuery ["orgs", toPathPart org, "members"] [("filte 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 index bd7a9784..af8c8b36 100644 --- a/src/GitHub/Endpoints/Organizations/Teams.hs +++ b/src/GitHub/Endpoints/Organizations/Teams.hs @@ -1,218 +1,101 @@ -{-# LANGUAGE DataKinds #-} -{-# LANGUAGE OverloadedStrings #-} ------------------------------------------------------------------------------ -- | --- License : BSD-3-Clause --- Maintainer : Oleg Grenrus --- -- The Owner teams API as described on -- . + module GitHub.Endpoints.Organizations.Teams ( - teamsOf, - teamsOf', teamsOfR, - teamInfoFor, - teamInfoFor', teamInfoForR, - createTeamFor', createTeamForR, - editTeam', editTeamR, - deleteTeam', deleteTeamR, listTeamMembersR, - listTeamRepos, - listTeamRepos', listTeamReposR, - teamMembershipInfoFor, - teamMembershipInfoFor', + addOrUpdateTeamRepoR, teamMembershipInfoForR, - addTeamMembershipFor', addTeamMembershipForR, - deleteTeamMembershipFor', deleteTeamMembershipForR, - listTeamsCurrent', listTeamsCurrentR, module GitHub.Data, ) where -import Prelude () -import Prelude.Compat - -import Data.Aeson.Compat (encode) -import Data.Vector (Vector) - import GitHub.Data -import GitHub.Request - --- | List teams. List the teams of an Owner. --- When authenticated, lists private teams visible to the authenticated user. --- When unauthenticated, lists only public teams for an Owner. --- --- > teamsOf' (Just $ OAuth "token") "thoughtbot" -teamsOf' :: Maybe Auth -> Name Organization -> IO (Either Error (Vector SimpleTeam)) -teamsOf' auth org = - executeRequestMaybe auth $ teamsOfR org Nothing - --- | List the public teams of an Owner. --- --- > teamsOf "thoughtbot" -teamsOf :: Name Organization -> IO (Either Error (Vector SimpleTeam)) -teamsOf = teamsOf' Nothing +import GitHub.Internal.Prelude +import Prelude () -- | List teams. -- See -teamsOfR :: Name Organization -> Maybe Count -> Request k (Vector SimpleTeam) -teamsOfR org = PagedQuery ["orgs", toPathPart org, "teams"] [] - --- | The information for a single team, by team id. --- With authentication --- --- > teamInfoFor' (Just $ OAuth "token") 1010101 -teamInfoFor' :: Maybe Auth -> Id Team -> IO (Either Error Team) -teamInfoFor' auth tid = - executeRequestMaybe auth $ teamInfoForR tid - --- | The information for a single team, by team id. --- --- > teamInfoFor' (Just $ OAuth "token") 1010101 -teamInfoFor :: Id Team -> IO (Either Error Team) -teamInfoFor = teamInfoFor' Nothing +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 a team under an Owner --- --- > createTeamFor' (OAuth "token") "Owner" (CreateTeam "newteamname" "some description" [] PermssionPull) -createTeamFor' :: Auth - -> Name Organization - -> CreateTeam - -> IO (Either Error Team) -createTeamFor' auth org cteam = - executeRequest auth $ createTeamForR org cteam + query ["teams", toPathPart tid] [] -- | Create team. -- See -createTeamForR :: Name Organization -> CreateTeam -> Request 'True Team +createTeamForR :: Name Organization -> CreateTeam -> Request 'RW Team createTeamForR org cteam = - Command Post ["orgs", toPathPart org, "teams"] (encode cteam) - --- | Edit a team, by id. --- --- > editTeamFor' -editTeam' :: Auth - -> Id Team - -> EditTeam - -> IO (Either Error Team) -editTeam' auth tid eteam = - executeRequest auth $ editTeamR tid eteam + command Post ["orgs", toPathPart org, "teams"] (encode cteam) -- | Edit team. -- See -editTeamR :: Id Team -> EditTeam -> Request 'True Team +editTeamR :: Id Team -> EditTeam -> Request 'RW Team editTeamR tid eteam = - Command Patch ["teams", toPathPart tid] (encode eteam) + command Patch ["teams", toPathPart tid] (encode eteam) --- | Delete a team, by id. --- --- > deleteTeam' (OAuth "token") 1010101 -deleteTeam' :: Auth -> Id Team -> IO (Either Error ()) -deleteTeam' auth tid = - executeRequest auth $ deleteTeamR tid - --- | Delete team. -- -- See -deleteTeamR :: Id Team -> Request 'True () +deleteTeamR :: Id Team -> GenRequest 'MtUnit 'RW () deleteTeamR tid = Command Delete ["teams", toPathPart tid] mempty -- | List team members. -- -- See -listTeamMembersR :: Id Team -> TeamMemberRole -> Maybe Count -> Request 'True (Vector SimpleUser) -listTeamMembersR tid r = PagedQuery ["teams", toPathPart tid, "members"] [("role", Just r')] +listTeamMembersR :: Id Team -> TeamMemberRole -> FetchCount -> Request 'RA (Vector SimpleUser) +listTeamMembersR tid r = + pagedQuery ["teams", toPathPart tid, "members"] [("role", Just r')] where r' = case r of TeamMemberRoleAll -> "all" TeamMemberRoleMaintainer -> "maintainer" TeamMemberRoleMember -> "member" --- | The repositories of a single team, by team id. --- With authentication --- --- > listTeamRepos' (Just $ GitHub.OAuth token) (GitHub.mkTeamId team_id) -listTeamRepos' :: Maybe Auth -> Id Team -> IO (Either Error (Vector Repo)) -listTeamRepos' auth tid = executeRequestMaybe auth $ listTeamReposR tid Nothing - -- | Query team repositories. -- See -listTeamReposR :: Id Team -> Maybe Count -> Request k (Vector Repo) -listTeamReposR tid = PagedQuery ["teams", toPathPart tid, "repos"] [] +listTeamReposR :: Id Team -> FetchCount -> Request k (Vector Repo) +listTeamReposR tid = + pagedQuery ["teams", toPathPart tid, "repos"] [] --- | Retrieve repositories for a team. --- --- > listTeamRepos (GitHub.mkTeamId team_id) -listTeamRepos :: Id Team -> IO (Either Error (Vector Repo)) -listTeamRepos = listTeamRepos' Nothing - --- | Retrieve team mebership information for a user. --- With authentication --- --- > teamMembershipInfoFor' (Just $ OAuth "token") 1010101 "mburns" -teamMembershipInfoFor' :: Maybe Auth -> Id Team -> Name Owner -> IO (Either Error TeamMembership) -teamMembershipInfoFor' auth tid user = - executeRequestMaybe auth $ teamMembershipInfoForR tid user +-- | 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] [] - --- | Retrieve team mebership information for a user. --- --- > teamMembershipInfoFor 1010101 "mburns" -teamMembershipInfoFor :: Id Team -> Name Owner -> IO (Either Error TeamMembership) -teamMembershipInfoFor = teamMembershipInfoFor' Nothing - --- | Add (or invite) a member to a team. --- --- > addTeamMembershipFor' (OAuth "token") 1010101 "mburns" RoleMember -addTeamMembershipFor' :: Auth -> Id Team -> Name Owner -> Role-> IO (Either Error TeamMembership) -addTeamMembershipFor' auth tid user role = - executeRequest auth $ addTeamMembershipForR tid user role + query ["teams", toPathPart tid, "memberships", toPathPart user] [] -- | Add team membership. -- See -addTeamMembershipForR :: Id Team -> Name Owner -> Role -> Request 'True TeamMembership +addTeamMembershipForR :: Id Team -> Name Owner -> Role -> Request 'RW TeamMembership addTeamMembershipForR tid user role = - Command Put ["teams", toPathPart tid, "memberships", toPathPart user] (encode $ CreateTeamMembership role) - --- | Delete a member of a team. --- --- > deleteTeamMembershipFor' (OAuth "token") 1010101 "mburns" -deleteTeamMembershipFor' :: Auth -> Id Team -> Name Owner -> IO (Either Error ()) -deleteTeamMembershipFor' auth tid user = - executeRequest auth $ deleteTeamMembershipForR tid user + command Put ["teams", toPathPart tid, "memberships", toPathPart user] (encode $ CreateTeamMembership role) -- | Remove team membership. -- See -deleteTeamMembershipForR :: Id Team -> Name Owner -> Request 'True () +deleteTeamMembershipForR :: Id Team -> Name Owner -> GenRequest 'MtUnit 'RW () deleteTeamMembershipForR tid user = Command Delete ["teams", toPathPart tid, "memberships", toPathPart user] mempty --- | List teams for current authenticated user --- --- > listTeamsCurrent' (OAuth "token") -listTeamsCurrent' :: Auth -> IO (Either Error (Vector Team)) -listTeamsCurrent' auth = executeRequest auth $ listTeamsCurrentR Nothing - -- | List user teams. -- See -listTeamsCurrentR :: Maybe Count -> Request 'True (Vector Team) -listTeamsCurrentR = PagedQuery ["user", "teams"] [] +listTeamsCurrentR :: FetchCount -> Request 'RA (Vector Team) +listTeamsCurrentR = + pagedQuery ["user", "teams"] [] diff --git a/src/GitHub/Endpoints/PullRequests.hs b/src/GitHub/Endpoints/PullRequests.hs index 5cdc15fa..5e5d6aac 100644 --- a/src/GitHub/Endpoints/PullRequests.hs +++ b/src/GitHub/Endpoints/PullRequests.hs @@ -1,181 +1,101 @@ -{-# LANGUAGE DataKinds #-} -{-# LANGUAGE OverloadedStrings #-} ------------------------------------------------------------------------------ -- | --- License : BSD-3-Clause --- Maintainer : Oleg Grenrus --- -- The pull requests API as documented at -- . + module GitHub.Endpoints.PullRequests ( - pullRequestsFor, pullRequestsForR, - pullRequest', - pullRequest, pullRequestR, - createPullRequest, + pullRequestDiffR, + pullRequestPatchR, createPullRequestR, - updatePullRequest, updatePullRequestR, - pullRequestCommits', - pullRequestCommitsIO, pullRequestCommitsR, - pullRequestFiles', - pullRequestFiles, pullRequestFilesR, - isPullRequestMerged, isPullRequestMergedR, - mergePullRequest, mergePullRequestR, module GitHub.Data ) where import GitHub.Data -import GitHub.Request - -import Data.Aeson.Compat (Value, encode, object, (.=)) -import Data.Vector (Vector) - --- | All open pull requests for the repo, by owner and repo name. --- --- > pullRequestsFor "rails" "rails" -pullRequestsFor :: Name Owner -> Name Repo -> IO (Either Error (Vector SimplePullRequest)) -pullRequestsFor user repo = - executeRequest' $ pullRequestsForR user repo defaultPullRequestOptions Nothing +import GitHub.Internal.Prelude +import Prelude () +import Data.ByteString.Lazy (ByteString) -- | List pull requests. -- See -pullRequestsForR :: Name Owner -> Name Repo - -> PullRequestOptions -- ^ State - -> Maybe Count - -> Request k (Vector SimplePullRequest) -pullRequestsForR user repo opts = PagedQuery +pullRequestsForR + :: Name Owner + -> Name Repo + -> PullRequestMod + -> FetchCount + -> Request k (Vector SimplePullRequest) +pullRequestsForR user repo opts = pagedQuery ["repos", toPathPart user, toPathPart repo, "pulls"] - (pullRequestOptionsToQueryString opts) + (prModToQueryString opts) --- | A detailed pull request, which has much more information. This takes the --- repo owner and name along with the number assigned to the pull request. --- With authentification. --- --- > pullRequest' (Just ("github-username", "github-password")) "thoughtbot" "paperclip" 562 -pullRequest' :: Maybe Auth -> Name Owner -> Name Repo -> Id PullRequest -> IO (Either Error PullRequest) -pullRequest' auth user repo prid = - executeRequestMaybe auth $ pullRequestR user repo prid +-- | Query a single pull request to obtain the diff +-- See +pullRequestDiffR :: Name Owner -> Name Repo -> IssueNumber -> GenRequest 'MtDiff rw ByteString +pullRequestDiffR user repo prid = + Query ["repos", toPathPart user, toPathPart repo, "pulls", toPathPart prid] [] --- | A detailed pull request, which has much more information. This takes the --- repo owner and name along with the number assigned to the pull request. --- --- > pullRequest "thoughtbot" "paperclip" 562 -pullRequest :: Name Owner -> Name Repo -> Id PullRequest -> IO (Either Error PullRequest) -pullRequest = pullRequest' Nothing +-- | Query a single pull request to obtain the patch +-- See +pullRequestPatchR :: Name Owner -> Name Repo -> IssueNumber -> GenRequest 'MtPatch rw ByteString +pullRequestPatchR user repo prid = + Query ["repos", toPathPart user, toPathPart repo, "pulls", toPathPart prid] [] -- | Query a single pull request. -- See -pullRequestR :: Name Owner -> Name Repo -> Id PullRequest -> Request k PullRequest +pullRequestR :: Name Owner -> Name Repo -> IssueNumber -> Request k PullRequest pullRequestR user repo prid = - Query ["repos", toPathPart user, toPathPart repo, "pulls", toPathPart prid] [] - -createPullRequest :: Auth - -> Name Owner - -> Name Repo - -> CreatePullRequest - -> IO (Either Error PullRequest) -createPullRequest auth user repo cpr = - executeRequest auth $ createPullRequestR user repo cpr + query ["repos", toPathPart user, toPathPart repo, "pulls", toPathPart prid] [] -- | Create a pull request. -- See createPullRequestR :: Name Owner -> Name Repo -> CreatePullRequest - -> Request 'True PullRequest + -> Request 'RW PullRequest createPullRequestR user repo cpr = - Command Post ["repos", toPathPart user, toPathPart repo, "pulls"] (encode cpr) - --- | Update a pull request -updatePullRequest :: Auth -> Name Owner -> Name Repo -> Id PullRequest -> EditPullRequest -> IO (Either Error PullRequest) -updatePullRequest auth user repo prid epr = - executeRequest auth $ updatePullRequestR user repo prid epr + command Post ["repos", toPathPart user, toPathPart repo, "pulls"] (encode cpr) -- | Update a pull request. -- See updatePullRequestR :: Name Owner -> Name Repo - -> Id PullRequest + -> IssueNumber -> EditPullRequest - -> Request 'True PullRequest + -> Request 'RW PullRequest updatePullRequestR user repo prid epr = - Command Patch ["repos", toPathPart user, toPathPart repo, "pulls", toPathPart prid] (encode epr) - --- | All the commits on a pull request, given the repo owner, repo name, and --- the number of the pull request. --- With authentification. --- --- > pullRequestCommits' (Just ("github-username", "github-password")) "thoughtbot" "paperclip" 688 -pullRequestCommits' :: Maybe Auth -> Name Owner -> Name Repo -> Id PullRequest -> IO (Either Error (Vector Commit)) -pullRequestCommits' auth user repo prid = - executeRequestMaybe auth $ pullRequestCommitsR user repo prid Nothing - --- | All the commits on a pull request, given the repo owner, repo name, and --- the number of the pull request. --- --- > pullRequestCommits "thoughtbot" "paperclip" 688 -pullRequestCommitsIO :: Name Owner -> Name Repo -> Id PullRequest -> IO (Either Error (Vector Commit)) -pullRequestCommitsIO = pullRequestCommits' Nothing + command Patch ["repos", toPathPart user, toPathPart repo, "pulls", toPathPart prid] (encode epr) -- | List commits on a pull request. -- See -pullRequestCommitsR :: Name Owner -> Name Repo -> Id PullRequest -> Maybe Count -> Request k (Vector Commit) +pullRequestCommitsR :: Name Owner -> Name Repo -> IssueNumber -> FetchCount -> Request k (Vector Commit) pullRequestCommitsR user repo prid = - PagedQuery ["repos", toPathPart user, toPathPart repo, "pulls", toPathPart prid, "commits"] [] - --- | The individual files that a pull request patches. Takes the repo owner and --- name, plus the number assigned to the pull request. --- With authentification. --- --- > pullRequestFiles' (Just ("github-username", "github-password")) "thoughtbot" "paperclip" 688 -pullRequestFiles' :: Maybe Auth -> Name Owner -> Name Repo -> Id PullRequest -> IO (Either Error (Vector File)) -pullRequestFiles' auth user repo prid = - executeRequestMaybe auth $ pullRequestFilesR user repo prid Nothing - --- | The individual files that a pull request patches. Takes the repo owner and --- name, plus the number assigned to the pull request. --- --- > pullRequestFiles "thoughtbot" "paperclip" 688 -pullRequestFiles :: Name Owner -> Name Repo -> Id PullRequest -> IO (Either Error (Vector File)) -pullRequestFiles = pullRequestFiles' Nothing + pagedQuery ["repos", toPathPart user, toPathPart repo, "pulls", toPathPart prid, "commits"] [] -- | List pull requests files. -- See -pullRequestFilesR :: Name Owner -> Name Repo -> Id PullRequest -> Maybe Count -> Request k (Vector File) +pullRequestFilesR :: Name Owner -> Name Repo -> IssueNumber -> FetchCount -> Request k (Vector File) pullRequestFilesR user repo prid = - PagedQuery ["repos", toPathPart user, toPathPart repo, "pulls", toPathPart prid, "files"] [] - --- | Check if pull request has been merged. -isPullRequestMerged :: Auth -> Name Owner -> Name Repo -> Id PullRequest -> IO (Either Error Bool) -isPullRequestMerged auth user repo prid = - executeRequest auth $ isPullRequestMergedR user repo prid + pagedQuery ["repos", toPathPart user, toPathPart repo, "pulls", toPathPart prid, "files"] [] -- | Query if a pull request has been merged. -- See -isPullRequestMergedR :: Name Owner -> Name Repo -> Id PullRequest -> Request k Bool -isPullRequestMergedR user repo prid = StatusQuery StatusOnlyOk $ +isPullRequestMergedR :: Name Owner -> Name Repo -> IssueNumber -> GenRequest 'MtStatus rw Bool +isPullRequestMergedR user repo prid = Query ["repos", toPathPart user, toPathPart repo, "pulls", toPathPart prid, "merge"] [] --- | Merge a pull request. -mergePullRequest :: Auth -> Name Owner -> Name Repo -> Id PullRequest -> Maybe String -> IO (Either Error MergeResult) -mergePullRequest auth user repo prid commitMessage = - executeRequest auth $ mergePullRequestR user repo prid commitMessage - -- | Merge a pull request (Merge Button). -- https://developer.github.com/v3/pulls/#merge-a-pull-request-merge-button -mergePullRequestR :: Name Owner -> Name Repo -> Id PullRequest -> Maybe String -> Request 'True MergeResult -mergePullRequestR user repo prid commitMessage = StatusQuery StatusMerge $ +mergePullRequestR :: Name Owner -> Name Repo -> IssueNumber -> Maybe Text -> GenRequest 'MtStatus 'RW MergeResult +mergePullRequestR user repo prid commitMessage = Command Put paths (encode $ buildCommitMessageMap commitMessage) where paths = ["repos", toPathPart user, toPathPart repo, "pulls", toPathPart prid, "merge"] - buildCommitMessageMap :: Maybe String -> Value + 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/ReviewComments.hs b/src/GitHub/Endpoints/PullRequests/ReviewComments.hs deleted file mode 100644 index 24402266..00000000 --- a/src/GitHub/Endpoints/PullRequests/ReviewComments.hs +++ /dev/null @@ -1,44 +0,0 @@ ------------------------------------------------------------------------------ --- | --- License : BSD-3-Clause --- Maintainer : Oleg Grenrus --- --- The pull request review comments API as described at --- . -module GitHub.Endpoints.PullRequests.ReviewComments ( - pullRequestReviewCommentsIO, - pullRequestReviewCommentsR, - pullRequestReviewComment, - pullRequestReviewCommentR, - module GitHub.Data, - ) where - -import Data.Vector (Vector) -import GitHub.Data -import GitHub.Request - --- | All the comments on a pull request with the given ID. --- --- > pullRequestReviewComments "thoughtbot" "factory_girl" (Id 256) -pullRequestReviewCommentsIO :: Name Owner -> Name Repo -> Id PullRequest -> IO (Either Error (Vector Comment)) -pullRequestReviewCommentsIO user repo prid = - executeRequest' $ pullRequestReviewCommentsR user repo prid Nothing - --- | List comments on a pull request. --- See -pullRequestReviewCommentsR :: Name Owner -> Name Repo -> Id PullRequest -> Maybe Count -> Request k (Vector Comment) -pullRequestReviewCommentsR user repo prid = - PagedQuery ["repos", toPathPart user, toPathPart repo, "pulls", toPathPart prid, "comments"] [] - --- | One comment on a pull request, by the comment's ID. --- --- > pullRequestReviewComment "thoughtbot" "factory_girl" (Id 301819) -pullRequestReviewComment :: Name Owner -> Name Repo -> Id Comment -> IO (Either Error Comment) -pullRequestReviewComment user repo cid = - executeRequest' $ pullRequestReviewCommentR user repo cid - --- | Query a single comment. --- See -pullRequestReviewCommentR :: Name Owner -> Name Repo -> Id Comment -> Request k Comment -pullRequestReviewCommentR user repo cid = - Query ["repos", toPathPart user, toPathPart repo, "pulls", "comments", toPathPart cid] [] 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 index d053d461..85c8b639 100644 --- a/src/GitHub/Endpoints/Repos.hs +++ b/src/GitHub/Endpoints/Repos.hs @@ -1,75 +1,36 @@ -{-# LANGUAGE DataKinds #-} -{-# LANGUAGE DeriveDataTypeable #-} -{-# LANGUAGE DeriveGeneric #-} -{-# LANGUAGE OverloadedStrings #-} ------------------------------------------------------------------------------ -- | --- License : BSD-3-Clause --- Maintainer : Oleg Grenrus --- -- The Github Repos API, as documented at -- + module GitHub.Endpoints.Repos ( -- * Querying repositories - currentUserRepos, currentUserReposR, - userRepos, - userRepos', userReposR, - organizationRepos, - organizationRepos', organizationReposR, - repository, - repository', repositoryR, - contributors, - contributors', contributorsR, - contributorsWithAnonymous, - contributorsWithAnonymous', - languagesFor, - languagesFor', languagesForR, - tagsFor, - tagsFor', tagsForR, - branchesFor, - branchesFor', branchesForR, - contentsFor, - contentsFor', - readmeFor, - readmeFor', -- ** Create - createRepo', createRepoR, - createOrganizationRepo', createOrganizationRepoR, + forkExistingRepoR, -- ** Edit - editRepo, editRepoR, -- ** Delete - deleteRepo, deleteRepoR, -- * Data module GitHub.Data, ) where -import Prelude () -import Prelude.Compat - -import Control.Applicative ((<|>)) -import Data.Aeson.Compat (encode) -import Data.Vector (Vector) - import GitHub.Data -import GitHub.Request - -import qualified Data.ByteString.Char8 as BS8 +import GitHub.Internal.Prelude +import Prelude () repoPublicityQueryString :: RepoPublicity -> QueryString repoPublicityQueryString RepoPublicityAll = [("type", Just "all")] @@ -79,286 +40,101 @@ repoPublicityQueryString RepoPublicityPublic = [("type", Just "public")] repoPublicityQueryString RepoPublicityPrivate = [("type", Just "private")] -- | List your repositories. -currentUserRepos :: Auth -> RepoPublicity -> IO (Either Error (Vector Repo)) -currentUserRepos auth publicity = - executeRequest auth $ currentUserReposR publicity Nothing - --- | List your repositories. --- See -currentUserReposR :: RepoPublicity -> Maybe Count -> Request k(Vector Repo) +-- See +currentUserReposR :: RepoPublicity -> FetchCount -> Request k (Vector Repo) currentUserReposR publicity = - PagedQuery ["user", "repos"] qs + pagedQuery ["user", "repos"] qs where qs = repoPublicityQueryString publicity --- | The repos for a user, by their login. Can be restricted to just repos they --- own, are a member of, or publicize. Private repos will return empty list. --- --- > userRepos "mike-burns" All -userRepos :: Name Owner -> RepoPublicity -> IO (Either Error (Vector Repo)) -userRepos = userRepos' Nothing - --- | The repos for a user, by their login. --- With authentication. --- --- > userRepos' (Just (BasicAuth (user, password))) "mike-burns" All -userRepos' :: Maybe Auth -> Name Owner -> RepoPublicity -> IO (Either Error (Vector Repo)) -userRepos' auth user publicity = - executeRequestMaybe auth $ userReposR user publicity Nothing - -- | List user repositories. --- See -userReposR :: Name Owner -> RepoPublicity -> Maybe Count -> Request k(Vector Repo) +-- See +userReposR :: Name Owner -> RepoPublicity -> FetchCount -> Request k(Vector Repo) userReposR user publicity = - PagedQuery ["users", toPathPart user, "repos"] qs + pagedQuery ["users", toPathPart user, "repos"] qs where qs = repoPublicityQueryString publicity --- | The repos for an organization, by the organization name. --- --- > organizationRepos "thoughtbot" -organizationRepos :: Name Organization -> IO (Either Error (Vector Repo)) -organizationRepos org = organizationRepos' Nothing org RepoPublicityAll - --- | The repos for an organization, by the organization name. --- With authentication. --- --- > organizationRepos (Just (BasicAuth (user, password))) "thoughtbot" All -organizationRepos' :: Maybe Auth -> Name Organization -> RepoPublicity -> IO (Either Error (Vector Repo)) -organizationRepos' auth org publicity = - executeRequestMaybe auth $ organizationReposR org publicity Nothing - -- | List organization repositories. --- See -organizationReposR :: Name Organization -> RepoPublicity -> Maybe Count -> Request k (Vector Repo) +-- See +organizationReposR + :: Name Organization + -> RepoPublicity + -> FetchCount + -> Request k (Vector Repo) organizationReposR org publicity = - PagedQuery ["orgs", toPathPart org, "repos"] qs + pagedQuery ["orgs", toPathPart org, "repos"] qs where qs = repoPublicityQueryString publicity --- | Details on a specific repo, given the owner and repo name. --- --- > userRepo "mike-burns" "github" -repository :: Name Owner -> Name Repo -> IO (Either Error Repo) -repository = repository' Nothing - --- | Details on a specific repo, given the owner and repo name. --- With authentication. --- --- > userRepo' (Just (BasicAuth (user, password))) "mike-burns" "github" -repository' :: Maybe Auth -> Name Owner -> Name Repo -> IO (Either Error Repo) -repository' auth user repo = - executeRequestMaybe auth $ repositoryR user repo - -- | Query single repository. -- See repositoryR :: Name Owner -> Name Repo -> Request k Repo repositoryR user repo = - Query ["repos", toPathPart user, toPathPart repo] [] - --- | Create a new repository. --- --- > createRepo' (BasicAuth (user, password)) (newRepo "some_repo") {newRepoHasIssues = Just False} -createRepo' :: Auth -> NewRepo -> IO (Either Error Repo) -createRepo' auth nrepo = - executeRequest auth $ createRepoR nrepo + query ["repos", toPathPart user, toPathPart repo] [] -- | Create a new repository. -- See -createRepoR :: NewRepo -> Request 'True Repo +createRepoR :: NewRepo -> Request 'RW Repo createRepoR nrepo = - Command Post ["user", "repos"] (encode nrepo) + command Post ["user", "repos"] (encode nrepo) --- | Create a new repository for an organization. --- --- > createOrganizationRepo (BasicAuth (user, password)) "thoughtbot" (newRepo "some_repo") {newRepoHasIssues = Just False} -createOrganizationRepo' :: Auth -> Name Organization -> NewRepo -> IO (Either Error Repo) -createOrganizationRepo' auth org nrepo = - executeRequest auth $ createOrganizationRepoR org nrepo +-- | 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 'True Repo +createOrganizationRepoR :: Name Organization -> NewRepo -> Request 'RW Repo createOrganizationRepoR org nrepo = - Command Post ["orgs", toPathPart org, "repos"] (encode nrepo) - --- | Edit an existing repository. --- --- > editRepo (BasicAuth (user, password)) "some_user" "some_repo" def {editDescription = Just "some description"} -editRepo :: Auth - -> Name Owner -- ^ owner - -> Name Repo -- ^ repository name - -> EditRepo - -> IO (Either Error Repo) -editRepo auth user repo body = - executeRequest auth $ editRepoR user repo body - + command Post ["orgs", toPathPart org, "repos"] (encode nrepo) -- | Edit an existing repository. -- See -editRepoR :: Name Owner -> Name Repo -> EditRepo -> Request 'True Repo +editRepoR :: Name Owner -> Name Repo -> EditRepo -> Request 'RW Repo editRepoR user repo body = - Command Patch ["repos", toPathPart user, toPathPart repo] (encode b) + command Patch ["repos", toPathPart user, toPathPart repo] (encode b) where -- if no name is given, use curent name b = body {editName = editName body <|> Just repo} --- | The contributors to a repo, given the owner and repo name. --- --- > contributors "thoughtbot" "paperclip" -contributors :: Name Owner -> Name Repo -> IO (Either Error (Vector Contributor)) -contributors = contributors' Nothing - --- | The contributors to a repo, given the owner and repo name. --- With authentication. --- --- > contributors' (Just (BasicAuth (user, password))) "thoughtbot" "paperclip" -contributors' :: Maybe Auth -> Name Owner -> Name Repo -> IO (Either Error (Vector Contributor)) -contributors' auth user repo = - executeRequestMaybe auth $ contributorsR user repo False Nothing - -- | List contributors. -- See -contributorsR :: Name Owner - -> Name Repo - -> Bool -- ^ Include anonymous - -> Maybe Count - -> Request k (Vector Contributor) +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 + pagedQuery ["repos", toPathPart user, toPathPart repo, "contributors"] qs where qs | anon = [("anon", Just "true")] | otherwise = [] --- | The contributors to a repo, including anonymous contributors (such as --- deleted users or git commits with unknown email addresses), given the owner --- and repo name. --- --- > contributorsWithAnonymous "thoughtbot" "paperclip" -contributorsWithAnonymous :: Name Owner -> Name Repo -> IO (Either Error (Vector Contributor)) -contributorsWithAnonymous = contributorsWithAnonymous' Nothing - --- | The contributors to a repo, including anonymous contributors (such as --- deleted users or git commits with unknown email addresses), given the owner --- and repo name. --- With authentication. --- --- > contributorsWithAnonymous' (Just (BasicAuth (user, password))) "thoughtbot" "paperclip" -contributorsWithAnonymous' :: Maybe Auth -> Name Owner -> Name Repo -> IO (Either Error (Vector Contributor)) -contributorsWithAnonymous' auth user repo = - executeRequestMaybe auth $ contributorsR user repo True Nothing - --- | The programming languages used in a repo along with the number of --- characters written in that language. Takes the repo owner and name. --- --- > languagesFor "mike-burns" "ohlaunch" -languagesFor :: Name Owner -> Name Repo -> IO (Either Error Languages) -languagesFor = languagesFor' Nothing - --- | The programming languages used in a repo along with the number of --- characters written in that language. Takes the repo owner and name. --- With authentication. --- --- > languagesFor' (Just (BasicAuth (user, password))) "mike-burns" "ohlaunch" -languagesFor' :: Maybe Auth -> Name Owner -> Name Repo -> IO (Either Error Languages) -languagesFor' auth user repo = - executeRequestMaybe auth $ languagesForR user repo - -- | List languages. -- See languagesForR :: Name Owner -> Name Repo -> Request k Languages languagesForR user repo = - Query ["repos", toPathPart user, toPathPart repo, "languages"] [] - --- | The git tags on a repo, given the repo owner and name. --- --- > tagsFor "thoughtbot" "paperclip" -tagsFor :: Name Owner -> Name Repo -> IO (Either Error (Vector Tag)) -tagsFor = tagsFor' Nothing - --- | The git tags on a repo, given the repo owner and name. --- With authentication. --- --- > tagsFor' (Just (BasicAuth (user, password))) "thoughtbot" "paperclip" -tagsFor' :: Maybe Auth -> Name Owner -> Name Repo -> IO (Either Error (Vector Tag)) -tagsFor' auth user repo = - executeRequestMaybe auth $ tagsForR user repo Nothing + query ["repos", toPathPart user, toPathPart repo, "languages"] [] -- | List tags. -- See -tagsForR :: Name Owner -> Name Repo -> Maybe Count -> Request k (Vector Tag) +tagsForR :: Name Owner -> Name Repo -> FetchCount -> Request k (Vector Tag) tagsForR user repo = - PagedQuery ["repos", toPathPart user, toPathPart repo, "tags"] [] - --- | The git branches on a repo, given the repo owner and name. --- --- > branchesFor "thoughtbot" "paperclip" -branchesFor :: Name Owner -> Name Repo -> IO (Either Error (Vector Branch)) -branchesFor = branchesFor' Nothing - --- | The git branches on a repo, given the repo owner and name. --- With authentication. --- --- > branchesFor' (Just (BasicAuth (user, password))) "thoughtbot" "paperclip" -branchesFor' :: Maybe Auth -> Name Owner -> Name Repo -> IO (Either Error (Vector Branch)) -branchesFor' auth user repo = - executeRequestMaybe auth $ branchesForR user repo Nothing + pagedQuery ["repos", toPathPart user, toPathPart repo, "tags"] [] -- | List branches. -- See -branchesForR :: Name Owner -> Name Repo -> Maybe Count -> Request k (Vector Branch) +branchesForR :: Name Owner -> Name Repo -> FetchCount -> Request k (Vector Branch) branchesForR user repo = - PagedQuery ["repos", toPathPart user, toPathPart repo, "branches"] [] - --- | The contents of a file or directory in a repo, given the repo owner, name, and path to the file --- --- > contentsFor "thoughtbot" "paperclip" "README.md" -contentsFor :: Name Owner -> Name Repo -> String -> Maybe String -> IO (Either Error Content) -contentsFor = contentsFor' Nothing - --- | The contents of a file or directory in a repo, given the repo owner, name, and path to the file --- With Authentication --- --- > contentsFor' (Just (BasicAuth (user, password))) "thoughtbot" "paperclip" "README.md" Nothing -contentsFor' :: Maybe Auth -> Name Owner -> Name Repo -> String -> Maybe String -> IO (Either Error Content) -contentsFor' auth user repo path ref = - executeRequestMaybe auth $ contentsForR user repo path ref - -contentsForR :: Name Owner - -> Name Repo - -> String -- ^ file or directory - -> Maybe String -- ^ 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 . BS8.pack $ r)]) ref - --- | The contents of a README file in a repo, given the repo owner and name --- --- > readmeFor "thoughtbot" "paperclip" -readmeFor :: Name Owner -> Name Repo -> IO (Either Error Content) -readmeFor = readmeFor' Nothing - --- | The contents of a README file in a repo, given the repo owner and name --- With Authentication --- --- > readmeFor' (Just (BasicAuth (user, password))) "thoughtbot" "paperclip" -readmeFor' :: Maybe Auth -> Name Owner -> Name Repo -> IO (Either Error Content) -readmeFor' auth user repo = - executeRequestMaybe auth $ readmeForR user repo - -readmeForR :: Name Owner -> Name Repo -> Request k Content -readmeForR user repo = - Query ["repos", toPathPart user, toPathPart repo, "readme"] [] - --- | Delete an existing repository. --- --- > deleteRepo (BasicAuth (user, password)) "thoughtbot" "some_repo" -deleteRepo :: Auth -> Name Owner -> Name Repo -> IO (Either Error ()) -deleteRepo auth user repo = - executeRequest auth $ deleteRepoR user repo + pagedQuery ["repos", toPathPart user, toPathPart repo, "branches"] [] -deleteRepoR :: Name Owner -> Name Repo -> Request 'True () +-- | 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 index 34ffca78..f587636d 100644 --- a/src/GitHub/Endpoints/Repos/Collaborators.hs +++ b/src/GitHub/Endpoints/Repos/Collaborators.hs @@ -1,59 +1,51 @@ ------------------------------------------------------------------------------ -- | --- License : BSD-3-Clause --- Maintainer : Oleg Grenrus --- -- The repo collaborators API as described on -- . + module GitHub.Endpoints.Repos.Collaborators ( - collaboratorsOn, - collaboratorsOn', collaboratorsOnR, - isCollaboratorOn, + collaboratorPermissionOnR, isCollaboratorOnR, + addCollaboratorR, module GitHub.Data, ) where -import Data.Vector (Vector) import GitHub.Data -import GitHub.Request - --- | All the users who have collaborated on a repo. --- --- > collaboratorsOn "thoughtbot" "paperclip" -collaboratorsOn :: Name Owner -> Name Repo -> IO (Either Error (Vector SimpleUser)) -collaboratorsOn = collaboratorsOn' Nothing - --- | All the users who have collaborated on a repo. --- With authentication. -collaboratorsOn' :: Maybe Auth -> Name Owner -> Name Repo -> IO (Either Error (Vector SimpleUser)) -collaboratorsOn' auth user repo = - executeRequestMaybe auth $ collaboratorsOnR user repo Nothing +import GitHub.Internal.Prelude +import Prelude () -- | List collaborators. -- See -collaboratorsOnR :: Name Owner -> Name Repo -> Maybe Count -> Request k (Vector SimpleUser) +collaboratorsOnR :: Name Owner -> Name Repo -> FetchCount -> Request k (Vector SimpleUser) collaboratorsOnR user repo = - PagedQuery ["repos", toPathPart user, toPathPart repo, "collaborators"] [] + pagedQuery ["repos", toPathPart user, toPathPart repo, "collaborators"] [] --- | Whether the user is collaborating on a repo. Takes the user in question, --- the user who owns the repo, and the repo name. --- --- > isCollaboratorOn Nothing "mike-burns" "thoughtbot" "paperclip" --- > isCollaboratorOn Nothing "johnson" "thoughtbot" "paperclip" -isCollaboratorOn :: Maybe Auth - -> Name Owner -- ^ Repository owner - -> Name Repo -- ^ Repository name - -> Name User -- ^ Collaborator? - -> IO (Either Error Bool) -isCollaboratorOn auth user repo coll = - executeRequestMaybe auth $ isCollaboratorOnR user repo coll +-- | 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? - -> Request k Bool -isCollaboratorOnR user repo coll = StatusQuery StatusOnlyOk $ +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 index 95966ec6..bd554492 100644 --- a/src/GitHub/Endpoints/Repos/Comments.hs +++ b/src/GitHub/Endpoints/Repos/Comments.hs @@ -1,83 +1,32 @@ -{-# LANGUAGE CPP #-} ------------------------------------------------------------------------------ -- | --- License : BSD-3-Clause --- Maintainer : Oleg Grenrus --- -- The repo commits API as described on -- . + module GitHub.Endpoints.Repos.Comments ( - commentsFor, - commentsFor', commentsForR, - commitCommentsFor, - commitCommentsFor', commitCommentsForR, - commitCommentFor, - commitCommentFor', commitCommentForR, module GitHub.Data, ) where -import Data.Vector (Vector) import GitHub.Data -import GitHub.Request - --- | All the comments on a Github repo. --- --- > commentsFor "thoughtbot" "paperclip" -commentsFor :: Name Owner -> Name Repo -> IO (Either Error (Vector Comment)) -commentsFor = commentsFor' Nothing - --- | All the comments on a Github repo. --- With authentication. --- --- > commentsFor "thoughtbot" "paperclip" -commentsFor' :: Maybe Auth -> Name Owner -> Name Repo -> IO (Either Error (Vector Comment)) -commentsFor' auth user repo = - executeRequestMaybe auth $ commentsForR user repo Nothing +import GitHub.Internal.Prelude +import Prelude () -- | List commit comments for a repository. -- See -commentsForR :: Name Owner -> Name Repo -> Maybe Count -> Request k (Vector Comment) +commentsForR :: Name Owner -> Name Repo -> FetchCount -> Request k (Vector Comment) commentsForR user repo = - PagedQuery ["repos", toPathPart user, toPathPart repo, "comments"] [] - --- | Just the comments on a specific SHA for a given Github repo. --- --- > commitCommentsFor "thoughtbot" "paperclip" "41f685f6e01396936bb8cd98e7cca517e2c7d96b" -commitCommentsFor :: Name Owner -> Name Repo -> Name Commit -> IO (Either Error (Vector Comment)) -commitCommentsFor = commitCommentsFor' Nothing - --- | Just the comments on a specific SHA for a given Github repo. --- With authentication. --- --- > commitCommentsFor "thoughtbot" "paperclip" "41f685f6e01396936bb8cd98e7cca517e2c7d96b" -commitCommentsFor' :: Maybe Auth -> Name Owner -> Name Repo -> Name Commit -> IO (Either Error (Vector Comment)) -commitCommentsFor' auth user repo sha = - executeRequestMaybe auth $ commitCommentsForR user repo sha Nothing + pagedQuery ["repos", toPathPart user, toPathPart repo, "comments"] [] -- | List comments for a single commit. -- See -commitCommentsForR :: Name Owner -> Name Repo -> Name Commit -> Maybe Count -> Request k (Vector Comment) +commitCommentsForR :: Name Owner -> Name Repo -> Name Commit -> FetchCount -> Request k (Vector Comment) commitCommentsForR user repo sha = - PagedQuery ["repos", toPathPart user, toPathPart repo, "commits", toPathPart sha, "comments"] [] - --- | A comment, by its ID, relative to the Github repo. --- --- > commitCommentFor "thoughtbot" "paperclip" "669575" -commitCommentFor :: Name Owner -> Name Repo -> Id Comment -> IO (Either Error Comment) -commitCommentFor = commitCommentFor' Nothing - --- | A comment, by its ID, relative to the Github repo. --- --- > commitCommentFor "thoughtbot" "paperclip" "669575" -commitCommentFor' :: Maybe Auth -> Name Owner -> Name Repo -> Id Comment -> IO (Either Error Comment) -commitCommentFor' auth user repo cid = - executeRequestMaybe auth $ commitCommentForR user repo cid + 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] [] + 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 index 16a68c0e..1c50c651 100644 --- a/src/GitHub/Endpoints/Repos/Commits.hs +++ b/src/GitHub/Endpoints/Repos/Commits.hs @@ -1,121 +1,52 @@ -{-# LANGUAGE CPP #-} -{-# LANGUAGE OverloadedStrings #-} ------------------------------------------------------------------------------ -- | --- License : BSD-3-Clause --- Maintainer : Oleg Grenrus --- -- The repo commits API as described on -- . + module GitHub.Endpoints.Repos.Commits ( CommitQueryOption(..), - commitsFor, - commitsFor', commitsForR, - commitsWithOptionsFor, - commitsWithOptionsFor', commitsWithOptionsForR, - commit, - commit', commitR, - diff, - diff', diffR, module GitHub.Data, ) where -import Data.Time.ISO8601 (formatISO8601) -import Data.Vector (Vector) - -import qualified Data.ByteString as BS -import qualified Data.ByteString.Char8 as BS8 -import qualified Data.Text.Encoding as TE - import GitHub.Data -import GitHub.Request +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 $ BS8.pack $ formatISO8601 date) -renderCommitQueryOption (CommitQueryUntil date) = ("until", Just $ BS8.pack $ formatISO8601 date) - --- | The commit history for a repo. --- --- > commitsFor "mike-burns" "github" -commitsFor :: Name Owner -> Name Repo -> IO (Either Error (Vector Commit)) -commitsFor = commitsFor' Nothing - --- | The commit history for a repo. --- With authentication. --- --- > commitsFor' (Just (BasicAuth (user, password))) "mike-burns" "github" -commitsFor' :: Maybe Auth -> Name Owner -> Name Repo -> IO (Either Error (Vector Commit)) -commitsFor' auth user repo = - commitsWithOptionsFor' auth user repo [] +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 -> Maybe Count -> Request k (Vector Commit) +commitsForR :: Name Owner -> Name Repo -> FetchCount -> Request k (Vector Commit) commitsForR user repo limit = commitsWithOptionsForR user repo limit [] -commitsWithOptionsFor :: Name Owner -> Name Repo -> [CommitQueryOption] -> IO (Either Error (Vector Commit)) -commitsWithOptionsFor = commitsWithOptionsFor' Nothing - --- | The commit history for a repo, with commits filtered to satisfy a list of --- query options. --- With authentication. --- --- > commitsWithOptionsFor' (Just (BasicAuth (user, password))) "mike-burns" "github" [CommitQueryAuthor "djeik"] -commitsWithOptionsFor' :: Maybe Auth -> Name Owner -> Name Repo -> [CommitQueryOption] -> IO (Either Error (Vector Commit)) -commitsWithOptionsFor' auth user repo opts = - executeRequestMaybe auth $ commitsWithOptionsForR user repo Nothing opts - -- | List commits on a repository. -- See -commitsWithOptionsForR :: Name Owner -> Name Repo -> Maybe Count -> [CommitQueryOption] -> Request k (Vector Commit) +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 + pagedQuery ["repos", toPathPart user, toPathPart repo, "commits"] qs limit where qs = map renderCommitQueryOption opts - --- | Details on a specific SHA1 for a repo. --- --- > commit "mike-burns" "github" "9d1a9a361266c3c890b1108ad2fdf52f824b1b81" -commit :: Name Owner -> Name Repo -> Name Commit -> IO (Either Error Commit) -commit = commit' Nothing - --- | Details on a specific SHA1 for a repo. --- With authentication. --- --- > commit (Just $ BasicAuth (username, password)) "mike-burns" "github" "9d1a9a361266c3c890b1108ad2fdf52f824b1b81" -commit' :: Maybe Auth -> Name Owner -> Name Repo -> Name Commit -> IO (Either Error Commit) -commit' auth user repo sha = - executeRequestMaybe auth $ commitR user repo sha - -- | Query a single commit. -- See commitR :: Name Owner -> Name Repo -> Name Commit -> Request k Commit commitR user repo sha = - Query ["repos", toPathPart user, toPathPart repo, "commits", toPathPart sha] [] - --- | The diff between two treeishes on a repo. --- --- > diff "thoughtbot" "paperclip" "41f685f6e01396936bb8cd98e7cca517e2c7d96b" "HEAD" -diff :: Name Owner -> Name Repo -> Name Commit -> Name Commit -> IO (Either Error Diff) -diff = diff' Nothing - --- | The diff between two treeishes on a repo. --- --- > diff "thoughtbot" "paperclip" "41f685f6e01396936bb8cd98e7cca517e2c7d96b" "HEAD" -diff' :: Maybe Auth -> Name Owner -> Name Repo -> Name Commit -> Name Commit -> IO (Either Error Diff) -diff' auth user repo base headref = - executeRequestMaybe auth $ diffR user repo base headref + 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] [] + 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 index a8734a5c..c9b56e30 100644 --- a/src/GitHub/Endpoints/Repos/Forks.hs +++ b/src/GitHub/Endpoints/Repos/Forks.hs @@ -1,37 +1,18 @@ ------------------------------------------------------------------------------ -- | --- License : BSD-3-Clause --- Maintainer : Oleg Grenrus --- -- Hot forking action, as described at -- . + module GitHub.Endpoints.Repos.Forks ( - forksFor, - forksFor', forksForR, module GitHub.Data, ) where -import Data.Vector (Vector) import GitHub.Data -import GitHub.Request - --- | All the repos that are forked off the given repo. --- --- > forksFor "thoughtbot" "paperclip" -forksFor :: Name Owner -> Name Repo -> IO (Either Error (Vector Repo)) -forksFor = forksFor' Nothing - --- | All the repos that are forked off the given repo. --- | With authentication --- --- > forksFor' (Just (User (user, password))) "thoughtbot" "paperclip" -forksFor' :: Maybe Auth -> Name Owner -> Name Repo -> IO (Either Error (Vector Repo)) -forksFor' auth user repo = - executeRequestMaybe auth $ forksForR user repo Nothing +import GitHub.Internal.Prelude +import Prelude () -- | List forks. -- See -forksForR :: Name Owner -> Name Repo -> Maybe Count -> Request k (Vector Repo) +forksForR :: Name Owner -> Name Repo -> FetchCount -> Request k (Vector Repo) forksForR user repo = - PagedQuery ["repos", toPathPart user, toPathPart repo, "forks"] [] + 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 index fa225ac5..402fb4af 100644 --- a/src/GitHub/Endpoints/Repos/Webhooks.hs +++ b/src/GitHub/Endpoints/Repos/Webhooks.hs @@ -1,121 +1,75 @@ -{-# LANGUAGE DataKinds #-} ------------------------------------------------------------------------------ -- | --- License : BSD-3-Clause --- Maintainer : Oleg Grenrus --- -- The webhooks API, as described at -- -- + module GitHub.Endpoints.Repos.Webhooks ( -- * Querying repositories - webhooksFor', webhooksForR, - webhookFor', webhookForR, -- ** Create - createRepoWebhook', createRepoWebhookR, -- ** Edit - editRepoWebhook', editRepoWebhookR, -- ** Test - testPushRepoWebhook', testPushRepoWebhookR, - pingRepoWebhook', pingRepoWebhookR, -- ** Delete - deleteRepoWebhook', deleteRepoWebhookR, ) where -import Prelude () -import Prelude.Compat - -import Data.Aeson.Compat (encode) -import Data.Vector (Vector) - import GitHub.Data -import GitHub.Request - -webhooksFor' :: Auth -> Name Owner -> Name Repo -> IO (Either Error (Vector RepoWebhook)) -webhooksFor' auth user repo = - executeRequest auth $ webhooksForR user repo Nothing +import GitHub.Internal.Prelude +import Prelude () -- | List hooks. -- See -webhooksForR :: Name Owner -> Name Repo -> Maybe Count -> Request k (Vector RepoWebhook) +webhooksForR :: Name Owner -> Name Repo -> FetchCount -> Request k (Vector RepoWebhook) webhooksForR user repo = - PagedQuery ["repos", toPathPart user, toPathPart repo, "hooks"] [] - -webhookFor' :: Auth -> Name Owner -> Name Repo -> Id RepoWebhook -> IO (Either Error RepoWebhook) -webhookFor' auth user repo hookId = - executeRequest auth $ webhookForR user repo hookId - --- | Query single hook. + 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] [] - -createRepoWebhook' :: Auth -> Name Owner -> Name Repo -> NewRepoWebhook -> IO (Either Error RepoWebhook) -createRepoWebhook' auth user repo hook = - executeRequest auth $ createRepoWebhookR user repo hook + query ["repos", toPathPart user, toPathPart repo, "hooks", toPathPart hookId] [] -- | Create a hook. -- See -createRepoWebhookR :: Name Owner -> Name Repo -> NewRepoWebhook -> Request 'True RepoWebhook +createRepoWebhookR :: Name Owner -> Name Repo -> NewRepoWebhook -> Request 'RW RepoWebhook createRepoWebhookR user repo hook = - Command Post ["repos", toPathPart user, toPathPart repo, "hooks"] (encode hook) - -editRepoWebhook' :: Auth -> Name Owner -> Name Repo -> Id RepoWebhook -> EditRepoWebhook -> IO (Either Error RepoWebhook) -editRepoWebhook' auth user repo hookId hookEdit = - executeRequest auth $ editRepoWebhookR user repo hookId hookEdit + command Post ["repos", toPathPart user, toPathPart repo, "hooks"] (encode hook) -- | Edit a hook. -- See -editRepoWebhookR :: Name Owner -> Name Repo -> Id RepoWebhook -> EditRepoWebhook -> Request 'True RepoWebhook +editRepoWebhookR :: Name Owner -> Name Repo -> Id RepoWebhook -> EditRepoWebhook -> Request 'RW RepoWebhook editRepoWebhookR user repo hookId hookEdit = - Command Patch ["repos", toPathPart user, toPathPart repo, "hooks", toPathPart hookId] (encode hookEdit) - -testPushRepoWebhook' :: Auth -> Name Owner -> Name Repo -> Id RepoWebhook -> IO (Either Error Bool) -testPushRepoWebhook' auth user repo hookId = - executeRequest auth $ testPushRepoWebhookR user repo hookId + command Patch ["repos", toPathPart user, toPathPart repo, "hooks", toPathPart hookId] (encode hookEdit) -- | Test a push hook. -- See -testPushRepoWebhookR :: Name Owner -> Name Repo -> Id RepoWebhook -> Request 'True Bool -testPushRepoWebhookR user repo hookId = StatusQuery StatusOnlyOk $ +testPushRepoWebhookR :: Name Owner -> Name Repo -> Id RepoWebhook -> GenRequest 'MtStatus 'RW Bool +testPushRepoWebhookR user repo hookId = Command Post (createWebhookOpPath user repo hookId $ Just "tests") (encode ()) -pingRepoWebhook' :: Auth -> Name Owner -> Name Repo -> Id RepoWebhook -> IO (Either Error Bool) -pingRepoWebhook' auth user repo hookId = - executeRequest auth $ pingRepoWebhookR user repo hookId - -- | Ping a hook. -- See -pingRepoWebhookR :: Name Owner -> Name Repo -> Id RepoWebhook -> Request 'True Bool -pingRepoWebhookR user repo hookId = StatusQuery StatusOnlyOk $ +pingRepoWebhookR :: Name Owner -> Name Repo -> Id RepoWebhook -> GenRequest 'MtStatus 'RW Bool +pingRepoWebhookR user repo hookId = Command Post (createWebhookOpPath user repo hookId $ Just "pings") (encode ()) -deleteRepoWebhook' :: Auth -> Name Owner -> Name Repo -> Id RepoWebhook -> IO (Either Error ()) -deleteRepoWebhook' auth user repo hookId = - executeRequest auth $ deleteRepoWebhookR user repo hookId - -- | Delete a hook. -- See -deleteRepoWebhookR :: Name Owner -> Name Repo -> Id RepoWebhook -> Request 'True () +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 -> [String] +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 String -> [String] +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 index e92230a9..06ddd373 100644 --- a/src/GitHub/Endpoints/Search.hs +++ b/src/GitHub/Endpoints/Search.hs @@ -1,84 +1,41 @@ -{-# LANGUAGE OverloadedStrings #-} ------------------------------------------------------------------------------ -- | --- License : BSD-3-Clause --- Maintainer : Oleg Grenrus --- -- The Github Search API, as described at -- . + module GitHub.Endpoints.Search( - searchRepos', - searchRepos, searchReposR, - searchCode', - searchCode, searchCodeR, - searchIssues', - searchIssues, searchIssuesR, + searchUsersR, module GitHub.Data, ) where -import Data.Text (Text) - -import qualified Data.Text.Encoding as TE - import GitHub.Data -import GitHub.Request - --- | Perform a repository search. --- With authentication. --- --- > searchRepos' (Just $ BasicAuth "github-username" "github-password') "a in%3Aname language%3Ahaskell created%3A>2013-10-01&per_page=100" -searchRepos' :: Maybe Auth -> Text -> IO (Either Error (SearchResult Repo)) -searchRepos' auth = executeRequestMaybe auth . searchReposR +import GitHub.Internal.Prelude +import Prelude () --- | Perform a repository search. --- Without authentication. --- --- > searchRepos "q=a in%3Aname language%3Ahaskell created%3A>2013-10-01&per_page=100" -searchRepos :: Text -> IO (Either Error (SearchResult Repo)) -searchRepos = searchRepos' Nothing +import qualified Data.Text.Encoding as TE -- | Search repositories. -- See -searchReposR :: Text -> Request k (SearchResult Repo) -searchReposR searchString = Query ["search", "repositories"] [("q", Just $ TE.encodeUtf8 searchString)] - --- | Perform a code search. --- With authentication. --- --- > searchCode' (Just $ BasicAuth "github-username" "github-password') "a in%3Aname language%3Ahaskell created%3A>2013-10-01&per_page=100" -searchCode' :: Maybe Auth -> Text -> IO (Either Error (SearchResult Code)) -searchCode' auth = executeRequestMaybe auth . searchCodeR - --- | Perform a code search. --- Without authentication. --- --- > searchCode "q=addClass+in:file+language:js+repo:jquery/jquery" -searchCode :: Text -> IO (Either Error (SearchResult Code)) -searchCode = searchCode' Nothing +searchReposR :: Text -> FetchCount -> Request k (SearchResult Repo) +searchReposR searchString = + PagedQuery ["search", "repositories"] [("q", Just $ TE.encodeUtf8 searchString)] -- | Search code. -- See -searchCodeR :: Text -> Request k (SearchResult Code) -searchCodeR searchString = Query ["search", "code"] [("q", Just $ TE.encodeUtf8 searchString)] - --- | Perform an issue search. --- With authentication. --- --- > searchIssues' (Just $ BasicAuth "github-username" "github-password') "a repo%3Aphadej%2Fgithub&per_page=100" -searchIssues' :: Maybe Auth -> Text -> IO (Either Error (SearchResult Issue)) -searchIssues' auth = executeRequestMaybe auth . searchIssuesR - --- | Perform an issue search. --- Without authentication. --- --- > searchIssues "q=a repo%3Aphadej%2Fgithub&per_page=100" -searchIssues :: Text -> IO (Either Error (SearchResult Issue)) -searchIssues = searchIssues' Nothing +searchCodeR :: Text -> FetchCount -> Request k (SearchResult Code) +searchCodeR searchString = + PagedQuery ["search", "code"] [("q", Just $ TE.encodeUtf8 searchString)] -- | Search issues. -- See -searchIssuesR :: Text -> Request k (SearchResult Issue) -searchIssuesR searchString = Query ["search", "issues"] [("q", Just $ TE.encodeUtf8 searchString)] +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 index 19876dab..85f5e68e 100644 --- a/src/GitHub/Endpoints/Users.hs +++ b/src/GitHub/Endpoints/Users.hs @@ -1,55 +1,35 @@ -{-# LANGUAGE DataKinds #-} ------------------------------------------------------------------------------ -- | --- License : BSD-3-Clause --- Maintainer : Oleg Grenrus --- -- The Github Users API, as described at -- . + module GitHub.Endpoints.Users ( - userInfoFor, - userInfoFor', userInfoForR, ownerInfoForR, - userInfoCurrent', userInfoCurrentR, module GitHub.Data, ) where import GitHub.Data -import GitHub.Request - --- | The information for a single user, by login name. --- With authentification --- --- > userInfoFor' (Just ("github-username", "github-password")) "mike-burns" -userInfoFor' :: Maybe Auth -> Name User -> IO (Either Error User) -userInfoFor' auth = executeRequestMaybe auth . userInfoForR - --- | The information for a single user, by login name. --- --- > userInfoFor "mike-burns" -userInfoFor :: Name User -> IO (Either Error User) -userInfoFor = executeRequest' . userInfoForR +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] [] +userInfoForR user = query ["users", toPathPart user] [] -- | Query a single user or an organization. -- See ownerInfoForR :: Name Owner -> Request k Owner -ownerInfoForR owner = Query ["users", toPathPart owner] [] - --- | Retrieve information about the user associated with the supplied authentication. --- --- > userInfoCurrent' (OAuth "...") -userInfoCurrent' :: Auth -> IO (Either Error User) -userInfoCurrent' auth = - executeRequest auth $ userInfoCurrentR +ownerInfoForR owner = query ["users", toPathPart owner] [] -- | Query the authenticated user. -- See -userInfoCurrentR :: Request 'True User -userInfoCurrentR = Query ["user"] [] +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 index b1ee7690..13f8b494 100644 --- a/src/GitHub/Endpoints/Users/Followers.hs +++ b/src/GitHub/Endpoints/Users/Followers.hs @@ -1,43 +1,25 @@ ------------------------------------------------------------------------------ -- | --- License : BSD-3-Clause --- Maintainer : Oleg Grenrus --- -- The user followers API as described on -- . + module GitHub.Endpoints.Users.Followers ( - usersFollowing, - usersFollowedBy, usersFollowingR, usersFollowedByR, module GitHub.Data, ) where -import Data.Vector (Vector) - import GitHub.Data -import GitHub.Request - --- | All the users following the given user. --- --- > usersFollowing "mike-burns" -usersFollowing :: Name User -> IO (Either Error (Vector SimpleUser)) -usersFollowing user = - executeRequest' $ usersFollowingR user Nothing +import GitHub.Internal.Prelude +import Prelude () -- | List followers of a user. -- See -usersFollowingR :: Name User -> Maybe Count -> Request k (Vector SimpleUser) -usersFollowingR user = PagedQuery ["users", toPathPart user, "followers"] [] - --- | All the users that the given user follows. --- --- > usersFollowedBy "mike-burns" -usersFollowedBy :: Name User -> IO (Either Error (Vector SimpleUser)) -usersFollowedBy user = - executeRequest' $ usersFollowedByR user Nothing +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 -> Maybe Count -> Request k (Vector SimpleUser) -usersFollowedByR user = PagedQuery ["users", toPathPart user, "following"] [] +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 index d1118153..39deb0a6 100644 --- a/src/GitHub/Request.hs +++ b/src/GitHub/Request.hs @@ -1,18 +1,13 @@ -{-# LANGUAGE CPP #-} -{-# LANGUAGE DataKinds #-} -{-# LANGUAGE DeriveDataTypeable #-} -{-# LANGUAGE DeriveGeneric #-} -{-# LANGUAGE FlexibleContexts #-} -{-# LANGUAGE GADTs #-} -{-# LANGUAGE KindSignatures #-} -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE ScopedTypeVariables #-} -{-# LANGUAGE StandaloneDeriving #-} ------------------------------------------------------------------------------ +{-# LANGUAGE CPP #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE FunctionalDependencies #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE KindSignatures #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE UndecidableInstances #-} + -- | --- License : BSD-3-Clause --- Maintainer : Oleg Grenrus --- -- This module provides data types and helper methods, which makes possible -- to build alternative API request intepreters in addition to provided -- 'IO' functions. @@ -32,9 +27,16 @@ -- > -- | Lift request into Monad -- > githubRequest :: GH.Request 'False a -> GithubMonad a -- > githubRequest = singleton + module GitHub.Request ( + -- * A convenient execution of requests + github, + github', + GitHubRW, + GitHubRO, -- * Types - Request(..), + Request, + GenRequest (..), CommandMethod(..), toMethod, Paths, @@ -42,154 +44,397 @@ module GitHub.Request ( -- * Request execution in IO executeRequest, executeRequestWithMgr, + executeRequestWithMgrAndRes, executeRequest', executeRequestWithMgr', executeRequestMaybe, unsafeDropAuthRequirements, -- * Helpers + Accept (..), + ParseResponse (..), makeHttpRequest, - parseResponse, parseStatus, + parsePageLinks, + StatusMap, getNextUrl, performPagedRequest, + parseResponseJSON, + -- ** Preview + PreviewAccept (..), + PreviewParseResponse (..), + -- * SSL + -- | This always exist, independently of @openssl@ configuration flag. + -- They change accordingly, to make use of the library simpler. + withOpenSSL, + tlsManagerSettings, ) where -import Prelude () -import Prelude.Compat +import GitHub.Internal.Prelude +import Prelude () -#if MIN_VERSION_mtl(2,2,0) -import Control.Monad.Except (MonadError (..)) -#else -import Control.Monad.Error (MonadError (..)) -#endif +import Control.Monad.Error.Class (MonadError (..)) +import Control.Monad (when) import Control.Monad.Catch (MonadCatch (..), MonadThrow) import Control.Monad.Trans.Class (lift) import Control.Monad.Trans.Except (ExceptT (..), runExceptT) -import Data.Aeson.Compat (FromJSON, eitherDecode) -import Data.List (find, intercalate) -import Data.Semigroup (Semigroup (..)) -import Data.Text (Text) -import Data.Vector.Instances () - -import Network.HTTP.Client (CookieJar, HttpException (..), Manager, - RequestBody (..), Response (..), - applyBasicAuth, checkStatus, httpLbs, - method, newManager, parseUrl, requestBody, - requestHeaders, setQueryString) -import Network.HTTP.Client.Internal (setUri) -import Network.HTTP.Client.TLS (tlsManagerSettings) -import Network.HTTP.Link.Parser (parseLinkHeaderBS) -import Network.HTTP.Link.Types (Link (..), LinkParam (..), href, - linkParams) -import Network.HTTP.Types (Method, RequestHeaders, ResponseHeaders, - Status (..)) -import Network.URI (URI) - -import qualified Control.Exception as E -import qualified Data.ByteString.Lazy as LBS -import qualified Data.Text as T -import qualified Data.Vector as V -import qualified Network.HTTP.Client as HTTP - -import GitHub.Auth (Auth (..)) -import GitHub.Data (Error (..)) +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 :: Auth -> Request k a -> IO (Either Error a) -executeRequest auth req = do +executeRequest + :: (AuthMethod am, ParseResponse mt a) + => am + -> GenRequest mt rw a + -> IO (Either Error a) +executeRequest auth req = withOpenSSL $ do manager <- newManager tlsManagerSettings - x <- executeRequestWithMgr manager auth req -#if !MIN_VERSION_http_client(0, 4, 18) - closeManager manager -#endif - pure x + executeRequestWithMgr manager auth req -- | Like 'executeRequest' but with provided 'Manager'. -executeRequestWithMgr :: Manager - -> Auth - -> Request k a - -> IO (Either Error a) -executeRequestWithMgr mgr auth req = runExceptT $ - execute req +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 - execute :: Request k a -> ExceptT Error IO a - execute req' = case req' of - Query {} -> do - httpReq <- makeHttpRequest (Just auth) req - res <- httpLbs' httpReq - parseResponse res - PagedQuery _ _ l -> do - httpReq <- makeHttpRequest (Just auth) req - performPagedRequest httpLbs' predicate httpReq - where - predicate = maybe (const True) (\l' -> (< l') . V.length ) l - Command m _ _ -> do - httpReq <- makeHttpRequest (Just auth) req - res <- httpLbs' httpReq - case m of - Delete -> pure () - _ -> parseResponse res - StatusQuery sm _ -> do - httpReq <- makeHttpRequest (Just auth) req - res <- httpLbs' httpReq - parseStatus sm . responseStatus $ res - HeaderQuery _ r -> do - execute r - httpLbs' :: HTTP.Request -> ExceptT Error IO (Response LBS.ByteString) + httpLbs' :: HTTP.Request -> ExceptT Error IO (HTTP.Response LBS.ByteString) httpLbs' req' = lift (httpLbs req' mgr) `catch` onHttpException + performHttpReq :: 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' :: Request 'False a -> IO (Either Error a) -executeRequest' req = do +executeRequest' :: ParseResponse mt a => GenRequest mt 'RO a -> IO (Either Error a) +executeRequest' req = withOpenSSL $ do manager <- newManager tlsManagerSettings - x <- executeRequestWithMgr' manager req -#if !MIN_VERSION_http_client(0, 4, 18) - closeManager manager -#endif - pure x + executeRequestWithMgr' manager req -- | Like 'executeRequestWithMgr' but without authentication. -executeRequestWithMgr' :: Manager - -> Request 'False a - -> IO (Either Error a) -executeRequestWithMgr' mgr req = runExceptT $ - execute req - where - execute :: Request 'False a -> ExceptT Error IO a - execute req' = case req' of - Query {} -> do - httpReq <- makeHttpRequest Nothing req - res <- httpLbs' httpReq - parseResponse res - PagedQuery _ _ l -> do - httpReq <- makeHttpRequest Nothing req - performPagedRequest httpLbs' predicate httpReq - where - predicate = maybe (const True) (\l' -> (< l') . V.length) l - StatusQuery sm _ -> do - httpReq <- makeHttpRequest Nothing req - res <- httpLbs' httpReq - parseStatus sm . responseStatus $ res - HeaderQuery _ r -> do - execute r - httpLbs' :: HTTP.Request -> ExceptT Error IO (Response LBS.ByteString) - httpLbs' req' = lift (httpLbs req' mgr) `catch` onHttpException +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 :: Maybe Auth -> Request 'False a - -> IO (Either Error a) +executeRequestMaybe + :: (AuthMethod am, ParseResponse mt a) + => Maybe am + -> GenRequest mt 'RO a + -> IO (Either Error a) executeRequestMaybe = maybe executeRequest' executeRequest -- | Partial function to drop authentication need. -unsafeDropAuthRequirements :: Request 'True a -> Request k a +unsafeDropAuthRequirements :: GenRequest mt rw' a -> GenRequest mt rw a unsafeDropAuthRequirements (Query ps qs) = Query ps qs -unsafeDropAuthRequirements r = +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 ------------------------------------------------------------------------------ @@ -200,155 +445,144 @@ unsafeDropAuthRequirements r = -- * for 'Status', the 'Request' for underlying 'Request' is created, -- status checking is modifying accordingly. -- --- @ --- parseResponse :: 'Maybe' 'Auth' -> 'Request' k a -> 'Maybe' 'Request' --- @ -makeHttpRequest :: MonadThrow m - => Maybe Auth - -> Request k a - -> m HTTP.Request +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 - StatusQuery sm req -> do - req' <- makeHttpRequest auth req - return $ setCheckStatus (Just sm) req' Query paths qs -> do - req <- parseUrl $ url paths - return $ setReqHeaders - . setCheckStatus Nothing - . setAuthRequest auth - . setQueryString qs - $ req + 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 - . setCheckStatus Nothing - . setAuthRequest auth - . setQueryString qs - $ req + 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 - . setCheckStatus Nothing - . setAuthRequest auth - . setBody body - . setMethod (toMethod m) - $ req - HeaderQuery h req -> do - req' <- makeHttpRequest auth req - return $ req' { requestHeaders = h <> requestHeaders req' } + 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 - url :: Paths -> String - url paths = baseUrl ++ '/' : intercalate "/" paths + parseUrl' :: MonadThrow m => String -> m HTTP.Request + parseUrl' = HTTP.parseUrlThrow - baseUrl :: String - baseUrl = case auth of - Just (EnterpriseOAuth endpoint _) -> endpoint - _ -> "https://api.github.com" + url :: Paths -> String + url paths = maybe "https://api.github.com" T.unpack (endpoint =<< auth) ++ "/" ++ intercalate "/" paths' where + paths' = map (escapeURIString isUnescapedInURIComponent . T.unpack) paths setReqHeaders :: HTTP.Request -> HTTP.Request setReqHeaders req = req { requestHeaders = reqHeaders <> requestHeaders req } - setCheckStatus :: Maybe (StatusMap a) -> HTTP.Request -> HTTP.Request - setCheckStatus sm req = req { checkStatus = successOrMissing sm } - setMethod :: Method -> HTTP.Request -> HTTP.Request setMethod m req = req { method = m } reqHeaders :: RequestHeaders - reqHeaders = maybe [] getOAuthHeader auth - <> [("User-Agent", "github.hs/0.7.4")] - <> [("Accept", "application/vnd.github.preview")] + reqHeaders = [("User-Agent", "github.hs/" <> fromString (showVersion version))] -- Version + <> [("Accept", unTagged (contentType :: Tagged mt BS.ByteString))] setBody :: LBS.ByteString -> HTTP.Request -> HTTP.Request setBody body req = req { requestBody = RequestBodyLBS body } - setAuthRequest :: Maybe Auth -> HTTP.Request -> HTTP.Request - setAuthRequest (Just (BasicAuth user pass)) = applyBasicAuth user pass - setAuthRequest _ = id - - getOAuthHeader :: Auth -> RequestHeaders - getOAuthHeader (OAuth token) = [("Authorization", "token " <> token)] - getOAuthHeader (EnterpriseOAuth _ token) = [("Authorization", "token " <> token)] - getOAuthHeader _ = [] - - successOrMissing :: Maybe (StatusMap a) -> Status -> ResponseHeaders -> CookieJar -> Maybe E.SomeException - successOrMissing sm s@(Status sci _) hs cookiejar - | check = Nothing - | otherwise = Just $ E.toException $ StatusCodeException s hs cookiejar - where - check = case sm of - Nothing -> 200 <= sci && sci < 300 - Just StatusOnlyOk -> sci == 204 || sci == 404 - Just StatusMerge -> sci `elem` [204, 405, 409] + extraQueryItems :: [(BS.ByteString, Maybe BS.ByteString)] + extraQueryItems = case r of + PagedQuery _ _ (FetchPage pp) -> catMaybes [ + (\page -> ("page", Just (LBS.toStrict $ toLazyByteString $ intDec page))) <$> pageParamsPage pp + , (\perPage -> ("per_page", Just (LBS.toStrict $ toLazyByteString $ intDec perPage))) <$> pageParamsPerPage pp + ] + _ -> [] -- | Query @Link@ header with @rel=next@ from the request headers. -getNextUrl :: Response a -> Maybe URI +getNextUrl :: HTTP.Response a -> Maybe URI getNextUrl req = do linkHeader <- lookup "Link" (responseHeaders req) links <- parseLinkHeaderBS linkHeader nextURI <- find isRelNext links return $ href nextURI where - isRelNext :: Link -> Bool + -- isRelNext :: Link -> Bool or Link uri -> Bool isRelNext = any (== relNextLinkParam) . linkParams relNextLinkParam :: (LinkParam, Text) relNextLinkParam = (Rel, "next") --- | Parse API response. --- --- @ --- parseResponse :: 'FromJSON' a => 'Response' 'LBS.ByteString' -> 'Either' 'Error' a --- @ -parseResponse :: (FromJSON a, MonadError Error m) => Response LBS.ByteString -> m a -parseResponse res = case eitherDecode (responseBody res) of - Right x -> return x - Left err -> throwError . ParseError . T.pack $ err - --- | Helper for handling of 'RequestStatus'. --- --- @ --- parseStatus :: 'StatusMap' a -> 'Status' -> 'Either' 'Error' a --- @ -parseStatus :: MonadError Error m => StatusMap a -> Status -> m a -parseStatus StatusOnlyOk (Status sci _) - | sci == 204 = return True - | sci == 404 = return False - | otherwise = throwError $ JsonError $ "invalid status: " <> T.pack (show sci) -parseStatus StatusMerge (Status sci _) - | sci == 204 = return MergeSuccessful - | sci == 405 = return MergeCannotPerform - | sci == 409 = return MergeConflict - | otherwise = throwError $ JsonError $ "invalid status: " <> T.pack (show sci) - -- | Helper for making paginated requests. Responses, @a@ are combined monoidally. -- +-- The result is wrapped in the last received 'HTTP.Response'. +-- -- @ -- performPagedRequest :: ('FromJSON' a, 'Semigroup' a) --- => ('HTTP.Request' -> 'ExceptT' 'Error' 'IO' ('Response' 'LBS.ByteString')) +-- => ('HTTP.Request' -> 'ExceptT' 'Error' 'IO' ('HTTP.Response' 'LBS.ByteString')) -- -> (a -> 'Bool') -- -> 'HTTP.Request' --- -> 'ExceptT' 'Error' 'IO' a +-- -> 'ExceptT' 'Error' 'IO' ('HTTP.Response' a) -- @ -performPagedRequest :: forall a m. (FromJSON a, Semigroup a, MonadCatch m, MonadError Error m) - => (HTTP.Request -> m (Response LBS.ByteString)) -- ^ `httpLbs` analogue - -> (a -> Bool) -- ^ predicate to continue iteration - -> HTTP.Request -- ^ initial request - -> m a -performPagedRequest httpLbs' predicate initReq = do +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 <- parseResponse res + m <- unTagged (parseResponse initReq res :: Tagged mt (m a)) go m res initReq where - go :: a -> Response LBS.ByteString -> HTTP.Request -> m a + go :: a -> HTTP.Response LBS.ByteString -> HTTP.Request -> m (HTTP.Response a) go acc res req = case (predicate acc, getNextUrl res) of (True, Just uri) -> do - req' <- setUri req uri + req' <- HTTP.setUri req uri res' <- httpLbs' req' - m <- parseResponse res' + m <- unTagged (parseResponse req' res' :: Tagged mt (m a)) go (acc <> m) res' req' - (_, _) -> return acc + (_, _) -> 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 diff --git a/src/highlight.js b/src/highlight.js deleted file mode 100644 index 1e903bd0..00000000 --- a/src/highlight.js +++ /dev/null @@ -1,27 +0,0 @@ - -var highlight = function (on) { - return function () { - var links = document.getElementsByTagName('a'); - for (var i = 0; i < links.length; i++) { - var that = links[i]; - - if (this.href != that.href) { - continue; - } - - if (on) { - that.classList.add("hover-highlight"); - } else { - that.classList.remove("hover-highlight"); - } - } - } -}; - -window.onload = function () { - var links = document.getElementsByTagName('a'); - for (var i = 0; i < links.length; i++) { - links[i].onmouseover = highlight(true); - links[i].onmouseout = highlight(false); - } -}; diff --git a/src/style.css b/src/style.css deleted file mode 100644 index e83dc5ec..00000000 --- a/src/style.css +++ /dev/null @@ -1,55 +0,0 @@ -body { - background-color: #fdf6e3; -} - -.hs-identifier { - color: #073642; -} - -.hs-identifier.hs-var { -} - -.hs-identifier.hs-type { - color: #5f5faf; -} - -.hs-keyword { - color: #af005f; -} - -.hs-string, .hs-char { - color: #cb4b16; -} - -.hs-number { - color: #268bd2; -} - -.hs-operator { - color: #d33682; -} - -.hs-glyph, .hs-special { - color: #dc322f; -} - -.hs-comment { - color: #8a8a8a; -} - -.hs-pragma { - color: #2aa198; -} - -.hs-cpp { - color: #859900; -} - -a:link, a:visited { - text-decoration: none; - border-bottom: 1px solid #eee8d5; -} - -a:hover, a.hover-highlight { - background-color: #eee8d5; -} diff --git a/stack-ghc-8.0.yaml b/stack-ghc-8.0.yaml deleted file mode 100644 index 592b2ca4..00000000 --- a/stack-ghc-8.0.yaml +++ /dev/null @@ -1,110 +0,0 @@ -flags: - time-locale-compat: - old-locale: false -packages: -- '.' -setup-info: - ghc: - linux64: - 8.0.0.20160421: - url: https://downloads.haskell.org/~ghc/8.0.1-rc4/ghc-8.0.0.20160421-x86_64-unknown-linux.tar.xz - macosx: - 8.0.0.20160421: - url: https://downloads.haskell.org/~ghc/8.0.1-rc4/ghc-8.0.0.20160421-x86_64-apple-darwin.tar.xz -extra-deps: -- HUnit-1.3.1.1 -- QuickCheck-2.8.2 -- StateVar-1.1.0.4 -- adjunctions-4.3 -- aeson-0.11.2.0 -- aeson-compat-0.3.3.0 -- ansi-terminal-0.6.2.3 -- asn1-encoding-0.9.3 -- asn1-parse-0.9.4 -- asn1-types-0.3.2 -- async-2.1.0 -- attoparsec-0.13.0.2 -- base-compat-0.9.1 -- base-orphans-0.5.4 -- base16-bytestring-0.1.1.6 -- base64-bytestring-1.0.0.1 -- bifunctors-5.3 -- binary-orphans-0.1.4.0 -- blaze-builder-0.4.0.2 -- byteable-0.1.1 -- bytestring-conversion-0.3.1 -- case-insensitive-1.2.0.6 -- cereal-0.5.1.0 -- comonad-5 -- connection-0.2.5 -- contravariant-1.4 -- cookie-0.4.2 -- cryptohash-0.11.9 -- cryptonite-0.15 -- data-default-class-0.0.1 -- deepseq-generics-0.2.0.0 -- distributive-0.5.0.2 -- dlist-0.7.1.2 -- double-conversion-2.0.1.0 -- errors-2.1.2 -- exceptions-0.8.2.1 -- fail-4.9.0.0 -- file-embed-0.0.10 -- free-4.12.4 -- hashable-1.2.4.0 -- hourglass-0.2.10 -- hspec-2.2.3 -- hspec-core-2.2.3 -- hspec-discover-2.2.3 -- hspec-expectations-0.7.2 -- http-client-0.4.28 -- http-client-tls-0.2.4 -- http-link-header-1.0.1 -- http-types-0.9 -- iso8601-time-0.1.4 -- kan-extensions-5.0.1 -- keys-3.11 -- memory-0.12 -- mime-types-0.1.0.7 -- mtl-2.2.1 -- nats-1.1 -- network-2.6.2.1 -- network-uri-2.6.1.0 -- old-locale-1.0.0.7 -- parsec-3.1.11 -- pem-0.2.2 -- pointed-5 -- prelude-extras-0.4.0.3 -- primitive-0.6.1.0 -- profunctors-5.2 -- quickcheck-io-0.1.2 -- random-1.1 -- safe-0.3.9 -- scientific-0.3.4.6 -- semigroupoids-5.0.1 -- semigroups-0.18.1 -- setenv-0.1.1.3 -- socks-0.5.5 -- stm-2.4.4.1 -- streaming-commons-0.1.15.5 -- syb-0.6 -- tagged-0.8.4 -- text-1.2.2.1 -- text-binary-0.2.1 -- tf-random-0.5 -- time-locale-compat-0.1.1.1 -- tls-1.3.8 -- transformers-compat-0.5.1.4 -- unexceptionalio-0.3.0 -- unordered-containers-0.2.7.0 -- vector-0.11.0.0 -- vector-binary-instances-0.2.3.2 -- vector-instances-3.3.1 -- void-0.7.1 -- x509-1.6.3 -- x509-store-1.6.1 -- x509-system-1.6.3 -- x509-validation-1.6.3 -- zlib-0.6.1.1 -compiler-check: match-exact -resolver: ghc-8.0.0.20160421 diff --git a/stack-lts-2.yaml b/stack-lts-2.yaml deleted file mode 100644 index 5a8eb996..00000000 --- a/stack-lts-2.yaml +++ /dev/null @@ -1,25 +0,0 @@ -packages: -- '.' -- 'samples/' -extra-deps: -- aeson-extra-0.2.3.0 -- asn1-parse-0.9.4 -- asn1-types-0.3.2 -- base-compat-0.9.1 -- binary-orphans-0.1.3.0 -- connection-0.2.5 -- cryptonite-0.15 -- http-link-header-1.0.1 -- iso8601-time-0.1.4 -- memory-0.12 -- tls-1.3.8 -- x509-1.6.3 -- x509-store-1.6.1 -- x509-system-1.6.3 -- x509-validation-1.6.3 -resolver: lts-2.22 -flags: - github: - aeson-compat: false - iso8601-time: - new-time: false diff --git a/stack-lts-3.yaml b/stack-lts-3.yaml deleted file mode 100644 index 7b68091a..00000000 --- a/stack-lts-3.yaml +++ /dev/null @@ -1,14 +0,0 @@ -packages: -- '.' -- 'samples/' -extra-deps: -- base-compat-0.9.1 -- cryptonite-0.15 -- http-link-header-1.0.1 -- iso8601-time-0.1.4 -- memory-0.12 -- tls-1.3.8 -resolver: lts-3.22 -flags: - github: - aeson-compat: false diff --git a/stack-lts-4.yaml b/stack-lts-4.yaml deleted file mode 100644 index e73113f5..00000000 --- a/stack-lts-4.yaml +++ /dev/null @@ -1,8 +0,0 @@ -packages: -- '.' -- 'samples/' -extra-deps: -- base-compat-0.9.1 -- cryptonite-0.15 -- tls-1.3.8 -resolver: lts-4.2 diff --git a/stack-lts-5.yaml b/stack-lts-5.yaml deleted file mode 100644 index c0228d93..00000000 --- a/stack-lts-5.yaml +++ /dev/null @@ -1,5 +0,0 @@ -packages: -- '.' -- 'samples/' -extra-deps: [] -resolver: lts-5.16 diff --git a/stack-nightly.yaml b/stack-nightly.yaml deleted file mode 100644 index 81e4d4ff..00000000 --- a/stack-nightly.yaml +++ /dev/null @@ -1,8 +0,0 @@ -resolver: nightly-2016-05-13 -packages: -- '.' -- 'samples/' -extra-deps: [] -flags: - github: - aeson-compat: true diff --git a/stack.yaml b/stack.yaml deleted file mode 120000 index 0db6065a..00000000 --- a/stack.yaml +++ /dev/null @@ -1 +0,0 @@ -stack-lts-5.yaml \ No newline at end of file diff --git a/travis-install.sh b/travis-install.sh deleted file mode 100644 index 911eddb1..00000000 --- a/travis-install.sh +++ /dev/null @@ -1,50 +0,0 @@ -set -e - -case $BUILD in - stack) - mkdir -p ~/.local/bin; - if [ `uname` = "Darwin" ]; then - curl -kL https://www.stackage.org/stack/osx-x86_64 | tar xz --strip-components=1 --include '*/stack' -C ~/.local/bin; - else - curl -L https://www.stackage.org/stack/linux-x86_64 | tar xz --wildcards --strip-components=1 -C ~/.local/bin '*/stack'; - fi - stack --no-terminal setup - stack --no-terminal test --only-dependencies - ;; - cabal) - if [ -n "$STACKAGESNAPSHOT" ]; then - curl -sL https://www.stackage.org/$STACKAGESNAPSHOT/cabal.config | sed 's/constraints:/preferences:/' | grep -v installed > cabal.config - head cabal.config - fi - cabal --version - echo "$(ghc --version) [$(ghc --print-project-git-commit-id 2> /dev/null || echo '?')]" - if [ -f $HOME/.cabal/packages/hackage.haskell.org/00-index.tar.gz ]; then - zcat $HOME/.cabal/packages/hackage.haskell.org/00-index.tar.gz > $HOME/.cabal/packages/hackage.haskell.org/00-index.tar - fi - cabal update -v - sed -i 's/^jobs:/-- jobs:/' ${HOME}/.cabal/config - cabal install --only-dependencies --enable-tests --enable-benchmarks --dry -v > installplan.txt - sed -i -e '1,/^Resolving /d' installplan.txt; cat installplan.txt - - # check whether current requested install-plan matches cached package-db snapshot - if diff -u installplan.txt $HOME/.cabsnap/installplan.txt; then - echo "cabal build-cache HIT"; - rm -rfv .ghc; - cp -a $HOME/.cabsnap/ghc $HOME/.ghc; - cp -a $HOME/.cabsnap/lib $HOME/.cabsnap/share $HOME/.cabsnap/bin $HOME/.cabal/; - else - echo "cabal build-cache MISS"; - rm -rf $HOME/.cabsnap; - mkdir -p $HOME/.ghc $HOME/.cabal/lib $HOME/.cabal/share $HOME/.cabal/bin; - cabal install --only-dependencies --enable-tests --enable-benchmarks; - fi - - # snapshot package-db on cache miss - if [ ! -d $HOME/.cabsnap ]; then - echo "snapshotting package-db to build-cache"; - mkdir $HOME/.cabsnap; - cp -a $HOME/.ghc $HOME/.cabsnap/ghc; - cp -a $HOME/.cabal/lib $HOME/.cabal/share $HOME/.cabal/bin installplan.txt $HOME/.cabsnap/; - fi - ;; -esac diff --git a/travis-script.sh b/travis-script.sh deleted file mode 100644 index 6303342b..00000000 --- a/travis-script.sh +++ /dev/null @@ -1,34 +0,0 @@ -set -e - -case $BUILD in - stack) - stack --no-terminal test github - stack --no-terminal build github-samples - - # TODO: get executables from info - for testbin in show-user list-followers list-following operational; do - echo "Running " $testbin - stack exec github-$testbin - done - ;; - cabal) - if [ -f configure.ac ]; then autoreconf -i; fi - cabal configure --enable-tests --enable-benchmarks -v2 # -v2 provides useful information for debugging - cabal build # this builds all libraries and executables (including tests/benchmarks) - cabal test --show-details=always - - if [ "$CABALVER" = "1.22" ]; then cabal check; fi - if [ "$CABALVER" = "1.22" ]; then cabal haddock; fi - - cabal sdist # tests that a source-distribution can be generated - - # Check that the resulting source distribution can be built & installed. - # If there are no other `.tar.gz` files in `dist`, this can be even simpler: - # `cabal install --force-reinstalls dist/*-*.tar.gz` - export SRCPKG=$(cabal info . | awk '{print $2;exit}') - cd dist - tar -xzvf $SRCPKG.tar.gz - cd $SRCPKG - cabal configure --enable-tests && cabal build && cabal install --force-reinstalls - ;; -esac